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<perlmodstyle>

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_re
+f)
    : _mk_closure($slot);

  {
    no strict 'refs';
    *$slot = $closure;
  } 
} 

1;
[download]

Then we use it somewhere:

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_mut
+ator};
  
mk_accessor_mutator(__PACKAGE__, '_platform', [ qw/tst dev it uat/ ]);
mk_accessor_mutator(__PACKAGE__, '_system',   [ qw/airbp airworld avfu
+el aviation chevron shell/ ]);
mk_accessor_mutator(__PACKAGE__, 'merchant');
[download]

then in the test code:

BEGIN {
  require_ok('TDP::RewriteSettlementFiles::Util::ModifyNumbers'); 
}
[download]

fails hard:

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::Rewrit
+eSettlementFiles::Common module
# Can't continue after import errors at ../lib/TDP/RewriteSettlementFi
+les/Util/ModifyNumbers.pm line 11
# BEGIN failed--compilation aborted at ../lib/TDP/RewriteSettlementFil
+es/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; skipp
+ing 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.
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.