summaryrefslogtreecommitdiff
path: root/lib/Class/MakeMethods/Utility/DiskCache.pm
diff options
context:
space:
mode:
authorAndreas Brachold <vdr07@deltab.de>2007-11-10 17:53:53 +0000
committerAndreas Brachold <vdr07@deltab.de>2007-11-10 17:53:53 +0000
commitcfdd733c17cfa4f1a43b827a656e9e53cc2524ac (patch)
treeb6f659b1281f77628b36768f0888f67b65f9ca48 /lib/Class/MakeMethods/Utility/DiskCache.pm
parent9c6c30350161efd74faa3c3705096aecb71c0e81 (diff)
downloadxxv-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.pm165
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