123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242 |
- package Autom4te::C4che;
- use Data::Dumper;
- use Autom4te::Request;
- use Carp;
- use strict;
- use vars qw(@request);
- sub retrieve($%)
- {
- my ($self, %attr) = @_;
- foreach (@request)
- {
-
- next
- if join ("\n", @{$_->path}) ne join ("\n", @{$attr{path}});
-
- next
- if join ("\n", @{$_->input}) ne join ("\n", @{$attr{input}});
-
- return $_;
- }
- return undef;
- }
- sub register ($%)
- {
- my ($self, %attr) = @_;
-
- my $obj = new Autom4te::Request ('path' => $attr{path},
- 'input' => $attr{input});
- push @request, $obj;
-
- $obj->id ("$#request");
- return $obj;
- }
- sub request ($%)
- {
- my ($self, %request) = @_;
- my $req =
- Autom4te::C4che->retrieve (%request)
- || Autom4te::C4che->register (%request);
-
- foreach (@{$request{'macro'}})
- {
- if (! exists ${$req->macro}{$_})
- {
- ${$req->macro}{$_} = 1;
- $req->valid (0);
- }
- }
-
-
-
- return $req;
- }
- sub marshall ($)
- {
- my ($caller) = @_;
- my $res = '';
- my $marshall = Data::Dumper->new ([\@request], [qw (*request)]);
- $marshall->Indent(2)->Terse(0);
- $res = $marshall->Dump . "\n";
- return $res;
- }
- sub save ($$)
- {
- my ($self, $file) = @_;
- confess "cannot save a single request\n"
- if ref ($self);
- $file->seek (0, 0);
- $file->truncate (0);
- print $file
- "# This file was generated.\n",
- "# It contains the lists of macros which have been traced.\n",
- "# It can be safely removed.\n",
- "\n",
- $self->marshall;
- }
- sub load ($$)
- {
- my ($self, $file) = @_;
- my $fname = $file->name;
- confess "cannot load a single request\n"
- if ref ($self);
- my $contents = join "", $file->getlines;
- eval $contents;
- confess "cannot eval $fname: $@\n" if $@;
- }
- 1;
|