package TDP::RewriteSettlementFiles::Common; use 5.008008; use strict; use Exporter qw{import}; our @EXPORT_OK = qw{mk_mutator_accessor fatal_error}; use Carp; use Readonly; use Switch; our $VERSION = '0.00_01'; $VERSION = eval $VERSION; # see L sub fatal_error { local $Carp::CarpLevel = 1; Carp::croak ( (caller(1))[3] . '(): ' . shift() ); } sub _mk_plain_closure { my ($hash_key) = @_; return sub { my ($self, $value) = @_; if (@_ > 1) { $self->{$hash_key} = $value; } return $self->{$hash_key}; }; } sub _mk_array_validated_closure { my ($hash_key, $field_name, $values_aref) = @_; my %valid_values = map { $_ => {} } @$values_aref; return sub { my ($self, $value) = @_; if (@_ > 1) { fatal_error("invalid value for $field_name") if !exists $valid_values{$value}; $self->{$hash_key} = $value; } return $self->{$hash_key}; }; } sub mk_mutator_accessor { my ($pkg, $field_name, $valid_values_ref) = @_; my $slot = "$pkg\::$field_name"; ## building the closure outside the "no strict 'refs'" block ## to avoid subtle side effects; using $slot for the key to ## avoid namespace collision with XML::SAX::Base. my $closure = defined $valid_values_ref ? _mk_array_validated_closure($slot, $field_name, $valid_values_ref) : _mk_closure($slot); { no strict 'refs'; *$slot = $closure; } } 1; #### package TDP::RewriteSettlementFiles::Util::ModifyNumbers; use base 'TDP::RewriteSettlementFiles::Base'; use 5.008005; use strict; use Readonly; use List::Util qw/first/; use DBI; use TDP::RewriteSettlementFiles::Common qw{fatal_error mk_accessor_mutator}; mk_accessor_mutator(__PACKAGE__, '_platform', [ qw/tst dev it uat/ ]); mk_accessor_mutator(__PACKAGE__, '_system', [ qw/airbp airworld avfuel aviation chevron shell/ ]); mk_accessor_mutator(__PACKAGE__, 'merchant'); #### BEGIN { require_ok('TDP::RewriteSettlementFiles::Util::ModifyNumbers'); } #### perl TDP-RewriteSettlementFiles-Util-ModifyNumbers.t 1..307 not ok 1 - use TDP::RewriteSettlementFiles::Util::ModifyNumbers; # Failed test 'use TDP::RewriteSettlementFiles::Util::ModifyNumbers;' # at TDP-RewriteSettlementFiles-Util-ModifyNumbers.t line 179. # Tried to use 'TDP::RewriteSettlementFiles::Util::ModifyNumbers'. # Error: "mk_accessor_mutator" is not exported by the TDP::RewriteSettlementFiles::Common module # Can't continue after import errors at ../lib/TDP/RewriteSettlementFiles/Util/ModifyNumbers.pm line 11 # BEGIN failed--compilation aborted at ../lib/TDP/RewriteSettlementFiles/Util/ModifyNumbers.pm line 11. # Compilation failed in require at (eval 5) line 2. # BEGIN failed--compilation aborted at (eval 5) line 2. TDP::RewriteSettlementFiles::Util::ModifyNumbers didn't compile; skipping everything else! # Looks like you planned 307 tests but only ran 1. # Looks like you failed 1 test of 1 run. # Looks like your test died just after 1.