File Coverage

File:	/usr/local/share/autoconf/Autom4te/C4che.pm
Coverage:	94.4%

line	stmt	bran	cond	sub	pod	time	code
1							# autoconf -- create `configure' using m4 macros
2							# Copyright (C) 2003, 2006, 2009, 2010 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 3 of the License, or
7							# (at your option) 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, see <http://www.gnu.org/licenses/>.
16
17							package Autom4te::C4che;
18
19 - 31							=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
32
33	2758 2758 2758			2758		8724 3313 11805	use Data::Dumper;
34	2758 2758 2758			2758		18108 2974 23037	use Autom4te::Request;
35	2758 2758 2758			2758		9858 2382 8084	use Carp;
36	2758 2758 2758			2758		10086 2547 6961	use strict;
37
38 - 49							=over 4 =item @request List of requests. We cannot declare it "my" as the loading, performed via "do", would refer to another scope, and @request would not be updated. It used to work with "my" vars, and I do not know whether the current behavior (5.6) is wanted or not. =cut
50
51	2758 2758 2758			2758		9003 2425 6840	use vars qw(@request);
52
53 - 57							=item C<$req = Autom4te::C4che-E<gt>retrieve (%attr)> Find a request with the same path and input. =cut
58
59							sub retrieve($%)
60							{
61	2758			2758	1	8517	my ($self, %attr) = @_;
62
63	2758					8289	foreach (@request)
64							{
65							# Same path.
66							next
67	2639 2639 2639	50				4104 12983 10370	if join ("\n", @{$_->path}) ne join ("\n", @{$attr{path}});
68
69							# Same inputs.
70							next
71	2639 2639 2639	100				5451 9587 12258	if join ("\n", @{$_->input}) ne join ("\n", @{$attr{input}});
72
73							# Found it.
74	861					4061	return $_;
75							}
76
77	1897					21627	return undef;
78							}
79
80 - 84							=item C<$req = Autom4te::C4che-E<gt>register (%attr)> Create and register a request for these path and input. =cut
85
86							# $REQUEST-OBJ
87							# register ($SELF, %ATTR)
88							# -----------------------
89							# NEW should not be called directly.
90							# Private.
91							sub register ($%)
92							{
93	1897			1897	1	9191	my ($self, %attr) = @_;
94
95							# path and input are the only ID for a request object.
96	1897					20760	my $obj = new Autom4te::Request ('path' => $attr{path},
97							'input' => $attr{input});
98	1897					3947	push @request, $obj;
99
100							# Assign an id for cache file.
101	1897					19491	$obj->id ("$#request");
102
103	1897					9054	return $obj;
104							}
105
106
107 - 112							=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
113
114							# $REQUEST-OBJ
115							# request($SELF, %REQUEST)
116							# ------------------------
117							sub request ($%)
118							{
119	2758			2758	1	20081	my ($self, %request) = @_;
120
121	2758		67			16978	my $req =
122							Autom4te::C4che->retrieve (%request)
123							\|\| Autom4te::C4che->register (%request);
124
125							# If there are new traces to produce, then we are not valid.
126	2758 2758					5963 8038	foreach (@{$request{'macro'}})
127							{
128	190611 190611	100				154434 347668	if (! exists ${$req->macro}{$_})
129							{
130	94164 94164					86482 170386	${$req->macro}{$_} = 1;
131	94164					191003	$req->valid (0);
132							}
133							}
134
135							# It would be great to have $REQ check that it is up to date wrt
136							# its dependencies, but that requires getting traces (to fetch the
137							# included files), which is out of the scope of Request (currently?).
138
139	2758					9652	return $req;
140							}
141
142
143 - 147							=item C<$string = Autom4te::C4che-E<gt>marshall ()> Serialize all the current requests. =cut
148
149
150							# marshall($SELF)
151							# ---------------
152							sub marshall ($)
153							{
154	2742			2742	1	7772	my ($caller) = @_;
155	2742					5631	my $res = '';
156
157	2742					48872	my $marshall = Data::Dumper->new ([\@request], [qw (*request)]);
158	2742					234793	$marshall->Indent(2)->Terse(0);
159	2742					16830	$res = $marshall->Dump . "\n";
160
161	2742					1364726	return $res;
162							}
163
164
165 - 169							=item C<Autom4te::C4che-E<gt>save ($file)> Save the cache in the C<$file> file object. =cut
170
171							# SAVE ($FILE)
172							# ------------
173							sub save ($$)
174							{
175	2742			2742	1	12549	my ($self, $file) = @_;
176
177	2742	50				13743	confess "cannot save a single request\n"
178							if ref ($self);
179
180	2742					20285	$file->seek (0, 0);
181	2742					15420	$file->truncate (0);
182	2742					13384	print $file
183							"# This file was generated.\n",
184							"# It contains the lists of macros which have been traced.\n",
185							"# It can be safely removed.\n",
186							"\n",
187							$self->marshall;
188							}
189
190
191 - 195							=item C<Autom4te::C4che-E<gt>load ($file)> Load the cache from the C<$file> file object. =cut
196
197							# LOAD ($FILE)
198							# ------------
199							sub load ($$)
200							{
201	2758			2758	1	9367	my ($self, $file) = @_;
202	2758					13440	my $fname = $file->name;
203
204	2758	50				10112	confess "cannot load a single request\n"
205							if ref ($self);
206
207	2758					11224	my $contents = join "", $file->getlines;
208
209	2758					397946	eval $contents;
210
211	2758	50				16393	confess "cannot eval $fname: $@\n" if $@;
212							}
213
214
215 - 223							=head1 SEE ALSO L<Autom4te::Request> =head1 HISTORY Written by Akim Demaille E<lt>F<akim@freefriends.org>E<gt>. =cut
224
225							1; # for require
226
227							### Setup "GNU" style for perl-mode and cperl-mode.
228							## Local Variables:
229							## perl-indent-level: 2
230							## perl-continued-statement-offset: 2
231							## perl-continued-brace-offset: 0
232							## perl-brace-offset: 0
233							## perl-brace-imaginary-offset: 0
234							## perl-label-offset: -2
235							## cperl-indent-level: 2
236							## cperl-brace-offset: 0
237							## cperl-continued-brace-offset: 0
238							## cperl-label-offset: -2
239							## cperl-extra-newline-before-brace: t
240							## cperl-merge-trailing-else: nil
241							## cperl-continued-statement-offset: 2
242							## End: