← Back to branch summary

~ubuntu-branches/ubuntu/trusty/freeguide/trusty

« back to all changes in this revision

Viewing changes to xmltv/share/perl/5.8.8/XMLTV/Memoize.pm

  • Committer: Bazaar Package Importer
  • Author(s): Shaun Jackman
  • Date: 2007-09-11 16:52:59 UTC
  • mfrom: (1.2.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20070911165259-4r32oke21i1ezbmv
Tags: 0.10.5-1
http://bugs.debian.org/441762
* New upstream release.
* Update the watch file.
* Change Debian policy to version 3.7.2.2. No changes necessary.
* Add ant-optional to build dependencies. Closes: #441762.

Show diffs side-by-side

added added

removed removed

Lines of Context:
xmltv/share/perl/5.8.8/XMLTV/Memoize.pm
 
1
# Just some routines related to the Memoize module that are used in
 
2
# more than one place in XMLTV.  But not general enough to merge back
 
3
# into Memoize.
 
4
#
 
5
# $Id: Memoize.pm,v 1.15 2006/01/11 18:01:38 mattiasholmlund Exp $
 
6
#
 
7
 
 
8
package XMLTV::Memoize;
 
9
use strict;
 
10
use File::Basename;
 
11
use Getopt::Long;
 
12
 
 
13
# Use Log::TraceMessages if installed.
 
14
BEGIN {
 
15
    eval { require Log::TraceMessages };
 
16
    if ($@) {
 
17
        *t = sub {};
 
18
        *d = sub { '' };
 
19
    }
 
20
    else {
 
21
        *t = \&Log::TraceMessages::t;
 
22
        *d = \&Log::TraceMessages::d;
 
23
    }
 
24
}
 
25
 
 
26
# Add an undocumented option to cache things in a DB_File database.
 
27
# You need to decide which subroutines should be cached: see
 
28
# XMLTV::Get_nice for how to memoize web page fetches.  Call like
 
29
# this:
 
30
#
 
31
# if (check_argv('fred', 'jim')) {
 
32
#     # The subs fred() and jim() are now memoized.
 
33
# }
 
34
#
 
35
# If the user passed a --cache option to your program, this will be
 
36
# removed from @ARGV and caching will be turned on.  The optional
 
37
# argument to --cache gives the filename to use.
 
38
#
 
39
# Currently it is assumed that the function gives the same result in
 
40
# both scalar and list context.
 
41
#
 
42
# Note that the Memoize module is not loaded unless --cache options
 
43
# are found.
 
44
#
 
45
# Returns a ref to a list of code references for the memoized
 
46
# versions, if memoization happened (but does install the memoized
 
47
# versions under the original names too).  Returns undef if no
 
48
# memoization was wanted.
 
49
#
 
50
sub check_argv( @ ) {
 
51
#    local $Log::TraceMessages::On = 1;
 
52
    my $yes = 0;
 
53
    my $p = new Getopt::Long::Parser(config => ['passthrough']);
 
54
    die if not $p;
 
55
    my $opt_cache;
 
56
    my $opt_quiet = 0;
 
57
    my $result = $p->getoptions('cache:s' => \$opt_cache,
 
58
                                'quiet' => \$opt_quiet );
 
59
    die "failure processing --cache option" if not $result;
 
60
    unshift @ARGV, "--quiet" if $opt_quiet;
 
61
 
 
62
    return undef if not defined $opt_cache;
 
63
    my $filename;
 
64
    if ($opt_cache eq '') {
 
65
        # --cache given, but no filename.  Guess one.
 
66
        my $basename = File::Basename::basename($0);
 
67
        $filename = "$basename.cache";
 
68
    }
 
69
    else {
 
70
        $filename = $opt_cache;
 
71
    }
 
72
    print STDERR "using cache $filename\n" unless $opt_quiet;
 
73
 
 
74
    require POSIX;
 
75
    require Memoize;
 
76
    require DB_File;
 
77
    my @tie_args = ('DB_File', $filename,
 
78
                    POSIX::O_RDWR() | POSIX::O_CREAT(), 0666);
 
79
 
 
80
    # $from_caller is a sub which converts a function name into one
 
81
    # seen from the caller's namespace.  Namespaces do not nest, so if
 
82
    # it already has :: it should be left alone.
 
83
    #
 
84
    my $caller = caller();
 
85
    t "caller: $caller";
 
86
    my $from_caller = sub( $ ) {
 
87
        for (shift) {
 
88
            return $_ if /::/;
 
89
            return "${caller}::$_";
 
90
        }
 
91
    };
 
92
 
 
93
    # Annoyingly tie(%cache, @tie_args) doesn't work
 
94
    my %cache;
 
95
    tie %cache, 'DB_File', $filename,
 
96
      POSIX::O_RDWR() | POSIX::O_CREAT(), 0666;
 
97
    my @r;
 
98
    foreach (@_) {
 
99
        my $r = Memoize::memoize($from_caller->($_),
 
100
                                 SCALAR_CACHE => [ HASH => \%cache ],
 
101
                                 LIST_CACHE => 'MERGE');
 
102
        die "could not memoize $_" if not $r;
 
103
        push @r, $r;
 
104
    }
 
105
    return \@r;
 
106
}
 
107
 
 
108
1;