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. |
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. |
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 |
|
|