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