view release on metacpan or  search on metacpan

lib/TIGR/Foundation.pm  view on Meta::CPAN

         $pname = $1;
         $self->{program_name} = $pname ;
      }
      if ($self->{program_name} =~ /^-$/) {     # check if '-' is the input
         $self->{program_name} = "STDIN";
      }
      # Get the invocation.
      my $pcommand = join (' ', @ARGV);
      if ( defined $pcommand ) {
         $pcommand =~ /^(.*)$/;
         $pcommand = $1;
      }
      else {
         $pcommand = "";
      }
      $self->{invocation} = $pcommand ;

      # The following variables are to contain information specified by
      # the 'host' program; there are methods of setting and retrieving each.
      @{$self->{depend_info}} = ();
      $self->{version_handler} = undef; 
      $self->{version_info} = undef; 
      $self->{help_info} = undef; 
      $self->{usage_info} = undef; 

      # These are used for logging.
      $self->{debug_level} = -1;                # debug is negative, no logging
      @{$self->{debug_store}} = ();             # the backup debug level stack
      @{$self->{debug_queue}} = ();             # queue used by MSG routine
      @{$self->{error_queue}} = ();             # queue used by ERROR routine
      $self->{max_debug_queue_size} = 100;      # maximum size for queue before
                                                # log entries are expired
      @{$self->{log_files}} =                   # these log files are consulted
         ("$self->{program_name}.log",          # on file write error and are
          "/tmp/$self->{program_name}.$$.log"); # modified by setLogFile
      $self->{msg_file_open_flag} = 0;          # flag to check logLocal file
      $self->{error_file_open_flag} = 0;        # flag to check logError file
      $self->{msg_file_used} = 0;               # flag to indicate if log file
      $self->{error_file_used} = 0;             #   has been written to
      $self->{msg_append_flag} = 0;             # by default logs are truncated
      $self->{error_append_flag} = 0;           # by default logs are truncated
      $self->{log_append_setting} = 0;          # (truncate == 0)
      $self->{static_log_file} = undef;         # user defined log file

      # These monitor program execution time.
      $self->{start_time} = time;               # program start time
      $self->{finish_time} = undef;             # program stop time
      
      # Set a user name and a host name.
      $self->{'host_name'} = hostname();
      if ( ! defined ( $self->{'host_name'} ) ) {
         $self->{'host_name'} = "NOHOSTNAME";
      }
      else {
         $self->{'host_name'} =~ s/^(\.*)$/$1/; # Taint-check it.
      }

      # A __WARN__ handler is needed to keep this sane.
      my $tmp_warn_handler = $SIG{__WARN__} || "DEFAULT";
      $SIG{__WARN__} = sub {};
      my @info_arr = getpwuid($<);
      $self->{'user_name'} = $info_arr[0];
      $self->{'home_dir'} = $info_arr[7];
      $SIG{__WARN__} = $tmp_warn_handler;
      if ( ! defined ( $self->{'user_name'} ) ) {
         $self->{'user_name'} = "NOUSERNAME";
      }
      else {
         $self->{'user_name'} =~ s/^(\.*)$/$1/g;# Taint check.
      }
      if ( ! defined ( $self->{'home_dir'} ) ) {
         $self->{'home_dir'} = "/";
      }
      else {
         $self->{'home_dir'} =~ s/^(\.*)$/$1/g; # Taint check.
      }
     
      $self->logLocal("START: " . $self->{'program_name'} . " " .
         $self->{'invocation'}, 0);
      $self->logLocal("Username: " . $self->{'user_name'}, 0);
      $self->logLocal("Hostname: " . $self->{'host_name'}, 0);

      return $self;
   }



=item $value = $obj_instance->getProgramInfo($field_type);

This function returns field values for specified field types describing
attributes of the program.  The C<$field_type> parameter must be a listed
attribute: C<name>, C<invocation>, C<env_path>, C<abs_path>.
The C<name> field specifies the bare name of the executable.  The
C<invocation> field specifies the command line arguments passed to the
executable.   The C<env_path> value returns the environment path to the
working directory.  The C<abs_path> value specifies the absolute path to the
working directory.  If C<env_path> is found to be inconsistent, then that
value will return the C<abs_path> value.  If an invalid C<$field_type> is 
passed, the function returns undefined.  

=cut


   sub getProgramInfo($) {
      my $self = shift;
      my $field_type = shift;
      my $return_value = undef;
      if (defined $field_type) {
         $field_type =~ /^name$/ && do {
            $return_value = $self->{program_name};
         };
         $field_type =~ /^invocation$/ && do {
            $return_value = $self->{invocation};
         };
         $field_type =~ /^env_path$/ && do {
            my $return_value = "";
            if (
                (defined $ENV{'PWD'}) &&
                (abs_path($ENV{'PWD'}) eq abs_path(".") ) &&
                ($ENV{'PWD'} =~ /^(.*)$/)     
               ) {