ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/Cache/Cache.pm
(Generate patch)

Comparing COMP/SCRAM/src/Cache/Cache.pm (file contents):
Revision 1.2 by sashby, Fri Dec 10 13:41:39 2004 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;
82     my ($path) = @_;
83     opendir (DIR, $path) || die "$path: cannot read: $!\n";
84 <   # Skip .admin subdirectories too:
85 <   my @items = map { "$path/$_" } grep ($_ ne "." && $_ ne ".." && $_ ne ".admin", readdir(DIR));
84 >   # Skip .admin and CVS subdirectories too.
85 >   # Also skip files that look like backup files or files being modified with emacs:
86 >   my @items = map { "$path/$_" } grep (
87 >                                        $_ ne "." && $_ ne ".." && $_ ne "CVS" &&
88 >                                        $_ ne ".admin" && $_ !~ m|\.#*|,
89 >                                        readdir(DIR)
90 >                                        );  
91     closedir (DIR);
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 67 | 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 77 | Line 129 | sub checktree()
129     # non-directories unless $dofiles is set.  Considering only directories is
130     # dramatically faster.
131     next if ($path =~ /\.admin/); # skip .admin dirs
132 +   next if ($path =~ /.*CVS/);
133  
134     # NB: We stat each path only once ever.  The special "_" file handle uses
135     # the results from the last stat we've made.  See man perlfunc/stat.
# Line 169 | 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 186 | 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 196 | 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 223 | 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 289 | 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 296 | 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 322 | 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 350 | 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 374 | 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 382 | 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 390 | 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 417 | 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 428 | 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 447 | 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 455 | 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 463 | 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 470 | 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 479 | 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