lib/NonameTV/FileStore.pm

   1 package NonameTV::FileStore;
   2
   3 use strict;
   4
   5 use NonameTV::Log qw/d p w f/;
   6
   7 use File::Slurp qw/read_file/;
   8 use LWP::Simple qw/get/;
   9 use Digest::MD5 qw/md5_hex/;
  10 use File::Path qw/mkpath/;
  11 use File::stat;
  12
  13 use Carp qw/croak carp/;
  14
  15 use utf8;
  16
  17 =begin nd
  18
  19 Class: NonameTV::FileStore
  20
  21 =cut
  22
  23 =begin nd:
  24
  25 Constructor: new
  26
  27 =cut
  28
  29 sub new #( $param )
  30 {
  31   my $class = ref( $_[0] ) || $_[0];
  32
  33   my $self = {};
  34   bless $self, $class;
  35
  36   # Copy the parameters supplied in the constructor.
  37   foreach my $key ( keys( %{ $_[1] } ) ) {
  38     $self->{$key} = ( $_[1] )->{$key};
  39   }
  40
  41   croak "Failed to specify Path"
  42       if not defined $self->{Path};
  43
  44   $self->{_fl} = {};
  45
  46   return $self;
  47 }
  48
  49 =begin nd
  50
  51 Method: AddFile
  52
  53 Add a new file to the filestore for a specific channel. If an
  54 identical file already exists (same filename and md5sum), no action is
  55 performed. If a file with the same name but different content exists,
  56 the old file is replaced with the new file.
  57
  58 Returns: undef
  59
  60 =cut
  61
  62 sub AddFile #( $xmltvid, $filename, $cref )
  63 {
  64   my $self = shift;
  65   my( $xmltvid, $filename, $cref ) = @_;
  66
  67   $self->LoadFileList( $xmltvid );
  68
  69   carp "Cannot add a file to a remote filestore"
  70       if not $self->PathIsLocal();
  71
  72   my $dir = $self->{Path} . "/$xmltvid";
  73
  74   mkpath( $dir );
  75
  76   my( $oldmd5, $ts ) = $self->GetFileMeta( $xmltvid, $filename );
  77
  78   my $newmd5 = md5_hex( $$cref );
  79   if( not defined( $oldmd5 ) ) {
  80     my $fullname = "$dir/$filename";
  81     open( OUT, "> $fullname" ) or die "Failed to write to $fullname";
  82     print OUT $$cref;
  83     close( OUT );
  84
  85     $self->AddFileMeta( $xmltvid, $filename, $newmd5 );
  86   }
  87   elsif( $oldmd5 ne $newmd5 ) {
  88     # Same filename but different content. Make up a new filename.
  89     my( $base, $ext ) = ($filename =~ /^(.*)(\..*?)$/);
  90     if( not defined $ext ) {
  91       $base = $filename;
  92       $ext = "";
  93     }
  94
  95     my $nextmd5;
  96     my $nextfilename;
  97
  98     for( my $c=1; $c<100; $c++ ) {
  99       $nextfilename = "$base-$c$ext";
 100       ( $nextmd5 ) = $self->GetFileMeta( $xmltvid, $nextfilename );
 101       if( (not defined( $nextmd5 )) or ($nextmd5 eq $newmd5) ) {
 102         last;
 103       }
 104     }
 105
 106     if( not defined( $nextmd5 ) ) {
 107       my $fullname = "$dir/$nextfilename";
 108       open( OUT, "> $fullname" ) or die "Failed to write to $fullname";
 109       print OUT $$cref;
 110       close( OUT );
 111
 112       $self->AddFileMeta( $xmltvid, $nextfilename, $newmd5 );
 113     }
 114   }
 115   else {
 116 #    print "Duplicate file skipped.\n";
 117   }
 118 }
 119
 120 sub AddFileMeta {
 121   my $self = shift;
 122   my( $xmltvid, $filename, $md5 ) = @_;
 123
 124   # Delete any entry with the same filename
 125   $self->{_fl}->{$xmltvid} =
 126       [ grep { $_->[0] ne $filename } @{$self->{_fl}->{$xmltvid}} ];
 127
 128   push @{$self->{_fl}->{$xmltvid}}, [ $filename, $md5, time()];
 129   $self->{_flmodified}->{$xmltvid} = 1;
 130 }
 131
 132 =begin nd
 133
 134 Method: ListFiles
 135
 136 Returns an array with arrayrefs, where each arrayref contains a
 137 filename, an md5sum, and a timestamp for when the file was first added.
 138
 139 =cut
 140
 141 sub ListFiles #( $xmltvid )
 142 {
 143   my $self = shift;
 144   my( $xmltvid ) = @_;
 145
 146   $self->LoadFileList( $xmltvid );
 147
 148   return @{$self->{_fl}->{$xmltvid}};
 149 }
 150
 151 =begin nd
 152
 153 Method: GetFile
 154
 155 Returns a reference to the contents of the specified file or undef
 156 if the file does not exist.
 157
 158 =cut
 159
 160 sub GetFile {
 161   my $self = shift;
 162   my( $xmltvid, $filename ) = @_;
 163
 164   my $fullname = $self->{Path} . "/$xmltvid/$filename";
 165
 166   my $result;
 167
 168   if( $self->PathIsLocal() ) {
 169     $result = read_file( $fullname, err_mode => 'quiet' );
 170   }
 171   else {
 172     $result = get( $fullname );
 173   }
 174
 175   return defined( $result ) ? \$result : undef;
 176 }
 177
 178 sub GetFileMeta {
 179   my $self = shift;
 180   my( $xmltvid, $filename ) = @_;
 181
 182   foreach my $e (@{$self->{_fl}->{$xmltvid}}) {
 183     return ($e->[1], $e->[2]) if $e->[0] eq $filename;
 184   }
 185
 186   return undef;
 187 }
 188
 189 =begin nd
 190
 191 Method: RemoveOldFiles
 192
 193 Remove all files for a specific channel that were added more than
 194 $days days ago.
 195
 196 =cut
 197
 198 sub RemoveOldFiles #( $xmltvid, $days )
 199 {
 200 }
 201
 202 sub PathIsLocal {
 203   my $self = shift;
 204
 205   return not $self->{Path} =~ /^http:/;
 206 }
 207
 208 sub LoadFileList {
 209   my $self = shift;
 210   my( $xmltvid ) = @_;
 211
 212   return if defined $self->{_fl}->{$xmltvid};
 213
 214   my @d;
 215
 216   my $fl = $self->GetFile( $xmltvid, "00files" );
 217
 218   if( not defined $fl ) {
 219     $self->RecreateIndex( $xmltvid );
 220     return;
 221   }
 222
 223   foreach my $line (split( "\n", $$fl)) {
 224     my( $filename, $md5sum, $ts ) = split( "\t", $line );
 225     push @d, [ $filename, $md5sum, $ts ];
 226   }
 227
 228   $self->{_fl}->{$xmltvid} = \@d;
 229   $self->{_flmodified}->{$xmltvid} = 0;
 230 }
 231
 232 =begin nd
 233
 234 Method: RecreateIndex
 235
 236 Recreate the index file from the files stored in the correct location.
 237
 238 =cut
 239
 240 sub RecreateIndex #( $xmltvid )
 241 {
 242   my $self = shift;
 243   my( $xmltvid ) = @_;
 244
 245   my @data;
 246
 247   unlink( $self->{Path} . "/$xmltvid/00files" );
 248
 249   foreach my $file (glob( $self->{Path} . "/$xmltvid/*" )) {
 250     my( $name ) = ($file =~ /.*\/(.*)/ );
 251     open(FILE, $file) or die "Can’t open ’$file’: $!";
 252     binmode(FILE);
 253
 254     my $md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
 255     my $st = stat($file) or die "Couldn't stat $file: $!";
 256     my $mtime = $st->mtime;
 257
 258     push( @data, [$name, $md5, $mtime] );
 259   }
 260
 261   $self->{_fl}->{$xmltvid} = [ sort { $a->[2] <=> $b->[2] } @data ];
 262   $self->{_flmodified}->{$xmltvid} = 1;
 263 }
 264
 265 sub WriteFileMeta {
 266   my $self = shift;
 267   my( $xmltvid ) = @_;
 268
 269   my $fullname = $self->{Path} . "/$xmltvid/00files";
 270   open( OUT, "> $fullname" ) or die "Failed to write to $fullname";
 271   foreach my $e (@{$self->{_fl}->{$xmltvid}}) {
 272     print OUT join( "\t", @{$e} ) . "\n";
 273   }
 274   close( OUT );
 275 }
 276
 277 sub DESTROY {
 278   my $self = shift;
 279
 280   foreach my $xmltvid (keys %{$self->{_flmodified}} ) {
 281     $self->WriteFileMeta( $xmltvid )
 282         if $self->{_flmodified}->{$xmltvid};
 283   }
 284 }
 285
 286 =head1 COPYRIGHT
 287
 288 Copyright (C) 2008 Mattias Holmlund.
 289
 290 =cut
 291
 292 1;
 293
 294 ### Setup coding system
 295 ## Local Variables:
 296 ## coding: utf-8
 297 ## End: