tools/picture-upload.pl

   1 #!/usr/bin/perl
   2
   3 use File::Temp;
   4 use File::Copy;
   5 use CGI;
   6 use C4::Context;
   7 use C4::Auth;
   8 use C4::Output;
   9 use C4::Members;
  10
  11 my $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
  12
  13 #my $destdir = "/usr/local/koha/intranet/htdocs/intranet-tmpl/images/patronpictures";
  14 #my $uploadfile = shift @ARGV;
  15 my $input = new CGI;
  16 my $destdir = C4::Context->config('intrahtdocs') . "/patronimages";
  17
  18 warn "DEST : $destdir";
  19 my ($template, $loggedinuser, $cookie)
  20         = get_template_and_user({template_name => "tools/picture-upload.tmpl",
  21                                         query => $input,
  22                                         type => "intranet",
  23                                         authnotrequired => 0,
  24                                         flagsrequired => {management => 1, tools => 1},
  25                                         debug => 0,
  26                                         });
  27
  28 unless (-d $destdir) {
  29         $errors{'NODIR'} = 1;
  30         warn "patronimages directory not present";
  31 }
  32 if ( %errors ) {
  33     $template->param( ERRORS => [ \%errors ] );
  34 }
  35 my $uploadfilename = $input->param( 'uploadfile' );
  36 my $uploadfile = $input->upload( 'uploadfile' );
  37 my ( $total, $handled, @counts );
  38
  39 if ( $uploadfile ) {
  40     my $dirname = File::Temp::tempdir( CLEANUP => 1);
  41     warn "dirname = $dirname" if $DEBUG;
  42     my ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => '.zip', UNLINK => 1 );
  43     warn "tempfile = $tempfile" if $DEBUG;
  44     my ( @directories, %errors );
  45
  46     $errors{'NOTZIP'} = 1 unless ( $uploadfilename =~ /\.zip$/i );
  47     $errors{'NOWRITETEMP'} = 1 unless ( -w $dirname );
  48     $errors{'NOWRITEDEST'} = 1 unless ( -w $destdir );
  49     $errors{'EMPTYUPLOAD'} = 1 unless ( length( $uploadfile ) > 0 );
  50
  51     if ( %errors ) {
  52         $template->param( ERRORS => [ \%errors ] );
  53     } else {
  54         while ( <$uploadfile> ) {
  55             print $tfh $_;
  56         }
  57
  58         close $tfh;
  59
  60         system("unzip $tempfile -d $dirname");
  61
  62         push @directories, "$dirname";
  63         foreach $recursive_dir ( @directories ) {
  64             opendir $dir, $recursive_dir;
  65             while ( my $entry = readdir $dir ) {
  66                         push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
  67                         warn "$recursive_dir/$entry" if $DEBUG;
  68             }
  69             closedir $dir;
  70         }
  71
  72         foreach my $dir ( @directories ) {
  73             $handled += handle_dir( $dir );
  74         }
  75
  76         $total = scalar @directories;
  77         warn "Total files processed: $total" if $DEBUG;
  78         $template->param(
  79                          TOTAL => $total,
  80                          HANDLED => $handled,
  81                          COUNTS => \@counts,
  82                          TCOUNTS => scalar(@counts),
  83                          );
  84     }
  85 }
  86
  87 output_html_with_http_headers $input, $cookie, $template->output;
  88
  89 sub handle_dir {
  90     warn "Entering sub handle_dir" if $DEBUG;
  91     my ( $dir ) = @_;
  92     my ( %count );
  93     my $file;
  94     $count{filenames} = ();
  95
  96     my $mimemap = {
  97         "gif"   => "image/gif",
  98         "jpg"   => "image/jpeg",
  99         "jpeg"  => "image/jpeg",
 100         "png"   => "image/png"
 101     };
 102
 103     opendir my $dirhandle, $dir;
 104     while ( my $filename = readdir $dirhandle ) {
 105         $file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i);
 106     }
 107     unless (open (FILE, $file)) {
 108                 warn "Opening $dir/$file failed!" if $DEBUG;
 109                 return 0;
 110         };
 111
 112     while (my $line = <FILE>) {
 113         warn "Reading contents of $file" if $DEBUG;
 114         chomp $line;
 115         warn "Examining line: $line" if $DEBUG;
 116         my ( $filename, $cardnumber );
 117         my $delim = ($line =~ /\t/) ? "\t" : ",";
 118         warn "Delimeter is \'$delim\'" if $DEBUG;
 119         ($cardnumber, $filename) = split $delim, $line;
 120         $cardnumber =~ s/[\"\r\n]//g;  # remove offensive characters
 121         $filename   =~ s/[\"\r\n\s]//g;
 122         warn "Cardnumber: $cardnumber Filename: $filename" if $DEBUG;
 123         if ($cardnumber && $filename) {
 124             warn "Source: $dir/$filename" if $DEBUG;
 125             open (IMG, "$dir/$filename") or warn "Could not open $dir/$filename";
 126             #binmode (IMG); # Not sure if we need this or not -fbcit
 127             my $imgfile;
 128             while (<IMG>) {
 129                 $imgfile .= $_;
 130             }
 131             my $mimetype = $mimemap->{lc ($1)} if $filename =~ m/\.([^.]+)$/i;
 132             warn "$filename is mimetype \"$mimetype\"" if $DEBUG;
 133             my $dberror = PutPatronImage($cardnumber,$mimetype, $imgfile) if $mimetype;
 134 #            warn "Database says: $dberror" if $dberror;
 135             close (IMG);
 136             unless ( $dberror || !$mimetype ) {
 137                 $count{count}++;
 138                 push @{ $count{filenames} }, { source => $filename, dest => $cardnumber };
 139             }
 140         }
 141     }
 142     $count{source} = $dir;
 143     $count{dest} = $destdir;
 144     push @counts, \%count;
 145     close FILE;
 146     return 1;
 147 }