lib/clive/Cache.pm

   1 # -*- coding: ascii -*-
   2 ###########################################################################
   3 # clive, command line video extraction utility.
   4 #
   5 # Copyright 2009 Toni Gundogdu.
   6 #
   7 # This file is part of clive.
   8 #
   9 # clive is free software: you can redistribute it and/or modify it under
  10 # the terms of the GNU General Public License as published by the Free
  11 # Software Foundation, either version 3 of the License, or (at your option)
  12 # any later version.
  13 #
  14 # clive is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  16 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
  17 # details.
  18 #
  19 # You should have received a copy of the GNU General Public License along
  20 # with this program. If not, see <http://www.gnu.org/licenses/>.
  21 ###########################################################################
  22 package clive::Cache;
  23
  24 use warnings;
  25 use strict;
  26
  27 use base 'Class::Singleton';
  28
  29 use clive::Video;
  30 use clive::Error qw(CLIVE_OK CLIVE_GREP);
  31
  32 use constant DEFAULT_DUMP_FORMAT => qq/%n: %t [%f, %mMB]/;
  33
  34 sub init {
  35     my $self = shift;
  36
  37     my $config = clive::Config->instance->config;
  38
  39     $self->{enabled} = 0;
  40
  41     eval("require BerkeleyDB");
  42     $self->{enabled} = 1
  43         if ( !$@ && !$config->{no_cache} );
  44
  45     if ( $self->{enabled} ) {
  46         require Digest::SHA;
  47
  48         my %cache;
  49         my $handle = tie(
  50             %cache, "BerkeleyDB::Hash",
  51             -Filename => $config->{cache_file},
  52             -Flags    => BerkeleyDB->DB_CREATE
  53         ) or die "error: cannot open $config->{cache_file}: $!\n";
  54
  55         $self->{handle} = $handle;
  56         $self->{cache}  = \%cache;
  57
  58         if ( $config->{cache_dump} ) {
  59             _dumpCache($self);
  60         }
  61         elsif ( $config->{cache_grep} ) {
  62             _grepCache($self);
  63         }
  64         elsif ( $config->{cache_clear} ) {
  65             _clearCache($self);
  66         }
  67     }
  68     else {
  69         if ( $config->{cache_dump} || $config->{cache_grep} ) {
  70             die "error: requires BerkeleyDB module\n";
  71         }
  72     }
  73 }
  74
  75 sub enabled {
  76     my $self = shift;
  77     return $self->{enabled};
  78 }
  79
  80 sub read {
  81     my $self = shift;
  82     return (1) if !$self->{enabled};
  83     return _mapRecord( $self, @_ );
  84 }
  85
  86 sub write {
  87     my $self = shift;
  88     return if !$self->{enabled};
  89     my $props = shift;
  90     my $hash  = Digest::SHA::sha1_hex( $$props->page_link );
  91     $self->{cache}{$hash} = $$props->toCacheRecord;
  92     $self->{handle}->db_sync();
  93 }
  94
  95 sub grepQueue {
  96     my $self = shift;
  97     $self->{grep_queue};
  98 }
  99
 100 sub _mapRecord {
 101     my ( $self, $props, $hash ) = @_;
 102     $hash = Digest::SHA::sha1_hex( $$props->page_link )
 103         if ( !$hash );
 104
 105     # Key order matters. Keep in sync with clive::Video::toCacheRecord order.
 106     if ( $self->{cache}{$hash} ) {
 107         my @values = split( /#/, $self->{cache}{$hash} );
 108         my @keys = qw(
 109             page_title      page_link      video_id      video_link
 110             video_host      video_format   file_length   file_suffix
 111             content_type    time_stamp
 112         );
 113         my $i = 0;
 114         my %record = map { $_ => $values[ $i++ ] } @keys;
 115         $$props->fromCacheRecord( \%record );
 116         return (1);
 117     }
 118     return (0);
 119 }
 120
 121 sub _dumpCache {
 122     my $self = shift;
 123
 124     my $config  = clive::Config->instance->config;
 125     my $dumpfmt = $config->{cache_dump_format} || DEFAULT_DUMP_FORMAT;
 126     my $props   = clive::Video->new
 127         ;                      # Reuse this rather than re-create it for each record.
 128
 129     my $i = 1;
 130     print _formatDump( $self, $dumpfmt, $_, \$props, $i++ ) . "\n"
 131         foreach ( keys %{ $self->{cache} } );
 132
 133     exit(CLIVE_OK);
 134 }
 135
 136 sub _grepCache {
 137     my $self = shift;
 138
 139     my $config  = clive::Config->instance->config;
 140     my $dumpfmt = $config->{cache_dump_format} || DEFAULT_DUMP_FORMAT;
 141     my $props   = clive::Video->new
 142         ;                      # Reuse this rather than re-create it for each record.
 143
 144     my $g
 145         = $config->{cache_ignore_case}
 146         ? qr|$config->{cache_grep}|i
 147         : qr|$config->{cache_grep}|;
 148
 149     $self->{grep_queue} = [];
 150     my $i = 1;
 151     foreach ( keys %{ $self->{cache} } ) {
 152         my $dumpstr = _formatDump( $self, $dumpfmt, $_, \$props, $i++ );
 153         my @e = split( /#/, $self->{cache}{$_} );
 154         if ( grep /$g/, @e ) {
 155             push( @{ $self->{grep_queue} }, $props->page_link );
 156             print "$dumpstr\n"
 157                 if ( $config->{cache_remove_record} );
 158         }
 159     }
 160
 161     if ( $config->{cache_remove_record} ) {
 162         if ( scalar( @{ $self->{grep_queue} } ) > 0 ) {
 163             print("Confirm delete (y/N):");
 164             $_ = lc <STDIN>;
 165             chomp;
 166             if ( lc $_ eq "y" ) {
 167                 foreach ( @{ $self->{grep_queue} } ) {
 168                     my $hash = Digest::SHA::sha1_hex($_);
 169                     delete $self->{cache}{$hash};
 170                 }
 171             }
 172             exit(CLIVE_OK);
 173         }
 174     }
 175     if ( scalar( @{ $self->{grep_queue} } ) == 0 ) {
 176         clive::Log->instance->err( CLIVE_GREP,
 177             "nothing matched $g in cache" );
 178         exit(CLIVE_GREP);
 179     }
 180 }
 181
 182 sub _formatDump {
 183     my ( $self, $dumpfmt, $hash, $props, $index ) = @_;
 184
 185     if ( _mapRecord( $self, $props, $hash ) ) {
 186         my $title  = $$props->page_title;
 187         my $id     = $$props->video_id;
 188         my $host   = $$props->video_host;
 189         my $len    = $$props->file_length;
 190         my $mb     = sprintf( "%.1f", clive::Util::toMB($len) );
 191         my $tstamp = $$props->time_stamp;
 192         my ( $date, $time ) = ( split( / /, $tstamp ) );
 193         my $format = $$props->video_format;
 194         $index = sprintf( "%04d", $index );
 195
 196         my $fmt = $dumpfmt;
 197         $fmt =~ s/%t/$title/g;
 198         $fmt =~ s/%i/$id/g;
 199         $fmt =~ s/%h/$host/g;
 200         $fmt =~ s/%l/$len/g;
 201         $fmt =~ s/%m/$mb/g;
 202         $fmt =~ s/%d/$date/g;
 203         $fmt =~ s/%T/$time/g;
 204         $fmt =~ s/%s/$tstamp/g;
 205         $fmt =~ s/%f/$format/g;
 206         $fmt =~ s/%n/$index/g;
 207
 208         return $fmt;
 209     }
 210     return "";
 211 }
 212
 213 sub _clearCache {
 214     my $self  = shift;
 215     my $count = 0;
 216     $self->{handle}->truncate($count);
 217     print "$count records truncated.\n";
 218     exit(CLIVE_OK);
 219 }
 220
 221 sub DESTROY {
 222     my $self = shift;
 223     $self->{handle} = undef;
 224     if ( $self->{cache} ) {
 225         untie( %{ $self->{cache} } );
 226     }
 227 }
 228
 229 1;
 230
 231 # Said a joker to the thief.