view release on metacpan or  search on metacpan

ArgvFile.pm  view on Meta::CPAN

In case the ".script" name rule does not meet your needs or does not fit
into a certain policy, the expected startup filenames can be set up by
an option C<startupFilename>. The option value may be a scalar used as
the expected filename, or a reference to an array of accepted choices,
or a reference to code returning the name - plainly or as a reference to
an array of names. Such callback code will be called I<once> and will
receive the name of the script.

  # use ".config"
  argvFile(startupFilename => '.config');

  # use ".config" or "config"
  argvFile(startupFilename => [qw(.config config)]);

  # emulate the default behaviour,
  # but use an extra dot postfix
  my $nameBuilder=sub {join('', '.', basename($_[0]), '.');};
  argvFile(startupFilename => $nameBuilder);

  # use .(script)rc or .(script)/config
  my $nameBuilder=sub
                   {
                    my $sname=basename($_[0]);
                    [".${sname}rc", ".${sname}/config"];
                   };
  argvFile(startupFilename => $nameBuilder);

Note that the list variants will use the first matching filename in each
possible startup-file path. For example if your array is C<['.scriptrc',
'.script.config']> and you have both a C<.scriptrc> and a C<.script.config>
file in (say) your current directory, only the C<.scriptrc> file will be
used, as it is the first found.

The contents found in a startup file is placed I<before> all explicitly
set command line arguments. This enables to overwrite a default setting
by an explicit option. If all startup files are read, I<current> startup
files can overwrite I<home> files which have preceedence over I<default>
ones, so that the I<default> startups are most common. In other words,
if the module would not support startup files, you could get the same
result with "script @/path/.script @/homes/user/.script @/the/current/dir/.script".

Note: There is one certain case when overwriting will I<not> work completely
because duplicates are sorted out: if all three types of startup files are
used and the script is started in the installation directory,
the default file will be identical to the current file. The default file is
processed, but the current file is skipped as a duplicate later on and will
I<not> overwrite settings made caused by the intermediately processed home file.
If started in another directory, it I<will> overwrite the home settings.
But the alternative seems to be even more confusing: the script would behave
differently if just started in its installation path. Because a user might
be more aware of configuration editing then of the current path, I choose
the current implementation, but this preceedence might become configurable
in a future version.

If there is no I<HOME> environment variable, the I<home> setting takes no effect
to avoid trouble accessing the root directory.

B<Cascades>

The function supports multi-level (or so called I<cascaded>) option files.
If a filename in an option file hint starts with a "@" again, this complete
name is the resolution written back to @ARGV - assuming there will be
another utility reading option files.

 Examples:
  @rfile          rfile will be opened, its contents is
                  made part of @ARGV.
  @@rfile         cascade: "@rfile" is written back to
                  @ARGV assuming that there is a subsequent
                  tool called by the script to which this
                  hint will be passed to solve it by an own
                  call of argvFile().

The number of cascaded hints is unlimited.

B<Processing an alternative array>

Although the function was designed to process @ARGV, it is possible to
process another array as well if you prefer. To do this, simply pass
a I<reference> to this array by parameter B<array>.

 Examples:
  argvFile()                    # processes @ARGV;
  argvFile(array=>\@options);   # processes @options;

B<Choosing an alternative hint prefix>

By default, "@" is the prefix used to mark an option file. This can
be changed by using the optional parameter B<prefix>:

 Examples:
  argvFile();                   # use "@";
  argvFile(prefix=>'~');        # use "~";

Note that the strings "#", "=", "-" and "+" are reserved and I<cannot>
be chosen here because they are used to start plain or POD comments or
are typically option prefixes.

B<Using an option instead of a hint prefix>

People not familiar with option files might be confused by file prefixes.
This can be avoided by offering an I<option> that can be used instead
of a prefix, using the optional parameter B<fileOption>:

  # install a file option
  # (all lines are equivalent)
  argvFile(fileOption=>'options');
  argvFile(fileOption=>'-options');
  argvFile(fileOption=>'+options');
  argvFile(fileOption=>'--options');

The name of the option can be specified with or without the usual option
prefixes C<->, C<--> and C<+>.

Once an option is declared, it I<can> replace a prefix. (Prefixes remain
in action as well.)

   # with -options declared to be a file option,
   # these sequences are equivalent
   @file
   -options file

   # five equivalent cascades
   @@@@file
   -options @@@file
   -options -options @@file
   -options -options -options @file
   -options -options -options -options file

Please note that prefixes are attached to the filename with no spaces
in between, while the option declared via -fileOption is separated from
the filename by whitespace, as for normal options.


=cut
sub argvFile
 {
  # declare function variables
  my ($maskString, $i, %rfiles, %startup, %seen)=("\0x07\0x06\0x07");

  # detect the host system (to prepare filename handling)
  my $casesensitiveFilenames=$^O!~/^(?:dos|os2|MSWin32)/i;

  # check and get parameters
  confess('[BUG] Getopt::ArgvFile::argvFile() uses named parameters, please provide name value pairs.') if @_ % 2;
  my %switches=@_;

  # perform more parameter checks
  confess('[BUG] The "array" parameter value is no array reference.') if exists $switches{array} and not (ref($switches{array}) and ref($switches{array}) eq 'ARRAY');
  confess('[BUG] The "prefix" parameter value is no defined literal.') if exists $switches{prefix} and (not defined $switches{prefix} or ref($switches{prefix}));
  confess('[BUG] Invalid "prefix" parameter $switches{"prefix"}.') if exists $switches{prefix} and $switches{prefix}=~/^[-#=+]$/;
  confess('[BUG] The "startupFilename" parameter value is neither a scalar nor array or code reference.') if exists $switches{startupFilename} and ref($switches{startupFilename}) and ref($switches{startupFilename})!~/^(ARRAY|CODE)$/;
  confess('[BUG] The "fileOption" parameter value is no defined literal.') if exists $switches{fileOption} and (not defined $switches{fileOption} or ref($switches{fileOption}));

  # check if further operations are suppressed (in case of a call via import())
  {
   my ($callerSub)=(caller(1))[3];
   return if     defined $callerSub and $callerSub eq join('::', __PACKAGE__, 'import')
             and exists $switches{justload};
  }

  # set array reference
  my $arrayRef=exists $switches{array} ? $switches{array} : \@ARGV;

  # set prefix
  my $prefix=exists $switches{prefix} ? $switches{prefix} : '@';

  # set file option
  my $fileOption=exists $switches{fileOption} ? $switches{fileOption} : '';
  $fileOption=~s/^$optionPrefixPattern//;

  # set up startup filename list
  my $startupFilenames=exists  $switches{startupFilename}
                        ?  ref($switches{startupFilename})
                         ? ref($switches{startupFilename}) eq 'CODE'
                          ?    $switches{startupFilename}->($0)
                          :    $switches{startupFilename}
                         :    [$switches{startupFilename}]
                        : [join('', '.', basename($0))];

  # check callback results
  confess('[BUG] The filenames callback did not return a scalar or an array reference.')
   if ref($startupFilenames) and ref($startupFilenames) ne 'ARRAY';

ArgvFile.pm  view on Meta::CPAN

  # Also set the first-found startup files while we're finding them. This makes sure we
  # only use *one* file per path.
  my %startupFiles;
  foreach my $type (qw(default home current))
    {
     # skip unused settings
     next unless exists $switches{$type};

     # build filename (use the first existing file built according to the list of choices, if any)
     my $cfg=(grep(-e, map {catfile(abs_path($startup{$type}{path}), $_)} @$startupFilenames))[0];

     # remove this setting if the associated file
     # was already seen before (each file should be read once)
     # - or if there is no such file this call
     delete $switches{$type}, next if not defined $cfg or exists $seen{$cfg};

     # buffer filename for subsequent use - no need to built it twice
     $startupFiles{$type}=$cfg;

     # otherwise, note that we saw this file
     $seen{$cfg}=1;
    }

  # Check all possible startup files for usage - be careful to handle
  # them in the following order (implemented by alphabetical order here!):
  # FIRST, the DEFAULT startup should be read, THEN the HOME one and finally
  # the CURRENT one - this way, all startup options are placed before command
  # line ones, and the CURRENT settings can overwrite the HOME settings which
  # can overwrite the DEFAULT ones - which are the most common.
  # Note that to achieve this reading order, we have to build the array
  # of filenames in reverse order (because we use unshift() for construction).
  foreach my $type (qw(current home default))
    {
     # let's proceed this file first, if there is anything to do
     # - this way, command line options can overwrite configuration
     # settings (we already checked file existence above)
     unshift @$arrayRef, join('', $prefix, $startupFiles{$type})
       if exists $switches{$type};
    }

  # nesting ...
  while (grep(/^$prefix/, @$arrayRef))
    {
     # declare scope variables
     my (%nr, @c, $c);

     # scan the array for option file hints
     for ($i=0; $i<@$arrayRef; $i++)
       {$nr{$i}=1 if substr($arrayRef->[$i], 0, 1) eq $prefix;}

     for ($i=0; $i<@$arrayRef; $i++)
       {
        if ($nr{$i})
          {
           # an option file - handle it

           # remove the option hint
           $arrayRef->[$i]=~s/$prefix//;

           # if there is still an option file hint in the name of the file,
           # this is a cascaded hint - insert it with a special temporary
           # hint (has to be different from $prefix to avoid a subsequent solution
           # by this loop)
           push(@c, $arrayRef->[$i]), next if $arrayRef->[$i]=~s/^$prefix/$maskString/;

           # skip nonexistent or recursively nested files
           next if !-e $arrayRef->[$i] || -d _ || $rfiles{$casesensitiveFilenames ? $arrayRef->[$i] : lc($arrayRef->[$i])};

           # store filename to avoid recursion
           $rfiles{$casesensitiveFilenames ? $arrayRef->[$i] : lc($arrayRef->[$i])}=1;

           # open file and read its contents
           open(OPT, $arrayRef->[$i]);
           {
            # scopy
            my ($pod);

            # handle every line
            while (<OPT>)
              {
               # check for POD directives
               $pod=1 if /^=\w/;
               $pod=0, next if /^=cut/;

               # skip space and comment lines (including POD)
               next if /^\s*$/ || /^\s*\#/ || $pod;

               # remove newlines, leading and trailing spaces
               s/\s*\n?$//; s/^\s*//;

               # get "shellwords", double backslashes before Dollar characters
               # as they would get lost otherwise (other backslash removals are welcome!)
               s/\\\$/\\\\\$/g;
               my (@shellwords)=shellwords($_);

               # replace environment variables, if necessary
               if (exists $switches{resolveEnvVars})
                 {
                  # get *quoted* strings
                  my (@quotedwords)=quotewords('\s+', 1, $_);

                  # process all strings
                  for (my $i=0; $i<@shellwords; ++$i)
                    {
                     # substitute environment variables, except in single quoted strings
                     unless ($quotedwords[$i]=~/^'.+'$/)
                       {
                        # named variables
                        $shellwords[$i]=~s/(?<!\\)\$(\w+)/exists $ENV{$1} ? $ENV{$1} : ''/ge;

                        # symbolic variables
                        $shellwords[$i]=~s/(?<!\\)\$(?:{(\w+)})/exists $ENV{$1} ? $ENV{$1} : ''/ge;

                        # finally, remove the backslashes before Dollar characters we added above
                        $shellwords[$i]=~s/\\\$/\$/g;
                       }
                    }
                 }

               # resolve relative pathes, if requested
               if (exists $switches{resolveRelativePathes})
                 {
                  # process all strings
                  foreach my $string (@shellwords)
                    {
                     # scopy
                     my @p;
                     # replace as necessary
                     @p=(defined($1) ? $1 : '', $2), $string=~s#^$p[0]$p[1]#join('', $p[0], abs_path(catfile(dirname($arrayRef->[$i]), $p[1])))#e
                       if $string=~m#^($prefix)?([./]+)/#;
                    }
                 }

               # supply results
               push(@c, @shellwords);
              }
           }
          }
        else
          {
           # a normal option or parameter - handle it
           push(@c, $arrayRef->[$i]);
          }
       }

     # substitute file options by prefixes, if necessary
     _fileOptions2prefixes($fileOption, $prefix, \@c) if $fileOption;

     # replace original array by expanded array
     @$arrayRef=@c;
    }

  # reset hint character in cascaded hints to $prefix
  @$arrayRef=map {s/^$maskString/$prefix/; $_} @$arrayRef;
 }


# allow one line invokation via "use", but make sure to keep backwards compatibility to
# the traditional interface inherited from Exporter 
sub import
 {
  # check if the caller intended to import symbols
  # (till 1.06, import() was inherited from Exporter and the only symbol to import was argvFile())
  if (@_==2 and $_[-1] eq "argvFile")
   {goto &Exporter::import;}
  else
   {
    # shift away the module name
    shift;

    # invoke argvFile(): now option files are processed while the module is loaded
    argvFile(@_);
   }
 }



# preprocess an array to convert the -fileOption string into a prefix
sub _fileOptions2prefixes
 {
  # get and check parameters
  my ($fileOption, $prefix, $arrayRef)=@_;

  # anything to do?
  if ($fileOption)
   {
    # make options a string and replace all file options by a prefix
    # (to replace the file option and its successor by the prefixed successor)
    my $options=join("\x01\x01\x01", @$arrayRef);
    $options=~s/($optionPrefixPattern$fileOption\x01+)/$prefix/g;

    # replace original array
    @$arrayRef=split(/\x01\x01\x01/, $options);;
   }
 }



# flag this module was read successfully
1;

# POD TRAILER ####################################################

=pod

=head1 ONE LINE INVOCATION

The traditional two line sequence

  # load the module
  use Getopt::ArgvFile qw(argvFile);

  ...