view release on metacpan or  search on metacpan

lib/Advanced/Config/Options.pm  view on Meta::CPAN

   $default_read_opts{encrypt_cb_opts} = \%empty_encrypt;

   # Special undocumented test prog option for overriding fish in parse_line().
   $default_read_opts{dbug_test_use_case_parse_override} = 0;  # Always off.

   # Special undocumented test prog option for overriding fish in read_config().
   $default_read_opts{dbug_test_use_case_hide_override} = 0;   # Always off.


   # ---------------------------------------------------------------------

   DBUG_PRINT ("INFO", "Initializing the GET options global hash ...");
   # Should always be set in the constructor ...
   $default_get_opts{inherit} = 0;        # Can inherit from the parent section.

   # The generic options ... Who cares where set!
   $default_get_opts{required}  = 0;         # Return undef by default.
   $default_get_opts{vcase}     = 0;         # Case of the value. (0 = as is)
   $default_get_opts{split_pattern} = qr /\s+/;  # Space separated lists.

   # Used in parsing dates for get_date() ...
   $default_get_opts{date_language}      = "English"; # The language to use in parsing dates.
   $default_get_opts{date_language_warn} = 0;         # Disable warnings in Date.pm.
   $default_get_opts{date_dl_conversion} = 0;         # 1-Enable 0-Disable using Date::Language for parsing.
   $default_get_opts{date_enable_yy}     = 0;         # 1-Enable 0-Disable using 2 digit years in a date!
   $default_get_opts{date_format}        = 3;         # Hints are 0 to 8.

   # These special case options not to show up in the POD ...
   # All associated with special "get_*()" functions that will auto set if needed.
   $default_get_opts{numeric}     = 0;       # 0-no, 1-integer (truncate), 2-integer (round), 3-real.
   $default_get_opts{auto_true}   = 0;       # Don't return as boolean.
   $default_get_opts{filename}    = 0;       # Tag doesn't do a file test.
   $default_get_opts{directory}   = 0;       # Tag doesn't do a directory test.
   $default_get_opts{split}       = 0;       # Don't split the value.
   $default_get_opts{sort}        = 0;       # Don't sort the split value. (1 - sort, -1 - reverse sort)
   $default_get_opts{date_active} = 0;       # 0-No, 1-Yes expecing it to be a date.


   # ---------------------------------------------------------------------

   DBUG_PRINT ("INFO", "Initializing the DATE formatting options global hash ...");
   $default_date_opts{date_order}     = 0;          # 0 - YMD, 1 - MDY, 2 - DMY
   $default_date_opts{date_sep}       = "-";        # Separator to format dates with.
   $default_date_opts{month_type}     = 0;          # 0 - numeric, 1 - abbreviate, 2 - full.
   $default_date_opts{month_language} = "English";  # See Date::Language.
   $default_date_opts{use_gmt}        = 0;          # 0 - localtime, 1 - gmtime.
   # $default_date_opts{timestamp}    = ?;          # Special case can't set directly.

   # ---------------------------------------------------------------------


   DBUG_VOID_RETURN ();
}

# ==============================================================
# A private helper method ... (not exported)
sub _get_opt_base
{
   DBUG_ENTER_FUNC ( @_ );
   my $user_opts = shift;
   my $defaults  = shift;    # Which default hash to validate against ...

   # Make own copy of the defaults hash ...
   my %result = %{$defaults};

   # Must warn about invalid key values ...
   foreach ( sort keys %{$user_opts} ) {
      my $k = lc ($_);
      my $val = $user_opts->{$_};

      unless ( exists $defaults->{$k} ) {
         warn "Unknown option '$k'.  Option ignored.\n";
         next;
      }

      # -------------------------------------
      # Trim it to make sure it's valid ...
      # -------------------------------------
      my $no_spaces_allowed = 1;
      if ( defined $val ) {
         if ( $k eq "date_sep" ) {
            $no_spaces_allowed = 0;
         } else {
            $val =~ s/^\s+//;
            $val =~ s/\s+$//;
         }

      } else {
         if ( defined $defaults->{$k} ) {
            warn "Option '$k' has no defined value.  Override ignored.\n";
         } else {
            $result{$k} = undef;
         }
         next;
      }

      # Making sure never undef for easier comparisons later on ...
      my $expect = ( defined $defaults->{$k} ) ? $defaults->{$k} : "";

      # -------------------------------------
      # Is this a call back reference ...
      # -------------------------------------
      if ( ref ( $expect ) eq "CODE" ) {
         my $call;
         if ( ref ($val) eq "CODE" ) {
            $call = $val;
         } elsif ( ref ($val) eq "") {
            if ( $val =~ m/^(.*)::([^:]+)$/ ) {
               my ($pkg, $func) = ($1, $2);
               $call = $pkg->can ($func);
            } elsif ( $val ne "" ) {
               $call = "main"->can ($val);
            }
         }

         if ( $call ) {
            $result{$k} = $call;
         } else {
            warn "Option '$k' must be a callback function.  Can't reference '$val'.  Override ignored.\n";
         }
         next;