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;
  27 use CGI;
  28 use C4::Context;
  29 use C4::Output;
  30 use C4::Koha;
  31 use File::stat qw(stat);
  32 use Digest::MD5 qw(md5_hex);
  33 use Encode;
  34
  35 my $input = new CGI;
  36 my $file_id = $input->param("id");
  37 my $access_dirs = C4::Context->config('access_dirs');
  38
  39 my @directories;
  40
  41 if ($access_dirs){
  42     if (ref $access_dirs->{access_dir} ){
  43         @directories = @{$access_dirs->{access_dir}};
  44     } else {
  45         @directories =($access_dirs->{access_dir});
  46     }
  47 } else {
  48     @directories = ();
  49 }
  50
  51 my ($template, $borrowernumber, $cookie)
  52     = get_template_and_user({template_name => "tools/access_files.tt",
  53                 query => $input,
  54                 type => "intranet",
  55                 flagsrequired => { tools => 'access_files' },
  56                 });
  57
  58 unless(@directories) {
  59     $template->param(error_no_dir => 1);
  60 }
  61 else {
  62     #Get the files list
  63     my @files_list;
  64     foreach my $dir(@directories){
  65         opendir(DIR, $dir);
  66         foreach my $filename (readdir(DIR)) {
  67             my $full_path = "$dir/$filename";
  68             my $id = md5_hex($full_path);
  69             next if ($filename =~ /^\./ or -d $full_path);
  70
  71             # Make sure the filename is unicode-friendly
  72             my $decoded_filename = decode('utf8', $filename);
  73             my $st = stat("$dir/$decoded_filename");
  74
  75             my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime($st->mtime);
  76             my $dt=DateTime->new(year      => $year + 1900,
  77                                   month    => $mon + 1,
  78                                   day      => $mday,
  79                                   hour     => $hour,
  80                                   minute   => $min,
  81                             );
  82             push(@files_list, {name => $decoded_filename,
  83                                access_dir => $dir,
  84                                date =>$dt,
  85                                size => $st->size,
  86                                id   => $id});
  87         }
  88         closedir(DIR);
  89     }
  90
  91     my %files_hash = map { $_->{id} => $_ } @files_list;
  92     # If we received a file_id and it is valid, send the file to the browser
  93     if(defined $file_id and exists $files_hash{$file_id} ){
  94         my $filename = $files_hash{$file_id}->{name};
  95         my $dir = $files_hash{$file_id}->{access_dir};
  96         binmode STDOUT;
  97         # Open the selected file and send it to the browser
  98         print $input->header(-type => 'application/x-download',
  99                              -name => "$filename",
 100                              -Content_length => -s "$dir/$filename",
 101                              -attachment => "$filename");
 102
 103         my $fh;
 104         open $fh, "<:encoding(UTF-8)", "$dir/$filename";
 105         binmode $fh;
 106
 107         my $buf;
 108         while(read($fh, $buf, 65536)) {
 109             print $buf;
 110         }
 111         close $fh;
 112
 113         exit(0);
 114     }
 115     else{
 116         # Send the file list to the template
 117         $template->param(files_loop => \@files_list);
 118     }
 119 }
 120
 121 output_html_with_http_headers $input, $cookie, $template->output;