plack/lib/Plack/App/BookReader.pm

   1 package Plack::App::BookReader;
   2 use parent qw(Plack::App::File);
   3 use strict;
   4 use warnings;
   5 use Plack::Util;
   6 use HTTP::Date;
   7 use Plack::MIME;
   8 use DirHandle;
   9 use URI::Escape;
  10 use Plack::Request;
  11 use Data::Dump qw(dump);
  12 use File::Path qw(make_path);
  13 use Graphics::Magick;
  14
  15 # Stolen from rack/directory.rb
  16 my $dir_file = "<tr><td class='name'><a href='%s'>%s</a></td><td class='size'>%s</td><td class='type'>%s</td><td class='mtime'>%s</td></tr>";
  17 my $dir_page = <<PAGE;
  18 <html><head>
  19   <title>%s</title>
  20   <meta http-equiv="content-type" content="text/html; charset=utf-8" />
  21   <style type='text/css'>
  22 table { width:100%%; }
  23 .name { text-align:left; }
  24 .size, .mtime { text-align:right; }
  25 .type { width:11em; }
  26 .mtime { width:15em; }
  27   </style>
  28 </head><body>
  29 <h1>%s</h1>
  30 <hr />
  31 <table>
  32   <tr>
  33     <th class='name'>Name</th>
  34     <th class='size'>Size</th>
  35     <th class='type'>Type</th>
  36     <th class='mtime'>Last Modified</th>
  37   </tr>
  38 %s
  39 </table>
  40 <hr />
  41 <code>%s</code>
  42 </body></html>
  43 PAGE
  44
  45 sub should_handle {
  46     my($self, $file) = @_;
  47     return -d $file || -f $file;
  48 }
  49
  50 sub return_dir_redirect {
  51     my ($self, $env) = @_;
  52     my $uri = Plack::Request->new($env)->uri;
  53     return [ 301,
  54         [
  55             'Location' => $uri . '/',
  56             'Content-Type' => 'text/plain',
  57             'Content-Length' => 8,
  58         ],
  59         [ 'Redirect' ],
  60     ];
  61 }
  62
  63 sub serve_path {
  64     my($self, $env, $path, $fullpath) = @_;
  65
  66     if (-f $path) {
  67
  68                 my $req = Plack::Request->new($env);
  69                 if ( my $reduce = $req->param('reduce') ) {
  70                         $reduce = int($reduce); # BookReader javascript somethimes returns float
  71                         warn "# -scale 1/$reduce $path\n";
  72
  73                         my $cache_path = "cache/$path.reduce.$reduce.jpg";
  74                         if ( $reduce <= 1 ) {
  75                                 $cache_path = $path;
  76                         } elsif ( ! -e $cache_path ) {
  77                                 my $image = Graphics::Magick->new( magick => 'jpg' );
  78                                 $image->Read($path);
  79                                 my ( $w, $h ) = $image->Get('width','height');
  80                                 $image->Resize(
  81                                         width  => $w / $reduce,
  82                                         height => $h / $reduce
  83                                 );
  84                                 $image->Write( filename => $cache_path );
  85                                 warn "# created $cache_path ", -s $cache_path, " bytes\n";
  86                         }
  87
  88                 return $self->SUPER::serve_path($env, $cache_path, $fullpath);
  89
  90                 }
  91
  92         return $self->SUPER::serve_path($env, $path, $fullpath);
  93     }
  94
  95     my $dir_url = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
  96
  97     if ($dir_url !~ m{/$}) {
  98         return $self->return_dir_redirect($env);
  99     }
 100
 101     my @files = ([ "../", "Parent Directory", '', '', '' ]);
 102
 103     my $dh = DirHandle->new($path);
 104     my @children;
 105     while (defined(my $ent = $dh->read)) {
 106         next if $ent eq '.';
 107         push @children, $ent;
 108     }
 109
 110         my @page_files;
 111
 112     for my $basename (sort { $a cmp $b } @children) {
 113                 push @page_files, $basename if $basename =~ m/\.jpg$/;
 114         my $file = "$path/$basename";
 115         my $url = $dir_url . $basename;
 116
 117         my $is_dir = -d $file;
 118         my @stat = stat _;
 119
 120
 121         $url = join '/', map {uri_escape($_)} split m{/}, $url;
 122
 123         if ($is_dir) {
 124             $basename .= "/";
 125             $url      .= "/";
 126         }
 127
 128         my $mime_type = $is_dir ? 'directory' : ( Plack::MIME->mime_type($file) || 'text/plain' );
 129         push @files, [ $url, $basename, $stat[7], $mime_type, HTTP::Date::time2str($stat[9]) ];
 130     }
 131
 132     my $dir  = Plack::Util::encode_html( $env->{PATH_INFO} );
 133     my $files = join "\n", map {
 134         my $f = $_;
 135         sprintf $dir_file, map Plack::Util::encode_html($_), @$f;
 136     } @files;
 137
 138         my $meta = {
 139                 page_urls => [ map { "$dir_url/$_" } sort { $a <=> $b } @page_files ],
 140         };
 141     my $page  = sprintf $dir_page, $dir, $dir, $files, dump( $meta );
 142
 143     return [ 200, ['Content-Type' => 'text/html; charset=utf-8'], [ $page ] ];
 144 }
 145
 146 1;
 147
 148 __END__
 149
 150 =head1 NAME
 151
 152 Plack::App::BookReader - Internet Archive Book Reader with directory index
 153
 154 =head1 SYNOPSIS
 155
 156   # app.psgi
 157   use Plack::App::BookReader;
 158   my $app = Plack::App::BookReader->new({ root => "/path/to/htdocs" })->to_app;
 159
 160 =head1 DESCRIPTION
 161
 162 This is a static file server PSGI application with directory index a la Apache's mod_autoindex.
 163
 164 =head1 CONFIGURATION
 165
 166 =over 4
 167
 168 =item root
 169
 170 Document root directory. Defaults to the current directory.
 171
 172 =back
 173
 174 =head1 AUTHOR
 175
 176 Dobrica Pavlinusic
 177 Tatsuhiko Miyagawa (based on L<Plack::App::Directory>
 178
 179 =head1 SEE ALSO
 180
 181 L<Plack::App::File>
 182
 183 =cut
 184