C4che.pm 4.8 KB

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