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