11 my $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
13 #my $destdir = "/usr/local/koha/intranet/htdocs/intranet-tmpl/images/patronpictures";
14 #my $uploadfile = shift @ARGV;
16 my $destdir = C4::Context->config('intrahtdocs') . "/patronimages";
18 warn "DEST : $destdir";
19 my ($template, $loggedinuser, $cookie)
20 = get_template_and_user({template_name => "tools/picture-upload.tmpl",
24 flagsrequired => {management => 1, tools => 1},
28 unless (-d $destdir) {
30 warn "patronimages directory not present";
33 $template->param( ERRORS => [ \%errors ] );
35 my $uploadfilename = $input->param( 'uploadfile' );
36 my $uploadfile = $input->upload( 'uploadfile' );
37 my ( $total, $handled, @counts );
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 );
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 );
52 $template->param( ERRORS => [ \%errors ] );
54 while ( <$uploadfile> ) {
60 system("unzip $tempfile -d $dirname");
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;
72 foreach my $dir ( @directories ) {
73 $handled += handle_dir( $dir );
76 $total = scalar @directories;
77 warn "Total files processed: $total" if $DEBUG;
82 TCOUNTS => scalar(@counts),
87 output_html_with_http_headers $input, $cookie, $template->output;
90 warn "Entering sub handle_dir" if $DEBUG;
94 $count{filenames} = ();
98 "jpg" => "image/jpeg",
99 "jpeg" => "image/jpeg",
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);
107 unless (open (FILE, $file)) {
108 warn "Opening $dir/$file failed!" if $DEBUG;
112 while (my $line = <FILE>) {
113 warn "Reading contents of $file" if $DEBUG;
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
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;
136 unless ( $dberror || !$mimetype ) {
138 push @{ $count{filenames} }, { source => $filename, dest => $cardnumber };
142 $count{source} = $dir;
143 $count{dest} = $destdir;
144 push @counts, \%count;