lib/Autom4te/C4che.pm

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