ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/Cache/Cache.pm

Comparing COMP/SCRAM/src/Cache/Cache.pm (file contents):
Revision 1.4 by sashby, Tue Jun 28 19:08:55 2005 UTC vs.
Revision 1.7 by sashby, Mon Sep 11 13:48:33 2006 UTC

#	Line 10 | Line 10
10		# Copyright: 2003 (C) Shaun Ashby
11		#
12		#--------------------------------------------------------------------
13	+
14	+	=head1 NAME
15	+
16	+	Cache::Cache - A generic directory cache object.
17	+
18	+	=head1 SYNOPSIS
19	+
20	+	my $cacheobject=Cache::Cache->new();
21	+
22	+	=head1 DESCRIPTION
23	+
24	+	A package to provide caching of directory information. Directory timestamps
25	+	are tracked on further reading of an existing cache and lists of modified
26	+	directories and BuildFiles can be obtained.
27	+
28	+	=head1 METHODS
29	+
30	+	=over
31	+
32	+	=cut
33	+
34		package Cache::Cache;
35		require 5.004;
36
37		use Exporter;
38		@ISA=qw(Exporter);
39		#
40	+
41	+	=item   C<new()>
42	+
43	+	Create a new Cache::Cache object. The name of the cache is B<DirCache.db> by default.
44	+
45	+	=cut
46	+
47		sub new()
48		###############################################################
49		# new                                                         #
#	Line 42 | Line 70 | sub new()
70		return $self;
71		}
72
73	+	=item   C<getdir($path)>
74	+
75	+	Return a list of directories starting from $path.
76	+
77	+	=cut
78	+
79		sub getdir()
80		{
81		my $self=shift;
#	Line 58 | Line 92 | sub getdir()
92		return @items;
93		}
94
95	+	=item   C<prune($path)>
96	+
97	+	Recursively remove directories from the cache starting at $path.
98	+
99	+	=cut
100	+
101		sub prune()
102		{
103		my $self=shift;
#	Line 72 | Line 112 | sub prune()
112		}
113		}
114
115	+	=item   C<checktree($path, $required, $dofiles)>
116	+
117	+	A timestamp checking routine. Starting from $path, check all timestamps of
118	+	directories and their files. Skip all files unless $dofiles is 1.
119	+
120	+	=cut
121	+
122		sub checktree()
123		{
124		my ($self, $path, $required, $dofiles) = @_;
#	Line 175 | Line 222 | sub checktree()
222		}
223		}
224
225	+	=item   C<clean_cache_recursive($startdir)>
226	+
227	+	Recursive remove cached data for directories under $startdir.
228	+
229	+	=cut
230	+
231		sub clean_cache_recursive()
232		{
233		my $self=shift;
#	Line 192 | Line 245 | sub clean_cache_recursive()
245		return $self;
246		}
247
248	+	=item   C<dirtree($dir,$dofiles)>
249	+
250	+	Starting from $dir, scan the directory tree. Ignore files unless $dofiles is set. This
251	+	function just calls checktree().
252	+
253	+	=cut
254	+
255		sub dirtree()
256		{
257		my $self=shift;
#	Line 202 | Line 262 | sub dirtree()
262		return $self;
263		}
264
265	+	=item   C<checkfiles()>
266	+
267	+	Function to actually run the timestamp checks. This is only run from
268	+	SCRAM::CMD::build().
269	+
270	+	=cut
271	+
272		sub checkfiles()
273		{
274		my $self=shift;
#	Line 229 | Line 296 | sub checkfiles()
296		# Get list of files in config dir:
297		my $configcache = {};
298		my %configfiles = map { -f $_ &&
299	<	$_ =~ m|$ENV{LOCALTOP}/$ENV{SCRAM_CONFIGDIR}.*?$|
299	>	$_ =~ m|\Q$ENV{LOCALTOP}\E/$ENV{SCRAM_CONFIGDIR}.*?$|
300		? ($_ => [ (stat(_))[9] ]) : () } keys %{$self->{DIRCACHE}};
301
302		# Also add ToolCache.db to the cache: FIXME: should probably use aglob here so
#	Line 295 | Line 362 | sub checkfiles()
362		return $self;
363		}
364
365	+	=item   C<dircache()>
366	+
367	+	Return a reference to the directory cache hash.
368	+
369	+	=cut
370	+
371		sub dircache()
372		{
373		my $self=shift;
#	Line 302 | Line 375 | sub dircache()
375		return $self->{DIRCACHE};
376		}
377
378	+	=item   C<added_dirs($path)>
379	+
380	+	Add $path to the list of directories added since last scan, or return
381	+	the list of added directories if no argument given.
382	+
383	+	=cut
384	+
385		sub added_dirs()
386		{
387		my $self=shift;
#	Line 328 | Line 408 | sub added_dirs()
408		}
409		}
410
411	+	=item   C<modified_parentdirs($path)>
412	+
413	+	Add a directory $path to the list of parent directories (directories
414	+	having subdirectories), or return a reference to the list.
415	+	Storing this parent allows any update to be taken recursively from this
416	+	location.
417	+
418	+	=cut
419	+
420		sub modified_parentdirs()
421		{
422		my $self=shift;
#	Line 356 | Line 445 | sub modified_parentdirs()
445		}
446		}
447
448	+	=item   C<schedremoval($d)>
449	+
450	+	Add directory $d to list of directories that should be removed
451	+	recursively from the cache.
452	+	If no arguments given, return a reference to a list of
453	+	directories to be removed.
454	+
455	+	=cut
456	+
457		sub schedremoval()
458		{
459		my $self=shift;
#	Line 380 | Line 478 | sub schedremoval()
478		}
479		}
480
481	+	=item   C<filestatus()>
482	+
483	+	Return a true or false value depending on whether
484	+	a BuildFile was changed or not.
485	+
486	+	=cut
487	+
488		sub filestatus()
489		{
490		my $self=shift;
#	Line 388 | Line 493 | sub filestatus()
493		return $self->{STATUSSRC};
494		}
495
496	+	=item   C<configstatus()>
497	+
498	+	Return a true or false value depending on whether
499	+	a file in the config directory was changed or not.
500	+
501	+	=cut
502	+
503		sub configstatus()
504		{
505		my $self=shift;
#	Line 396 | Line 508 | sub configstatus()
508		return $self->{STATUSCONFIG};
509		}
510
511	+	=item   C<bf_for_scanning()>
512	+
513	+	Return a list of BuildFiles to re-read. Note that this is only done
514	+	if the status was changed (i.e. not necessary to read through the list
515	+	of BuildFiles to know whether something changed as the flag B<STATUSSRC>
516	+	is set as the source tree is checked).
517	+	If B<STATUSCONFIG> is true, all BuildFiles are marked to be read.
518	+
519	+	=cut
520	+
521		sub bf_for_scanning()
522		{
523		my $self=shift;
#	Line 423 | Line 545 | sub bf_for_scanning()
545		return $MODIFIED;
546		}
547
548	+	=item   C<paths()>
549	+
550	+	Return a reference to an array of directories for the current source tree.
551	+
552	+	=cut
553	+
554		sub paths()
555		{
556		my $self=shift;
#	Line 434 | Line 562 | sub paths()
562		# storing those that are relevant to an array:
563		foreach my $path (keys %{$self->{DIRCACHE}})
564		{
565	<	if ( ! -d $path && $path != m|$ENV{LOCALTOP}/$ENV{SCRAM_CONFIGDIR}.*?$|)
565	>	if ( ! -d $path && $path != m|\Q$ENV{LOCALTOP}\E/$ENV{SCRAM_CONFIGDIR}.*?$|)
566		{
567		$self->logmsg("SCRAM: $path no longer exists. Clearing from cache.\n");
568		$self->cachestatus(1);
#	Line 453 | Line 581 | sub paths()
581		return $self->{ALLDIRS};
582		}
583
584	+	=item   C<verbose()>
585	+
586	+	Turn verbosity for the cache on or off.
587	+
588	+	=cut
589	+
590		sub verbose()
591		{
592		my $self=shift;
#	Line 461 | Line 595 | sub verbose()
595		: $self->{VERBOSE}
596		}
597
598	+	=item   C<cachestatus()>
599	+
600	+	Set or return the cache status to indicate whether or not a file
601	+	timestamp has changed since the last pass.
602	+
603	+	=cut
604	+
605		sub cachestatus()
606		{
607		my $self=shift;
#	Line 469 | Line 610 | sub cachestatus()
610		: $self->{STATUS}
611		}
612
613	+	=item   C<logmsg(@message)>
614	+
615	+	Print a message to B<STDERR>. This is only used in
616	+	checktree(), checkfiles() and paths().
617	+
618	+	=cut
619	+
620		sub logmsg()
621		{
622		my $self=shift;
#	Line 476 | Line 624 | sub logmsg()
624		print STDERR @_ if $self->verbose();
625		}
626
627	+	=item   C<name()>
628	+
629	+	Set or return the name of the cache. Normally set
630	+	to B<DirCache.db> (and not architecture dependent).
631	+
632	+	=cut
633	+
634		sub name()
635		{
636		my $self=shift;
#	Line 485 | Line 640 | sub name()
640		}
641
642		1;
643	+
644	+	=back
645	+
646	+	=head1 AUTHOR
647	+
648	+	Shaun Ashby (with contribution from Lassi Tuura)
649	+
650	+	=head1 MAINTAINER
651	+
652	+	Shaun Ashby
653	+
654	+	=cut
655	+

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines