share/autoconf/Autom4te/C4che.pm

   1 # autoconf -- create `configure' using m4 macros
   2 # Copyright (C) 2003, 2006  Free Software Foundation, Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2, or (at your option)
   7 # any later version.
   8
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  17 # 02110-1301, USA.
  18
  19 package Autom4te::C4che;
  20
  21 =head1 NAME
  22
  23 Autom4te::C4che - a single m4 run request
  24
  25 =head1 SYNOPSIS
  26
  27   use Autom4te::C4che;
  28
  29 =head1 DESCRIPTION
  30
  31 This Perl module handles the cache of M4 runs used by autom4te.
  32
  33 =cut
  34
  35 use Data::Dumper;
  36 use Autom4te::Request;
  37 use Carp;
  38 use strict;
  39
  40 =over 4
  41
  42 =item @request
  43
  44 List of requests.
  45
  46 We cannot declare it "my" as the loading, performed via "do", would
  47 refer to another scope, and @request would not be updated.  It used to
  48 work with "my" vars, and I do not know whether the current behavior
  49 (5.6) is wanted or not.
  50
  51 =cut
  52
  53 use vars qw(@request);
  54
  55 =item C<$req = Autom4te::C4che-E<gt>retrieve (%attr)>
  56
  57 Find a request with the same path and input.
  58
  59 =cut
  60
  61 sub retrieve($%)
  62 {
  63   my ($self, %attr) = @_;
  64
  65   foreach (@request)
  66     {
  67       # Same path.
  68       next
  69         if join ("\n", @{$_->path}) ne join ("\n", @{$attr{path}});
  70
  71       # Same inputs.
  72       next
  73         if join ("\n", @{$_->input}) ne join ("\n", @{$attr{input}});
  74
  75       # Found it.
  76       return $_;
  77     }
  78
  79   return undef;
  80 }
  81
  82 =item C<$req = Autom4te::C4che-E<gt>register (%attr)>
  83
  84 Create and register a request for these path and input.
  85
  86 =cut
  87
  88 # $REQUEST-OBJ
  89 # register ($SELF, %ATTR)
  90 # -----------------------
  91 # NEW should not be called directly.
  92 # Private.
  93 sub register ($%)
  94 {
  95   my ($self, %attr) = @_;
  96
  97   # path and input are the only ID for a request object.
  98   my $obj = new Autom4te::Request ('path'  => $attr{path},
  99                                    'input' => $attr{input});
 100   push @request, $obj;
 101
 102   # Assign an id for cache file.
 103   $obj->id ("$#request");
 104
 105   return $obj;
 106 }
 107
 108
 109 =item C<$req = Autom4te::C4che-E<gt>request (%request)>
 110
 111 Get (retrieve or create) a request for the path C<$request{path}> and
 112 the input C<$request{input}>.
 113
 114 =cut
 115
 116 # $REQUEST-OBJ
 117 # request($SELF, %REQUEST)
 118 # ------------------------
 119 sub request ($%)
 120 {
 121   my ($self, %request) = @_;
 122
 123   my $req =
 124     Autom4te::C4che->retrieve (%request)
 125     || Autom4te::C4che->register (%request);
 126
 127   # If there are new traces to produce, then we are not valid.
 128   foreach (@{$request{'macro'}})
 129     {
 130       if (! exists ${$req->macro}{$_})
 131         {
 132           ${$req->macro}{$_} = 1;
 133           $req->valid (0);
 134         }
 135     }
 136
 137   # It would be great to have $REQ check that it is up to date wrt
 138   # its dependencies, but that requires getting traces (to fetch the
 139   # included files), which is out of the scope of Request (currently?).
 140
 141   return $req;
 142 }
 143
 144
 145 =item C<$string = Autom4te::C4che-E<gt>marshall ()>
 146
 147 Serialize all the current requests.
 148
 149 =cut
 150
 151
 152 # marshall($SELF)
 153 # ---------------
 154 sub marshall ($)
 155 {
 156   my ($caller) = @_;
 157   my $res = '';
 158
 159   my $marshall = Data::Dumper->new ([\@request], [qw (*request)]);
 160   $marshall->Indent(2)->Terse(0);
 161   $res = $marshall->Dump . "\n";
 162
 163   return $res;
 164 }
 165
 166
 167 =item C<Autom4te::C4che-E<gt>save ($file)>
 168
 169 Save the cache in the C<$file> file object.
 170
 171 =cut
 172
 173 # SAVE ($FILE)
 174 # ------------
 175 sub save ($$)
 176 {
 177   my ($self, $file) = @_;
 178
 179   confess "cannot save a single request\n"
 180     if ref ($self);
 181
 182   $file->seek (0, 0);
 183   $file->truncate (0);
 184   print $file
 185     "# This file was generated.\n",
 186     "# It contains the lists of macros which have been traced.\n",
 187     "# It can be safely removed.\n",
 188     "\n",
 189     $self->marshall;
 190 }
 191
 192
 193 =item C<Autom4te::C4che-E<gt>load ($file)>
 194
 195 Load the cache from the C<$file> file object.
 196
 197 =cut
 198
 199 # LOAD ($FILE)
 200 # ------------
 201 sub load ($$)
 202 {
 203   my ($self, $file) = @_;
 204   my $fname = $file->name;
 205
 206   confess "cannot load a single request\n"
 207     if ref ($self);
 208
 209   my $contents = join "", $file->getlines;
 210
 211   eval $contents;
 212
 213   confess "cannot eval $fname: $@\n" if $@;
 214 }
 215
 216
 217 =head1 SEE ALSO
 218
 219 L<Autom4te::Request>
 220
 221 =head1 HISTORY
 222
 223 Written by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>.
 224
 225 =cut
 226
 227 1; # for require
 228
 229 ### Setup "GNU" style for perl-mode and cperl-mode.
 230 ## Local Variables:
 231 ## perl-indent-level: 2
 232 ## perl-continued-statement-offset: 2
 233 ## perl-continued-brace-offset: 0
 234 ## perl-brace-offset: 0
 235 ## perl-brace-imaginary-offset: 0
 236 ## perl-label-offset: -2
 237 ## cperl-indent-level: 2
 238 ## cperl-brace-offset: 0
 239 ## cperl-continued-brace-offset: 0
 240 ## cperl-label-offset: -2
 241 ## cperl-extra-newline-before-brace: t
 242 ## cperl-merge-trailing-else: nil
 243 ## cperl-continued-statement-offset: 2
 244 ## End: