tools/access_files.pl

   1 #!/usr/bin/perl
   2
   3 # Frédérick Capovilla, 2011 - Libéo
   4 #
   5 # Show a list of all the files in the directory specified by the option
   6 # "access_dir" in koha-conf.xml so they can be downloaded by users with the
   7 # "access_files" permission.
   8 #
   9 # This file is part of Koha.
  10 #
  11 # Koha is free software; you can redistribute it and/or modify it
  12 # under the terms of the GNU General Public License as published by
  13 # the Free Software Foundation; either version 3 of the License, or
  14 # (at your option) any later version.
  15 #
  16 # Koha is distributed in the hope that it will be useful, but
  17 # WITHOUT ANY WARRANTY; without even the implied warranty of
  18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19 # GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License
  22 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  23
  24 use Modern::Perl;
  25
  26 use C4::Auth qw( get_template_and_user );
  27 use CGI;
  28 use C4::Context;
  29 use C4::Output qw( output_html_with_http_headers );
  30 use File::stat qw( stat );
  31 use Digest::MD5 qw( md5_hex );
  32 use Encode qw( decode );
  33
  34 my $input = CGI->new;
  35 my $file_id = $input->param("id");
  36 my $access_dirs = C4::Context->config('access_dirs');
  37
  38 my @directories;
  39
  40 if ($access_dirs){
  41     if (ref $access_dirs->{access_dir} ){
  42         @directories = @{$access_dirs->{access_dir}};
  43     } else {
  44         @directories =($access_dirs->{access_dir});
  45     }
  46 } else {
  47     @directories = ();
  48 }
  49
  50 my ($template, $borrowernumber, $cookie)
  51     = get_template_and_user({template_name => "tools/access_files.tt",
  52                 query => $input,
  53                 type => "intranet",
  54                 flagsrequired => { tools => 'access_files' },
  55                 });
  56
  57 unless(@directories) {
  58     $template->param(error_no_dir => 1);
  59 }
  60 else {
  61     #Get the files list
  62     my @files_list;
  63     foreach my $dir(@directories){
  64         opendir(DIR, $dir);
  65         foreach my $filename (readdir(DIR)) {
  66             my $full_path = "$dir/$filename";
  67             my $id = md5_hex($full_path);
  68             next if ($filename =~ /^\./ or -d $full_path);
  69
  70             # Make sure the filename is unicode-friendly
  71             my $decoded_filename = decode('utf8', $filename);
  72             my $st = stat("$dir/$decoded_filename");
  73
  74             my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime($st->mtime);
  75             my $dt=DateTime->new(year      => $year + 1900,
  76                                   month    => $mon + 1,
  77                                   day      => $mday,
  78                                   hour     => $hour,
  79                                   minute   => $min,
  80                             );
  81             push(@files_list, {name => $decoded_filename,
  82                                access_dir => $dir,
  83                                date =>$dt,
  84                                size => $st->size,
  85                                id   => $id});
  86         }
  87         closedir(DIR);
  88     }
  89
  90     my %files_hash = map { $_->{id} => $_ } @files_list;
  91     # If we received a file_id and it is valid, send the file to the browser
  92     if(defined $file_id and exists $files_hash{$file_id} ){
  93         my $filename = $files_hash{$file_id}->{name};
  94         my $dir = $files_hash{$file_id}->{access_dir};
  95         binmode STDOUT;
  96         # Open the selected file and send it to the browser
  97         print $input->header(-type => 'application/x-download',
  98                              -name => "$filename",
  99                              -Content_length => -s "$dir/$filename",
 100                              -attachment => "$filename");
 101
 102         my $fh;
 103         open $fh, "<:encoding(UTF-8)", "$dir/$filename";
 104         binmode $fh;
 105
 106         my $buf;
 107         while(read($fh, $buf, 65536)) {
 108             print $buf;
 109         }
 110         close $fh;
 111
 112         exit(0);
 113     }
 114     else{
 115         # Send the file list to the template
 116         $template->param(files_loop => \@files_list);
 117     }
 118 }
 119
 120 output_html_with_http_headers $input, $cookie, $template->output;