/[autoconf]/autoconf/bin/autom4te.in
ViewVC logotype

Diff of /autoconf/bin/autom4te.in

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.87 by akim, Thu Aug 21 17:50:11 2003 UTC revision 1.88 by akim, Fri Aug 22 08:09:12 2003 UTC
# Line 36  BEGIN Line 36  BEGIN
36    $ENV{'SHELL'} = '@SHELL@' if ($^O eq 'dos');    $ENV{'SHELL'} = '@SHELL@' if ($^O eq 'dos');
37  }  }
38    
39  ## --------- ##  use Autom4te::C4che;
 ## Request.  ##  
 ## --------- ##  
   
 package Request;  
   
 use Data::Dumper;  
 use Autom4te::FileUtils;  
 use Autom4te::General;  
 use Autom4te::Struct;  
 use Autom4te::XFile;  
 use Carp;  
 use strict;  
   
 # List of requests.  
 # We can't declare it `my' as the loading, performed via `do',  
 # would refer to another scope, and @request would not be updated.  
 # It used to work with `my' vars, and I don't know whether the current  
 # behavior (5.6) is wanted or not.  
 use vars qw(@request);  
   
 struct  
   (  
    # The key of the cache files.  
    'id' => "\$",  
    # True iff %MACRO contains all the macros we want to trace.  
    'valid' => "\$",  
    # The include path.  
    'path' => '@',  
    # The set of input files.  
    'input' => '@',  
    # The set of macros currently traced.  
    'macro' => '%',  
   );  
   
   
 # $REQUEST-OBJ  
 # retrieve ($SELF, %ATTR)  
 # -----------------------  
 # Find a request with the same path and input.  
 # Private.  
 sub retrieve  
 {  
   my ($self, %attr) = @_;  
   
   foreach (@request)  
     {  
       # Same path.  
       next  
         if join ("\n", @{$_->path}) ne join ("\n", @{$attr{path}});  
   
       # Same inputs.  
       next  
         if join ("\n", @{$_->input}) ne join ("\n", @{$attr{input}});  
   
       # Found it.  
       return $_;  
     }  
   
   return undef;  
 }  
   
   
 # $REQUEST-OBJ  
 # register ($SELF, %ATTR)  
 # -----------------------  
 # NEW should not be called directly.  
 # Private.  
 sub register ($%)  
 {  
   my ($self, %attr) = @_;  
   
   # path and input are the only ID for a request object.  
   my $obj = $self->new ('path'  => $attr{path},  
                         'input' => $attr{input});  
   push @request, $obj;  
   
   # Assign an id for cache file.  
   $obj->id ("$#request");  
   
   return $obj;  
 }  
   
   
 # $REQUEST-OBJ  
 # request($SELF, %REQUEST)  
 # ------------------------  
 # Return a request corresponding to $REQUEST{path} and $REQUEST{input},  
 # using a cache value if it exists.  
 sub request ($%)  
 {  
   my ($self, %request) = @_;  
   
   my $req = Request->retrieve (%request) || Request->register (%request);  
   
   # If there are new traces to produce, then we are not valid.  
   foreach (@{$request{'macro'}})  
     {  
       if (! exists ${$req->macro}{$_})  
         {  
           ${$req->macro}{$_} = 1;  
           $req->valid (0);  
         }  
     }  
   
   # It would be great to have $REQ check that it up to date wrt its  
   # dependencies, but that requires getting traces (to fetch the  
   # included files), which is out of the scope of Request  
   # (currently?).  
   
   return $req;  
 }  
   
 # Serialize a request or all the current requests.  
 sub marshall  
 {  
   my ($caller) = @_;  
   my $res = '';  
   
   if (ref ($caller))  
     {  
       # CALLER is an object: instance method.  
       my $marshall = Data::Dumper->new ([$caller]);  
       $marshall->Indent(2)->Terse(0);  
       $res = $marshall->Dump . "\n";  
     }  
   else  
     {  
       # CALLER is the package: class method.  
       my $marshall = Data::Dumper->new ([\@request], [qw (*request)]);  
       $marshall->Indent(2)->Terse(0);  
       $res = $marshall->Dump . "\n";  
     }  
   
   return $res;  
 }  
   
   
 # includes_p (@MACRO)  
 # -------------------  
 # Does this request covers all the @MACRO.  
 sub includes_p  
 {  
   my ($self, @macro) = @_;  
   
   foreach (@macro)  
     {  
       return 0  
         if ! exists ${$self->macro}{$_};  
     }  
   return 1;  
 }  
   
   
 # SAVE ($FILE)  
 # ------------  
 # Save the cache in the $FILE Autom4te::XFile object.  
 sub save  
 {  
   my ($self, $file) = @_;  
   
   croak "$me: cannot save a single request\n"  
     if ref ($self);  
   
   $file->seek (0, 0);  
   $file->truncate (0);  
   print $file  
     "# This file was created by $me.\n",  
     "# It contains the lists of macros which have been traced.\n",  
     "# It can be safely removed.\n",  
     "\n",  
     $self->marshall;  
 }  
   
   
 # LOAD ($FILE)  
 # ------------  
 # "eval" the content of the $FILE Autom4te::XFile object.  
 sub load  
 {  
   my ($self, $file) = @_;  
   my $fname = $file->name;  
   
   croak "$me: cannot load a single request\n"  
     if ref ($self);  
   
   my $contents = join "", $file->getlines;  
   
   eval $contents;  
   
   croak "$me: cannot eval $fname: $@\n" if $@;  
 }  
   
   
 ## ---------- ##  
 ## Autom4te.  ##  
 ## ---------- ##  
   
 package Autom4te;  
   
40  use Autom4te::ChannelDefs;  use Autom4te::ChannelDefs;
41  use Autom4te::Channels;  use Autom4te::Channels;
42  use Autom4te::FileUtils;  use Autom4te::FileUtils;
43  use Autom4te::General;  use Autom4te::General;
 use File::Basename;  
44  use Autom4te::XFile;  use Autom4te::XFile;
45    use File::Basename;
46  use strict;  use strict;
47    
48  # Data directory.  # Data directory.
# Line 1167  $icache_file = new Autom4te::XFile $icac Line 968  $icache_file = new Autom4te::XFile $icac
968  $icache_file->lock (LOCK_EX);  $icache_file->lock (LOCK_EX);
969    
970  # Read the cache index if available and older than autom4te itself.  # Read the cache index if available and older than autom4te itself.
971  # If autom4te is younger, then some structures such as Request, might  # If autom4te is younger, then some structures such as C4che, might
972  # have changed, which would corrupt its processing.  # have changed, which would corrupt its processing.
973  Request->load ($icache_file)  Autom4te::C4che->load ($icache_file)
974    if -f $icache && mtime ($icache) > mtime ($0);    if -f $icache && mtime ($icache) > mtime ($0);
975    
976  # Add the new trace requests.  # Add the new trace requests.
977  my $req = Request->request ('input' => \@ARGV,  my $req = Autom4te::C4che->request ('input' => \@ARGV,
978                              'path'  => \@include,                                      'path'  => \@include,
979                              'macro' => [keys %trace, @preselect]);                                      'macro' => [keys %trace, @preselect]);
980    
981  # If $REQ's cache files are not up to date, or simply if the user  # If $REQ's cache files are not up to date, or simply if the user
982  # discarded them (-f), declare it invalid.  # discarded them (-f), declare it invalid.
# Line 1219  else Line 1020  else
1020    
1021  # If we ran up to here, the cache is valid.  # If we ran up to here, the cache is valid.
1022  $req->valid (1);  $req->valid (1);
1023  Request->save ($icache_file);  Autom4te::C4che->save ($icache_file);
1024    
1025  exit $exit_code;  exit $exit_code;
1026    

Legend:
Removed from v.1.87  
changed lines
  Added in v.1.88

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26