diff options
| author | Andreas Brachold <vdr07@deltab.de> | 2007-11-10 17:53:53 +0000 |
|---|---|---|
| committer | Andreas Brachold <vdr07@deltab.de> | 2007-11-10 17:53:53 +0000 |
| commit | cfdd733c17cfa4f1a43b827a656e9e53cc2524ac (patch) | |
| tree | b6f659b1281f77628b36768f0888f67b65f9ca48 /lib/Class/MakeMethods/Utility/DiskCache.pm | |
| parent | 9c6c30350161efd74faa3c3705096aecb71c0e81 (diff) | |
| download | xxv-cfdd733c17cfa4f1a43b827a656e9e53cc2524ac.tar.gz xxv-cfdd733c17cfa4f1a43b827a656e9e53cc2524ac.tar.bz2 | |
* Remove unsed packages
* Reorder exit routines
Diffstat (limited to 'lib/Class/MakeMethods/Utility/DiskCache.pm')
| -rw-r--r-- | lib/Class/MakeMethods/Utility/DiskCache.pm | 165 |
1 files changed, 0 insertions, 165 deletions
diff --git a/lib/Class/MakeMethods/Utility/DiskCache.pm b/lib/Class/MakeMethods/Utility/DiskCache.pm deleted file mode 100644 index 653303c..0000000 --- a/lib/Class/MakeMethods/Utility/DiskCache.pm +++ /dev/null @@ -1,165 +0,0 @@ -package Class::MakeMethods::Utility::DiskCache; - -$VERSION = 1.008; - -@EXPORT_OK = qw( disk_cache ); -sub import { require Exporter and goto &Exporter::import } # lazy Exporter - -use strict; -use Carp; -use File::Spec; -use File::Path; - -######################################################################## - -use vars qw( $DiskCacheDir ); - -my $IndexFile = "methods.ix"; # file also serves as timestamp -my $FileEnding = ".mm"; - -sub import { - my $package = shift; - if ( scalar @_ ) { - $DiskCacheDir = shift; - } -} - -######################################################################## - -my %HaveCheckedFreshness; - -# $result = disk_cache( $package, $file, $sub, @args ); -sub disk_cache { - my ( $full_funct, $args_string, $function, @args ) = @_; - - unless ( $DiskCacheDir and -e $DiskCacheDir ) { - return &$function( @args ); - } - - my ($package, $func_name) = ( $full_funct =~ /^(.+)::(\w+)$/ ); - - my $pack_dir = File::Spec->catdir( $DiskCacheDir, split /::/, $package ); - if ( ! -e $pack_dir and -w $DiskCacheDir ) { - mkpath($pack_dir, 0, 07777); - } - - unless ( defined $HaveCheckedFreshness{$package} ) { - - my $idx = File::Spec->catfile( $pack_dir, $IndexFile ); - - my $signature = dependency_signature($package); - - if ( -e $idx and read_file( $idx ) eq $signature ) { - $HaveCheckedFreshness{$package} = 1; - } else { - if ( ! -w $pack_dir ) { - # The index is out of date, but not writable -- abandon it - $HaveCheckedFreshness{ $package } = 0; - } else { - rmtree($pack_dir, 0, 1); - mkpath($pack_dir, 0, 07777); - - write_file( $idx, $signature ); - $HaveCheckedFreshness{$package} = 1; - } - } - } - - unless ( $HaveCheckedFreshness{$package} ) { - return &$function( @args ); - } - - my $func_dir = File::Spec->catdir( $pack_dir, $func_name ); - - if ( ! -e $func_dir and -w $pack_dir ) { - mkpath($func_dir, 0, 07777); - } - my $file = File::Spec->catfile( $func_dir, $args_string . $FileEnding ); - - if ( -e $file ) { - return read_file( $file ); - } - - my $value = ( &$function( @args ) ); - - if ( -e $func_dir and -w $func_dir ) { - write_file( $file, $value ); - } else { - warn "Can't cache: $file\n"; - } - - return $value; -} - -######################################################################## - -sub dependency_signature { - my @sources = shift; - my @results; - no strict 'refs'; - while ( my $class = shift @sources ) { - push @sources, @{"$class\::ISA"}; - push @results, $class unless ( grep { $_ eq $class } @results ); - } - - foreach ( @results ) { - s!::!/!g; - $_ .= '.pm'; - } - return join "\n", map { $_ . ' '. (stat($::INC{ $_ }))[9] } @results; -} - -######################################################################## - -sub read_file { - my $file = shift; - # warn "Reading file: $file\n"; - local *FILE; - open FILE, "$file" or die "Can't open $file: $!"; - local $/ = undef; - return <FILE>; -} - -sub write_file { - my $file = shift; - # warn "Writing file: $file \n"; - local *FILE; - open FILE, ">$file" or die "Can't write to $file: $!"; - print FILE shift(); -} - -sub read_dir { - my $dir = shift; - local *DIR; - opendir(DIR, $dir); - readdir(DIR); -} - -######################################################################## - -1; - -__END__ - -=head1 NAME - -Class::MakeMethods::Utility::DiskCache - Optional Template feature - -=head1 SYNOPSIS - - use Class::MakeMethods::Utility::DiskCache qw( /my/code/dir ); - -=head1 DESCRIPTION - -To enable disk caching of Class::MakeMethods::Template generated -code, create an empty directory and pass it to the DiskCache package: - - use Class::MakeMethods::Utility::DiskCache qw( /my/code/dir ); - -This has a mixed effect on performance, but has the notable advantage of letting you view the subroutines that are being generated by your templates. - -=head1 SEE ALSO - -See L<Class::MakeMethods::Template> for more information. - -=cut
\ No newline at end of file |
