| # autoconf -- create 'configure' using m4 macros | |
| # Copyright (C) 2003, 2006, 2009-2017, 2020-2025 Free Software | |
| # Foundation, Inc. | |
| # This program is free software: you can redistribute it and/or modify | |
| # it under the terms of the GNU General Public License as published by | |
| # the Free Software Foundation, either version 3 of the License, or | |
| # (at your option) any later version. | |
| # | |
| # This program is distributed in the hope that it will be useful, | |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| # GNU General Public License for more details. | |
| # | |
| # You should have received a copy of the GNU General Public License | |
| # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
| package Autom4te::C4che; | |
| =head1 NAME | |
| Autom4te::C4che - a single m4 run request | |
| =head1 SYNOPSIS | |
| use Autom4te::C4che; | |
| =head1 DESCRIPTION | |
| This Perl module handles the cache of M4 runs used by autom4te. | |
| =cut | |
| use 5.006; | |
| use strict; | |
| use warnings FATAL => 'all'; | |
| use Carp; | |
| use Data::Dumper; | |
| use Autom4te::Request; | |
| =over 4 | |
| =item @request | |
| List of requests. | |
| Must be a package global so it can be accessed by code evaluated via | |
| 'eval', below. | |
| =cut | |
| our @request; | |
| =item C<$req = Autom4te::C4che-E<gt>retrieve (%attr)> | |
| Find a request with the same path and input. | |
| =cut | |
| 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; | |
| } | |
| =item C<$req = Autom4te::C4che-E<gt>register (%attr)> | |
| Create and register a request for these path and input. | |
| =cut | |
| # $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 = new Autom4te::Request ('path' => $attr{path}, | |
| 'input' => $attr{input}); | |
| push @request, $obj; | |
| # Assign an id for cache file. | |
| $obj->id ("$#request"); | |
| return $obj; | |
| } | |
| =item C<$req = Autom4te::C4che-E<gt>request (%request)> | |
| Get (retrieve or create) a request for the path C<$request{path}> and | |
| the input C<$request{input}>. | |
| =cut | |
| # $REQUEST-OBJ | |
| # request($SELF, %REQUEST) | |
| # ------------------------ | |
| sub request ($%) | |
| { | |
| my ($self, %request) = @_; | |
| my $req = | |
| Autom4te::C4che->retrieve (%request) | |
| || Autom4te::C4che->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 is 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; | |
| } | |
| =item C<$string = Autom4te::C4che-E<gt>marshall ()> | |
| Serialize all the current requests. | |
| =cut | |
| # marshall($SELF) | |
| # --------------- | |
| sub marshall ($) | |
| { | |
| my ($caller) = @_; | |
| my $marshall = Data::Dumper->new ([\@request], [qw (*request)]); | |
| $marshall->Indent(2)->Terse(0); | |
| # The Sortkeys method was added in Data::Dumper 2.12_01, so it is | |
| # available in 5.8.x and 5.6.2 but not in 5.6.1 or earlier. | |
| # Ignore failure of method lookup. | |
| eval { $marshall->Sortkeys(1); }; | |
| return $marshall->Dump . "\n"; | |
| } | |
| =item C<Autom4te::C4che-E<gt>save ($file, $version)> | |
| Save the cache in the C<$file> file object. | |
| =cut | |
| # SAVE ($FILE, $VERSION) | |
| # ---------------------- | |
| sub save ($$) | |
| { | |
| my ($self, $file, $version) = @_; | |
| confess "cannot save a single request\n" | |
| if ref ($self); | |
| $file->seek (0, 0); | |
| $file->truncate (0); | |
| print $file | |
| "# This file was generated by Autom4te $version.\n", | |
| "# It contains the lists of macros which have been traced.\n", | |
| "# It can be safely removed.\n", | |
| "\n", | |
| $self->marshall; | |
| } | |
| =item C<Autom4te::C4che-E<gt>good_version ($file, $version)> | |
| Succeed if the cache from the C<$file> file object is of the given version. | |
| =cut | |
| # GOOD_VERSION ($FILE, $VERSION) | |
| # ------------------------------ | |
| sub good_version ($$) | |
| { | |
| my ($self, $file, $version) = @_; | |
| my ($line) = $file->getline; | |
| return defined ($line) && $line eq "# This file was generated by Autom4te $version.\n"; | |
| } | |
| =item C<Autom4te::C4che-E<gt>load ($file)> | |
| Load the cache from the C<$file> file object. | |
| =cut | |
| # LOAD ($FILE) | |
| # ------------ | |
| 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 $@; | |
| } | |
| =head1 SEE ALSO | |
| L<Autom4te::Request> | |
| =head1 HISTORY | |
| Written by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>. | |
| =cut | |
| 1; # for require | |
| ### Setup "GNU" style for perl-mode and cperl-mode. | |
| ## Local Variables: | |
| ## perl-indent-level: 2 | |
| ## perl-continued-statement-offset: 2 | |
| ## perl-continued-brace-offset: 0 | |
| ## perl-brace-offset: 0 | |
| ## perl-brace-imaginary-offset: 0 | |
| ## perl-label-offset: -2 | |
| ## cperl-indent-level: 2 | |
| ## cperl-brace-offset: 0 | |
| ## cperl-continued-brace-offset: 0 | |
| ## cperl-label-offset: -2 | |
| ## cperl-extra-newline-before-brace: t | |
| ## cperl-merge-trailing-else: nil | |
| ## cperl-continued-statement-offset: 2 | |
| ## End: |