tex2pdf

lustre 1.6.5 source code

#  'color'       => \@VALUES,
#  'destination' => \@VALUES,
#  'paper'       => \@VALUES,
#  'action'      => undef,
#  'three'       => undef,
#  'bool'        => undef,
#  'integer'     => undef,
#  'text'        => undef,
#  'directory'   => undef

##### Functions ###########################################

### handle a status report with a given priority level
# write it to the log file if log file if configuration is done
# write it to stdout if verbosity is set lower or equal
#
# The following priority levels exist:
# 1: minimal fatal error messages
# 2: additional information about fatal error
# 3: non-fatal error message 
# 4: warning
# 5: major step of the process
# 6: minor step of the process
# 7: progress report of minor step
# 8: long status report from called applications
# 9: debug info
#
# parameter 1: priority level
# parameter 2: list of output strings
# return value: none

sub report {
   my $level;
   my $verbosity;
   my $log_verbosity;
   my @output;

   if (@_ < 2 ) {
      @output = ( "Oppss! Report function got only 1 argument!" );
      $level  = 9;
   } else {
      ($level, @output) = @_;
   }

   if($CONFIGURED) {
      if( &param_value('debug') eq $NO ) {
         $verbosity = &param_value('verbosity');
         $log_verbosity = $LOGFILE_VERBOSITY;
      } else {
         $verbosity = 9;
         $log_verbosity = 9;
      } 
   } else {
      $verbosity = $PRE_CONFIG_VERBOSITY;
      $log_verbosity = $LOGFILE_VERBOSITY;
   }

   if ( $level <= $log_verbosity ) {
      open LOGFILE, ">> $MYLOGFILE";
      print LOGFILE @output,"\n";
      close LOGFILE;
   }

   if( $level <= $verbosity ) {
      print @output,"\n";
   }
}

### process system command and do the appropriate reports
# parameter 1: the system command to process
# parameter 2: flag - TRUE: abort on failure, FALSE: continue on failures
# parameter 3: priority level for output of system command
# parameter 4: specific failure message
# return value: TRUE - success, FALSE - failure 

sub system_command {
   my $command = $_[0];
   my $fatal_failure= $_[1];
   my $output_priority = $_[2];
   my $fail_message = $_[3];
   my $system_out;

   $system_out = `$command 2>&1`;

   if ($?) {
      if ($fatal_failure) {
         &report(2, $system_out) if ($system_out);
         &abort($fail_message.": $!");
      } else {
         &report($output_priority, $system_out) if ($system_out);
         &report(3, $fail_message.": $!");
      }
      return $FALSE;
   }

   return $TRUE;
}

### Index of the first occurence of a string in an array
# parameter 1: text
# parameter 2: list
# return value: index or -1 if not element of the array 

sub array_index {
   my ($text, @list) = @_;

   if(!defined($text)) {
      &report(9, "Oppss! Cannot compare nothing.");
      return -1;
   }

   foreach (0..$#list) {
      if ( $list[$_] eq $text ) { return $_; }
   }
   
   return -1;
}

### extract the last N lines of a text file
# abort on failures
# parameter 1: file to read
# parameter 2: N - number of lines to print (undef/0: all lines)
# return value: last N lines 

sub file_tail {
   my $file_name = $_[0];
   my $no_of_lines = defined($_[1]) ? $_[1] : 0;
   my @cache=();

   &check_file($file_name);
   open(TAIL_SOURCE, "<$file_name")
      or &abort("Could not read file $file_name: $!");

   if($no_of_lines == 0) {
      # use entire file
      while(<TAIL_SOURCE>) {
         if(!$_) { $_="\n"; }
         push(@cache, $_);
      }
   } else {
      # only last N lines
   
      # fill up cache
      while(@cache < $no_of_lines and <TAIL_SOURCE>) {
         if(!$_) { $_="\n"; }
         push(@cache, $_);
      }
   
      # always cache the last N lines up to the end of the file
      while(<TAIL_SOURCE>) {
         if(!$_) { $_="\n"; }
         shift(@cache);
         push(@cache, $_);
      }
   }
   
   close TAIL_SOURCE;

   return @cache;
}

### return all lines of FILE which match match regexp EXPR 
# parameter 1: FILE - file to read
# parameter 2: EXPR - regular expression to match
# parameter 3: true: exit on first occurence, otherwise get all (default: false)
# return value: array of matching lines

sub grep_file {
   my $file_name = $_[0];
   my $regexp = $_[1];
   my $first_only = $_[2] ? $TRUE : $FALSE;
   my @result=();

   ### open file and abort if not possible
   &check_file($file_name);
   open(GREP_SOURCE, "<$file_name")
      or &abort("Could not read file $file_name: $!");

   while(<GREP_SOURCE>) {
      if(m#$regexp#) {
         push(@result, $_);
         if($first_only) { last; }
      }
   }

   close GREP_SOURCE;
   return @result;
}
   
### Removing all temporary files

sub clean_up {
   &report(6, "Removing temporary files ...");
   foreach (@TMPFILES) {
      unlink($_) if(-f $_); 
   }

   foreach (@TMP_TEX_FILES) {
      # make sure that we have a good tex file name in order
      # to avoid unintended removals
      if( $_ ne "" and -f $_.'.tex' ) {
         unlink glob($_.".???"); 
      } else {
         &report(3, "Bad file in temp tex files list: $_");
      }
   }
}

### Output of all temp files

sub print_temp_files {
   if (scalar @TMPFILES > 0) {
      print "Stored the following explicit temporary files:\n";
      foreach (@TMPFILES) {
         if (-f $_) {
            print "> ".$_."\n";
         } else {
	    print "> ".$_." (does not exist)\n";
         }
      }
      print "\n";
   }
   
   if (scalar @TMP_TEX_FILES > 0) {
      print "Stored the following temporary TeX base names:\n";
      foreach (@TMP_TEX_FILES) {
         if( $_ ne "" and -f $_.'.tex' ) {
            print "> ".$_.": "; 
            foreach my $file (glob($_.".???")) {
	       print basename($file)." ";
	    }
            print "\n"; 
         } else {
            print "> ".$_.": bad file for temp TeX file\n";
         }
      }
      print "\n";
   }
}

###  exit with an error message

sub abort {
   &report(1, @_);
   if ( $CONFIGURED and &param_value('clean_on_abort') eq $YES 
       and &param_value('debug') eq $NO) {
      &clean_up;
   } else {
      &print_temp_files;
   }
   &report(2, "Aborting ...");
   exit 1;
}

### Check for required command with 'which'; abort if not found
# parameter $1: command to check
# parameter $2: remark if specified command is not found

sub checkCommand {
   my $command = $_[0];
   my $message = $_[1];
   my $which_output;

   $which_output = `which $command 2>&1`; 
   chomp $which_output;
   $_ = $which_output;
   s|^(.*/)?([^/]+)$|$2|;

   if ( $_ ne $command ) {
      &report(2, "\n$which_output");
      &report(1, "\nRequired command '$command' seems not to be in your path.");
      if ( defined($message) ) {
         &report(2, "$message");
      }
      &report(2, "Aborting ...");
      exit 1;
   }
}

###################### Generic configuration functions

### interactively answer a question with yes or no
# parameter 1: question
# parameter 2: default value (not set means $NIL)
# parameter 3: yes: allow undefined as third value
#              no : only yes/no allowed (default)
# return value: the given answer

sub question_ynu {
   my $user_input;
   my $question = $_[0];
   my $default = defined($_[1]) ? $_[1] : $NIL;
   my $undef_allowed = $_[2];
   my $response = undef;

   if (defined($undef_allowed) and $undef_allowed eq $YES) {
      $undef_allowed = $TRUE;
   } else {
      $undef_allowed = $FALSE;
   }

   if( $default =~ /^y(es)?/i ) {
      $question .= ' [y]: ';
      $default = $YES;
   } elsif ( $default eq $NIL and $undef_allowed ) {
      $question .= ' [u]: ';
      $default = $NIL;
   } else {
      $question .= ' [n]: ';
      $default = $NO;
   }
   while (! defined($response)) {
      print $question;
      $user_input = <STDIN>;
      chomp($user_input);
      
      if( $user_input =~ /^y(es)?/i ) {
         $response=$YES;
      } elsif ( $user_input =~ /^no?/i ) {
         $response=$NO;
      } elsif ( $user_input =~ /^u(ndef(ined)?)?/i and $undef_allowed ) {
         $response=$NIL;
      } elsif ( $user_input eq "" ) {
         $response=$default;
      } else {
         print "Please respond with y(es)";
         print ", u(ndefined)" if($undef_allowed);
         print " or n(o).\n";
      }
   }
   return $response;
}

### interactively input a positive integer number
# parameter 1: question
# parameter 2: default value
# parameter 3: min value
# parameter 4: max value
# return value: the input number

sub input_number {
   my $question = $_[0];
   my $default = $_[1];
   my $min_limit = $_[2];
   my $max_limit = $_[3];
   my $response= undef;

   while (! defined($response)) {
      print "$question [$default]: ";
      my $user_input = <STDIN>;
      chomp($user_input);
      
      if ($user_input eq "") {
         $response=$default;
      } else {
         $_ = $user_input;
         if (s/^([0-9]+)$/$1/ and $_ >= $min_limit and $_ <= $max_limit ) {
            $response = $_;
	 } else {
            print "Invalid input. Please enter a positve integer from $min_limit to $max_limit.\n";
         }
      }
   }
   return $response;
}

### interactively choose between several given values
# parameter 1: question
# parameter 2: default value
# parameter 3: reference to an array of possible values arrays
# return value: the chosen value

sub choose_value {
   my ($question, $default, $enum_array_ref)=@_;
   my $default_no=1;
   my $chosen_no;
   my @possible_values = @$enum_array_ref;
   my @value_array;
   my $value_key;
   my $value_output;

   print "$question\n";
   foreach (0..$#possible_values) {
      my $no     = $_ + 1;
      @value_array  = @{$possible_values[$_]};
      $value_key    = $value_array[0];
      $value_output = $value_array[1];

      print "$no) " . $value_output . "\n";
      if ( $default eq $value_key ) { $default_no=$no; }
   }

   $chosen_no=&input_number("Please enter the corresponding number", $default_no, 1, $#possible_values);

   @value_array  = @{$possible_values[$chosen_no - 1]};
   $value_key    = $value_array[0];
   return $value_key;
}

### interactively answer a question
# parameter 1: question
# parameter 2: current value
# return value: the new value

sub input_text {
   my $question=$_[0];
   my $default=$_[1];
   my $response= undef;