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
  10 my $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
  11
  12 #my $destdir = "/usr/local/koha/intranet/htdocs/intranet-tmpl/images/patronpictures";
  13 #my $uploadfile = shift @ARGV;
  14 my $input = new CGI;
  15 my $destdir = C4::Context->config('intrahtdocs') . "/patronimages";
  16
  17 warn "DEST : $destdir";
  18 my ($template, $loggedinuser, $cookie)
  19         = get_template_and_user({template_name => "tools/picture-upload.tmpl",
  20                                         query => $input,
  21                                         type => "intranet",
  22                                         authnotrequired => 0,
  23                                         flagsrequired => {management => 1, tools => 1},
  24                                         debug => 0,
  25                                         });
  26
  27 unless (-d $destdir) {
  28         $errors{'NODIR'} = 1;
  29         warn "patronimages directory not present";
  30 }
  31 if ( %errors ) {
  32     $template->param( ERRORS => [ \%errors ] );
  33 }
  34 my $uploadfilename = $input->param( 'uploadfile' );
  35 my $uploadfile = $input->upload( 'uploadfile' );
  36 my ( $total, $handled, @counts );
  37
  38 if ( $uploadfile ) {
  39     my $dirname = File::Temp::tempdir( CLEANUP => 1);
  40     warn "dirname = $dirname" if $DEBUG;
  41     my ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => '.zip', UNLINK => 1 );
  42     warn "tempfile = $tempfile" if $DEBUG;
  43     my ( @directories, %errors );
  44
  45     $errors{'NOTZIP'} = 1 unless ( $uploadfilename =~ /\.zip$/i );
  46     $errors{'NOWRITETEMP'} = 1 unless ( -w $dirname );
  47     $errors{'NOWRITEDEST'} = 1 unless ( -w $destdir );
  48     $errors{'EMPTYUPLOAD'} = 1 unless ( length( $uploadfile ) > 0 );
  49
  50     if ( %errors ) {
  51         $template->param( ERRORS => [ \%errors ] );
  52     } else {
  53         while ( <$uploadfile> ) {
  54             print $tfh $_;
  55         }
  56
  57         close $tfh;
  58
  59         system("unzip $tempfile -d $dirname");
  60
  61         push @directories, "$dirname";
  62         foreach $recursive_dir ( @directories ) {
  63             opendir $dir, $recursive_dir;
  64             while ( my $entry = readdir $dir ) {
  65                         push @directories, "$recursive_dir/$entry" if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
  66                         warn "$recursive_dir/$entry" if $DEBUG;
  67             }
  68             closedir $dir;
  69         }
  70
  71         foreach my $dir ( @directories ) {
  72             $handled += handle_dir( $dir );
  73         }
  74
  75         $total = scalar @directories;
  76         warn "Total files processed: $total" if $DEBUG;
  77         $template->param(
  78                          TOTAL => $total,
  79                          HANDLED => $handled,
  80                          COUNTS => \@counts,
  81                          TCOUNTS => scalar(@counts),
  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     opendir my $dirhandle, $dir;
  96     while ( my $filename = readdir $dirhandle ) {
  97         $file = "$dir/$filename" if ($filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i);
  98     }
  99     unless (open (FILE, $file)) {
 100                 warn "Opening $dir/$file failed!" if $DEBUG;
 101                 return 0;
 102         };
 103
 104     while (my $line = <FILE>) {
 105         warn "Reading contents of $file" if $DEBUG;
 106         chomp $line;
 107         warn "Examining line: $line" if $DEBUG;
 108         my ( $filename, $cardnumber );
 109         my $delim = ($line =~ /\t/) ? "\t" : ",";
 110         warn "Delimeter is \'$delim\'" if $DEBUG;
 111         ($cardnumber, $filename) = split $delim, $line;
 112         $cardnumber =~ s/[\"\r\n]//g;  # remove offensive characters
 113         $filename   =~ s/[\"\r\n\s]//g;
 114         warn "Cardnumber: $cardnumber Filename: $filename" if $DEBUG;
 115         if ($cardnumber && $filename) {
 116             warn "Source: $dir/$filename Target: $destdir/$cardnumber.jpg" if $DEBUG;
 117             my $result = move ( "$dir/$filename", "$destdir/$cardnumber.jpg" );
 118                 if ( $result ) {
 119                     $count{count}++;
 120                     push @{ $count{filenames} }, { source => $filename, dest => $cardnumber .".jpg" };
 121                 }
 122         }
 123     }
 124     $count{source} = $dir;
 125     $count{dest} = $destdir;
 126     push @counts, \%count;
 127     close FILE;
 128     return 1;
 129 }