tex2pdf

lustre 1.6.5 source code

   print "Suggested value: $default\n";
   if ( &question_ynu("Do you want to keep this value?", $YES) eq $YES ) {
      $response= $default;
   } else {
      print "$question ";
      my $user_input = <STDIN>;
      chomp($user_input);
      
      $response = $user_input;
   }
   return $response;
}

##### Make sure that specified file exists and is readable; abort if missing
# parameter 1: file to check
# parameter 2: remark if check fails on specified file

sub check_file {
   my $file = $_[0];
   my $message = defined($_[1]) ? $_[1] : "Required file cannot be accessed!";

   if ( ! -f $file ) {
      &report(2, "\nSorry. I cannot find '$file'.");
      &abort($message);
   } elsif ( ! -r $file ) {
      &report(2, "\nSorry. File '$file' exists, but is not readable.");
      &abort($message);
   }
}

##### Make sure that specified directory exists and is writable
# parameter 1: directory to check
# parameter 2: remark if check fails on specified directory
# parameter 3: if yes, creation is allowed
# return value: $TRUE - ok; $FALSE - error

sub check_dir {
   my $directory = $_[0];
   my $message = defined($_[1]) ? $_[1] : "Not a valid path!";
   my $allow_creation = defined($_[2]) ? $_[2] : $NO;

   if ( index($directory, "/") != 0 ) {
      &report(3, "\nSorry. '$directory' is not an absolute path.");
      &report(3, $message);
      return $FALSE;
   } elsif ( ! -d $directory ) {
      # dir does not exist
      if ( $allow_creation eq $YES ) {
         # creation allowed
         &report(4, "\nI cannot find '$directory'. Try to create it.");
         if ( mkdir($directory, 0755) ) {
            &report(7, "Creation of '$directory' was successful.");
            return $TRUE;
         } else {
            &report(3, "Creation of '$directory' failed.");
            &report(3, $message);
            return $FALSE;
	      }
      } else {
         # creation not allowed
         &report(3, "\nSorry. Directory '$directory' does not exist.");
         &report(3, $message);
         return $FALSE;
      }
   } elsif ( ! -w $directory ) {
      # dir not writable
      &report(3, "\nSorry. Directory '$directory' exists, but is not writable.");
      &report(3, $message);
      return $FALSE;
   }
   return $TRUE;
}

### interactively input a directory for data storage (absolute path)
# parameter 1: question
# parameter 2: default dir
# parameter 3: if 'yes' allow creation of directory
# return value: the specified directory

sub input_dir {
   my $question = $_[0];
   my $default_dir = $_[1];
   my $allow_creation = defined($_[2]) ? $_[2] : $NO;
   my $user_input;
   my $response = undef;

   if ( defined($default_dir) and index($default_dir, "/") == 0 
        and ( (! -d $default_dir and $allow_creation eq $YES) 
        or (-d $default_dir and -w $default_dir) ) ) {
      $question .= " [$default_dir]: ";
   } else {
      $default_dir = undef;
      $question .= ": ";
   }

   while (! defined($response)) {
      print "$question";
      $user_input = <STDIN>;
      chomp($user_input);
      
      if( $user_input eq "" and defined($default_dir) ) {
         # user has only pressed <ENTER> and thereby confirmed default value
	 if( ! &check_dir($default_dir,"Default value was not valid. Please, give different directory.", $allow_creation ) ) {
	    # default dir does not exist and cannot be created
	    $default_dir = undef;
	    $question = "$_[0]: ";
	 } else {
	    # valid default dir has already existed or has been created
            $response = $default_dir;
	 }
      } else {
         # user has given a directory
         if( &check_dir($user_input,"This is not a valid directory!", $allow_creation) ) {
	    $response = $user_input;
         }
      }
   }
   return $response;
}

#### add a new parameter type with corresponding additional data argument
#### parameters types
# parameter 1: type key
# parameter 2: additonal data for the type
#              e.g. for enum type: reference to list of arrays
# return value: none

sub add_param_type {
 
   my ($type, $scalar_argument) = @_;
 
   $PARAMETER_TYPES{$type} = $scalar_argument;
}

#### add a new parameter to the adminstrated parameters
####
# parameter 1: key
# parameter 2: type
# parameter 3: default value
# parameter 4: alias for command line options
# parameter 5: specification for command line options
# parameter 6: short description for help
# parameter 7: question
# parameter 8: explanation
# return value: none

sub add_param {
 
   my ($key, $type, $def_value, $opt_alias, $opt_spec, $description, $question, $explanation) = @_;
 
   $CONFIGURATION{$key} = $def_value;

   $PARAMETER_LIST{$key} = [ $type, $opt_alias, $opt_spec, $def_value, $description, $question, $explanation ];
   
   push(@PARAMETER_ORDER, $key);

   if (! exists $PARAMETER_TYPES{$type}) {
      $PARAMETER_TYPES{$type} = undef;
   }
}

### get the value of an existing parameter
# parameter 1: a parameter key
# return value: reference to the array of possible value entries 
#               (undef if not valid)

sub type_enum_array {
   my $key = $_[0];
   my $values_ref;

   if(! exists($PARAMETER_TYPES{$key})) {
      &abort("unknown type: $key");
   }

   $values_ref = $PARAMETER_TYPES{$key};

   if(ref $values_ref ne 'ARRAY') {
      $values_ref = undef;
   }

   return $values_ref;
}

### get the value of an existing parameter
# parameter 1: a parameter key
# return value: parameter value

sub param_value {
   my $key = $_[0];
   my $current_value;

   exists($CONFIGURATION{$key})
      or &abort("unknown parameter: $key");
   $current_value = $CONFIGURATION{$key};

   return $current_value;
}

### get the type of an existing parameter
# parameter 1: a parameter key
# return value: parameter value

sub param_type {
   my $key = $_[0];
   my $def_ref;
   my $type;

   exists($PARAMETER_LIST{$key})
      or &abort("unknown parameter: $key");
   $def_ref = $PARAMETER_LIST{$key};
   $type = @{$def_ref}[$TYPE];

   exists($PARAMETER_TYPES{$type})
      or &abort("parameter has unknown type: $key (type: $type)");

   return $type;
}

### determine if the given parameter is a full one (instead of option only)
# parameter 1: a parameter key
# return value: $TRUE - full parameter; $FALSE otherwise

sub full_param {
   my $key = $_[0];
   my @param_def;

   exists($PARAMETER_LIST{$key})
      or &abort("unknown parameter: $key");
   @param_def = @{$PARAMETER_LIST{$key}};

   if ($param_def[$TYPE] ne 'action' and defined ($param_def[$QUESTION])) {
      return $TRUE;
   } else {
      return $FALSE;
   }
}

### get the output needed for configuration of this parameter 
# parameter 1: a parameter key
# return value: array - (description, explanation, question) 

sub param_config_output {
   my $key = $_[0];
   my @param_def;
   my $description; 
   my $explanation; 
   my $question; 

   exists($PARAMETER_LIST{$key})
      or &abort("unknown parameter: $key");
   @param_def = @{$PARAMETER_LIST{$key}};
   $description = $param_def[$DESCRIPTION];
   $explanation = $param_def[$EXPLANATION];
   $question = $param_def[$QUESTION];
   
   return ($description, $explanation, $question);
}

### set the value of an existing parameter
# parameter 1: a parameter key
# parameter 2: the new value
# return value: none

sub set_param_value {
   my $key = $_[0];
   my $new_value = $_[1];

   exists($CONFIGURATION{$key})
      or &abort("unknown parameter: $key");
   $CONFIGURATION{$key}=$new_value;
}

### get option specifier for getopts
# parameter 1: option key
# return value: string - option specifier

sub option_specifier {
   my $key = $_[0];
   my $spec;
   my $def_ref;
 
   exists($PARAMETER_LIST{$key})
      or &abort("unknown parameter: $key");
   $def_ref = $PARAMETER_LIST{$key};
   $spec = $key . ${$def_ref}[$OPT_ALIAS] . ${$def_ref}[$OPT_SPEC];
 
   return $spec;
}

### handle an option
# parameter 1: a parameter/option key
# parameter 2: the option value
# return value: none

sub handle_option {
   my $key = $_[0];
   my $value = $_[1];
   my $type;
   
   $type = &param_type($key);

   if ($type eq 'action') {
      &handle_action_opt($key, $value);
   } elsif ( $type eq 'bool' or $type eq 'three') {
      my $bool_value = $value ? $YES : $NO;
      &set_param_value($key, $bool_value);
   } elsif ( $type eq 'directory') {
      if (! &check_dir($value)) {
         &report(2, "$key requires an existing writable directory as an absolute path.");
         &abort("Illegal value: $value");
      }
      &set_param_value($key, $value);
   } elsif (defined(&type_enum_array($type))){
      &set_enum_param($key, $value);
   } else {
      &set_param_value($key, $value);
   }
}

### handle all action options 
# parameter 1: a option key
# parameter 2: the option value
# return value: none

sub handle_action_opt {
   my $key = $_[0];
   my $value = $_[1];

   if ($key eq 'help') {
      &print_help;
      
   } elsif ($key eq 'version') {
      &print_version;
      
   } elsif ($key eq 'configure') {
      if ( -f $RC_FILENAME ) {
         &read_configuration($RC_FILENAME);
      }
      &configure;
      &write_configuration($RC_FILENAME);
      &print_configuration;
      
   } elsif ($key eq 'print_config') {
      if ( -f $RC_FILENAME ) {
         &read_configuration($RC_FILENAME);
      }
      &print_configuration;

   } else {
      &print_usage; 
      exit 1;
   }
   exit 0;
}

### set a variable by a command line option to a possible values; abort on error
# parameter 1: parameter key
# parameter 2: value

sub set_enum_value {
   my ($key, $value) = @_;
   my $type;
   my $enum_array_ref;
   my @allowed_values=();

   $type = &param_type($key);
   $enum_array_ref = &type_enum_array($type);
   &abort("Internal error: No value array for parameter $key.")
      if(!defined($enum_array_ref));

   ### find out if the given value is allowed  
   foreach my $value_array_ref (${$enum_array_ref}) {
      if(${$value_array_ref}[0] eq $value) {
         ### found it, so it is okay!
         &set_param_value($key, $value);
	 return;
      }
   }

   ### value is not listed, so not allowed
   ### make a list of all allowed values
   foreach my $value_array_ref (${$enum_array_ref}) {
      push(@allowed_values, ${$value_array_ref}[0]);
   }

   &report(2, "\n$key allows: " . @allowed_values . ".\n");
   &abort("Illegal value: $value");
}

### configure an existing parameter interactively
# parameter 1: a parameter key
# return value: none

sub config_param {
   my $key = $_[0];
   my $type; 
   my $new_value;
   my $current_value;
   my $description;
   my $explanation;
   my $question;

   ### get required information about this parameter
   $type = &param_type($key); 
   $current_value = &param_value($key);
   ($description, $explanation, $question) = &param_config_output($key);

   ### tell the user the facts
   print "\n\n--------------------------------------------\n";