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 use Data::Dumper;
  11
  12 my $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
  13
  14 my $input = new CGI;
  15
  16 my ($template, $loggedinuser, $cookie)
  17         = get_template_and_user({template_name => "tools/picture-upload.tmpl",
  18                                         query => $input,
  19                                         type => "intranet",
  20                                         authnotrequired => 0,
  21                                         flagsrequired => {management => 1, tools => 1},
  22                                         debug => 0,
  23                                         });
  24
  25 my $uploadfilename = $input->param( 'uploadfile' );
  26 my $uploadfile = $input->upload( 'uploadfile' );
  27 my ( $total, $handled, @counts );
  28
  29 if ( $uploadfile ) {
  30     my $dirname = File::Temp::tempdir( CLEANUP => 1);
  31     warn "dirname = $dirname" if $DEBUG;
  32     my ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => '.zip', UNLINK => 1 );
  33     warn "tempfile = $tempfile" if $DEBUG;
  34     my ( @directories, $errors );
  35
  36     $errors{'NOTZIP'} = 1 unless ( $uploadfilename =~ /\.zip$/i );
  37     $errors{'NOWRITETEMP'} = 1 unless ( -w $dirname );
  38     $errors{'EMPTYUPLOAD'} = 1 unless ( length( $uploadfile ) > 0 );
  39
  40     if ( %errors ) {
  41         $template->param( ERRORS => [ \%errors ] );
  42     } else {
  43         while ( <$uploadfile> ) {
  44             print $tfh $_;
  45         }
  46
  47         close $tfh;
  48
  49         unless (system("unzip $tempfile -d $dirname") == 0) {
  50             $errors{'UZIPFAIL'} = $uploadfilename;
  51             $template->param( ERRORS => [ \%errors ] );
  52             output_html_with_http_headers $input, $cookie, $template->output;   # This error is fatal to the import, so bail out here
  53             exit;
  54         }
  55         push @directories, "$dirname";
  56         foreach $recursive_dir ( @directories ) {
  57             opendir $dir, $recursive_dir;
  58             while ( my $entry = readdir $dir ) {
  59             push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
  60             warn "$recursive_dir/$entry" if $DEBUG;
  61             }
  62             closedir $dir;
  63         }
  64         my $results;
  65         foreach my $dir ( @directories ) {
  66             $results = handle_dir( $dir );
  67             $handled++ if $results == 1;
  68         }
  69
  70         if ( %$results || %errors ) {
  71             $template->param( ERRORS => [ \%$results ] );
  72         } else {
  73             $total = scalar @directories;
  74             warn "Total files processed: $total" if $DEBUG;
  75             warn "Errors in \$errors." if $errors;
  76             $template->param(
  77                  TOTAL => $total,
  78                  HANDLED => $handled,
  79                  COUNTS => \@counts,
  80                  TCOUNTS => scalar(@counts),
  81             );
  82         }
  83     }
  84 }
  85
  86 output_html_with_http_headers $input, $cookie, $template->output;
  87
  88 sub handle_dir {
  89     warn "Entering sub handle_dir" if $DEBUG;
  90     my ( $dir ) = @_;
  91     my ( %count );
  92     my $file;
  93     $count{filenames} = ();
  94
  95     my $mimemap = {
  96         "gif"   => "image/gif",
  97         "jpg"   => "image/jpeg",
  98         "jpeg"  => "image/jpeg",
  99         "png"   => "image/png"
 100     };
 101
 102     opendir my $dirhandle, $dir;
 103     while ( my $filename = readdir $dirhandle ) {
 104         $file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i);
 105     }
 106     unless (open (FILE, $file)) {
 107                 warn "Opening $dir/$file failed!";
 108                 $errors{'OPNLINK'} = $file;
 109                 return $errors; # This error is fatal to the import of this directory contents, so bail and return the error to the caller
 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" : ($line =~ /,/) ? "," : "";
 118         warn "Delimeter is \'$delim\'" if $DEBUG;
 119         unless ( $delim eq "," || $delim eq "\t" ) {
 120             warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
 121             $errors{'DELERR'} = 1;      # This error is fatal to the import of this directory contents, so bail and return the error to the caller
 122             return $errors;
 123         }
 124         ($cardnumber, $filename) = split $delim, $line;
 125         $cardnumber =~ s/[\"\r\n]//g;  # remove offensive characters
 126         $filename   =~ s/[\"\r\n\s]//g;
 127         warn "Cardnumber: $cardnumber Filename: $filename" if $DEBUG;
 128         if ($cardnumber && $filename) {
 129             my %filerrors;
 130             warn "Source: $dir/$filename" if $DEBUG;
 131             if (open (IMG, "$dir/$filename")) {
 132                 #binmode (IMG); # Not sure if we need this or not -fbcit
 133                 my $imgfile;
 134                 while (<IMG>) {
 135                     $imgfile .= $_;
 136                 }
 137                 my $mimetype = $mimemap->{lc ($1)} if $filename =~ m/\.([^.]+)$/i;
 138                 warn "$filename is mimetype \"$mimetype\"" if $DEBUG;
 139                 my $dberror = PutPatronImage($cardnumber,$mimetype, $imgfile) if $mimetype;
 140                 close (IMG);
 141                 if ( !$dberror && $mimetype ) { # Errors from here on are fatal only to the import of a particular image, so don't bail, just note the error and keep going
 142                     $count{count}++;
 143                     push @{ $count{filenames} }, { source => $filename, cardnumber => $cardnumber };
 144                 } elsif ( $dberror ) {
 145                     warn "Database returned error. We're not logging it because it most likely contains binary data which does unpleasent things to terminal windows and logs.";
 146                     $filerrors{'DBERR'} = 1;
 147                     push my @filerrors, \%filerrors;
 148                     push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
 149                     $template->param( ERRORS => 1 );
 150                 } elsif ( !$mimetype ) {
 151                     warn "Unable to determine mime type of $filename. Please verify mimetype and add to \%mimemap if necessary.";
 152                     $filerrors{'MIMERR'} = 1;
 153                     push my @filerrors, \%filerrors;
 154                     push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
 155                     $template->param( ERRORS => 1 );
 156                 }
 157             } else {
 158                 warn "Opening $dir/$filename failed!";
 159                 $filerrors{'OPNERR'} = 1;
 160                 push my @filerrors, \%filerrors;
 161                 push @{ $count{filenames} }, { filerrors => \@filerrors, source => $filename, cardnumber => $cardnumber };
 162                 $template->param( ERRORS => 1 );
 163             }
 164         }
 165     }
 166     $count{source} = $dir;
 167     push @counts, \%count;
 168     close FILE;
 169     closedir ( $dirhandle );
 170     return 1;
 171 }