10 my $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
12 #my $destdir = "/usr/local/koha/intranet/htdocs/intranet-tmpl/images/patronpictures";
13 #my $uploadfile = shift @ARGV;
15 my $destdir = C4::Context->config('intrahtdocs') . "/patronimages";
17 warn "DEST : $destdir";
18 my ($template, $loggedinuser, $cookie)
19 = get_template_and_user({template_name => "tools/picture-upload.tmpl",
23 flagsrequired => {management => 1, tools => 1},
27 unless (-d $destdir) {
29 warn "patronimages directory not present";
32 $template->param( ERRORS => [ \%errors ] );
34 my $uploadfilename = $input->param( 'uploadfile' );
35 my $uploadfile = $input->upload( 'uploadfile' );
36 my ( $total, $handled, @counts );
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 );
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 );
51 $template->param( ERRORS => [ \%errors ] );
53 while ( <$uploadfile> ) {
59 system("unzip $tempfile -d $dirname");
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;
71 foreach my $dir ( @directories ) {
72 $handled += handle_dir( $dir );
75 $total = scalar @directories;
76 warn "Total files processed: $total" if $DEBUG;
81 TCOUNTS => scalar(@counts),
86 output_html_with_http_headers $input, $cookie, $template->output;
89 warn "Entering sub handle_dir" if $DEBUG;
93 $count{filenames} = ();
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);
99 unless (open (FILE, $file)) {
100 warn "Opening $dir/$file failed!" if $DEBUG;
104 while (my $line = <FILE>) {
105 warn "Reading contents of $file" if $DEBUG;
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" );
120 push @{ $count{filenames} }, { source => $filename, dest => $cardnumber .".jpg" };
124 $count{source} = $dir;
125 $count{dest} = $destdir;
126 push @counts, \%count;