Function Templates

gistfile1.pl

my $cliSettings = {};
my $cliSettings->{'testName'} = "Standard";
my $verbose = 1;

{
  # A function to return functions!
  
  # you call &$getPathTemplate with a function that accepts a single, scalar (not reference)
  # argument and returns true or false (1 or 0 in Perl) the second argument is
  # a flag for the second argument that denotes if the destination this GetOptions
  # callback will be used for is an array.
  
  # The return value is a GetOptions callback that takes the usual ($argName, $argValue)
  # arguments.  In this case, we are checking paths.  The path is passed in to the validator.
  # If the validator returns true, then the path is stored in the cliSettings hash under 
  # the argument name provided.
  
  # If you specified an array, it is checked if the array exists, if not, a new array
  # is created and the reference stored.  The path is then stored in the array.
  my $getPathTemplate = sub {
    my ($validator, $array) = @_;
    return sub {
      my ($argName, $path) = @_;  
      $path = abs_path($path);
      die "Bad $argName argument $path\n" unless &$validator($path);
      if ($array) {
        $cliSettings->{$argName} = [] unless defined $cliSettings->{$argName};
        push(@{$cliSettings->{$argName}}, $path);
      } else {
        $cliSettings->{$argName} = $path;
      }
    }
  };

  GetOptions(
   "settingsFile=s"        => &$getPathTemplate( sub { -r $_[0] }, 0),
    "excludeDir=s"         => &$getPathTemplate( sub { -e $_[0] }, 1),
    "excludeFile=s"        => &$getPathTemplate( sub { -e $_[0] }, 1),
    "includeFile=s"        => &$getPathTemplate( sub { -r $_[0] }, 1),
    "includeDir=s"         => &$getPathTemplate( sub { -r $_[0] }, 1),
    "outputDir=s"          => &$getPathTemplate( sub { 1;       }, 0),
    "testRunnerLocation=s" => &$getPathTemplate( sub { -x $_[0] }, 0),
    "soapUISettings=s"     => &$getPathTemplate( sub { -r $_[0] }, 0),
    "testName=s"           => \$cliSettings->{'testName'},
    "quiet"                => sub { $verbose = 0 },
    "help|?"               => sub { pod2usage(-verbose => 2, -output => \*STDOUT); },
  );
}