lib/Perlbal/Fields.pm

   1 package Perlbal::Fields;
   2 use strict;
   3 use warnings;
   4 use fields;
   5
   6 # allow package to be called in command line
   7 __PACKAGE__->run(@ARGV) unless caller();
   8
   9 # should be the main method called, extra sub could be triggered from this point
  10 sub run {
  11     my ( $package, @options ) = @_;
  12
  13     # unactivate fields if launch in command line
  14     $package->remove();
  15
  16     1;
  17 }
  18
  19 # hash with keys and undef val for each class
  20 my $cache_for_class = {};
  21
  22 # replace fields::new method which uses Hash::Util::lock_ref_keys
  23 # - it's a good idea to keep using the original fields::new during development stage
  24 # - but during production we can avoid locking hash and wasting time doing this ( ~ 30 % )
  25 sub remove {
  26     my ($class) = @_;
  27
  28     no warnings "redefine";
  29     no strict 'refs';
  30     *fields::new = sub {
  31         my $class = shift;
  32         $class = ref $class if ref $class;
  33
  34         if ( !defined( $cache_for_class->{$class} ) ) {
  35             my $h    = {};
  36             my @keys = keys %{ $class . "::FIELDS" };
  37             map { $h->{$_} = undef; } @keys;
  38             $cache_for_class->{$class} = $h;
  39         }
  40         my %h = %{ $cache_for_class->{$class} };
  41
  42         return bless \%h, $class;
  43     };
  44 }
  45
  46 1;
  47