root/gs2-extensions/parallel-building/trunk/src/perllib/cgiactions/imageaction.pm @ 24626

Revision 24626, 5.3 KB (checked in by jmt12, 8 years ago)

An (almost) complete copy of the perllib directory from a (circa SEP2011) head checkout from Greenstone 2 trunk - in order to try and make merging in this extension a little easier later on (as there have been some major changes to buildcol.pl commited in the main trunk but not in the x64 branch)

Line 
1###########################################################################
2#
3# imageaction.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 2009 New Zealand Digital Library Project
9#
10# This program is free software; you can redistr   te it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26package imageaction;
27
28use strict;
29
30use cgiactions::baseaction;
31use util;
32
33@imageaction::ISA = ('baseaction');
34
35
36my $action_table =
37{
38    "fit-screen" => { 'compulsory-args' => [ "pageWidth", "pageHeight",
39                         "assocDir", "assocFile" ],
40              'optional-args'   => [ "orientation" ] },
41
42};
43
44
45sub new
46{
47    my $class = shift (@_);
48    my ($gsdl_cgi,$iis6_mode) = @_;
49
50    my $self = new baseaction($action_table,$gsdl_cgi,$iis6_mode);
51
52    return bless $self, $class;
53}
54
55
56
57sub get_mime_type
58{
59    my $self = shift @_;
60
61    my ($file) = @_;
62
63    my %image_mime_re =
64    (
65    "gif"   => "image/gif",
66    "jpe?g" => "image/jpeg",
67    "png"   => "image/png",
68    "tiff?" => "image/tiff",
69    "bmp"   => "image/bmp"
70    );
71
72    my ($ext) = ($file =~ m/^.*\.(.*)?$/);
73
74    foreach my $re (keys %image_mime_re) {
75    if ($ext =~ m/^$re$/i) {
76        return $image_mime_re{$re};
77    }
78    }
79
80    return undef;
81}
82
83
84
85
86sub fit_screen
87{
88    my $self = shift @_;
89
90    my $username  = $self->{'username'};
91    my $collect   = $self->{'collect'};
92    my $gsdl_cgi  = $self->{'gsdl_cgi'};
93    my $gsdlhome  = $self->{'gsdlhome'};
94
95
96    if ($baseaction::authentication_enabled) {
97    # Ensure the user is allowed to edit this collection
98    &authenticate_user($gsdl_cgi, $username, $collect);
99    }
100
101    my $site = $self->{'site'};
102    my $collect_directory = $gsdl_cgi->get_collection_dir($site);
103    #my $collect_directory = &util::filename_cat($gsdlhome, "collect");
104#    $gsdl_cgi->checked_chdir($collect_directory);
105
106
107#    # Make sure the collection isn't locked by someone else
108#
109
110    $self->lock_collection($username, $collect);
111
112    # look up additional args
113
114    my $pageWidth  = $self->{'pageWidth'};
115    my $pageHeight = $self->{'pageHeight'};
116    my $assocDir   = $self->{'assocDir'};
117    my $assocFile  = $self->{'assocFile'};
118
119    my $orientation = $self->{'orientation'};
120    $orientation = "portrait" if (!defined $orientation);
121
122    my $toplevel_assoc_dir
123    = &util::filename_cat($collect_directory,$collect,"index","assoc");
124    my $src_full_assoc_filename
125    = &util::filename_cat($toplevel_assoc_dir,$assocDir,$assocFile);
126
127    my $dst_width = $pageWidth;
128    my $dst_height = $pageHeight;
129
130    my $opt_ls = ($orientation eq "landscape") ? "-r" : "";
131   
132    my $dst_file = $dst_width."x".$dst_height."$opt_ls-$assocFile";
133
134    my $dst_full_assoc_filename
135    = &util::filename_cat($toplevel_assoc_dir,$assocDir,$dst_file);
136
137    # **** What if assoc folder is on read-only medium such as CD-ROM?
138    # Should really switch to using some collection specific tmp area
139    # => test if top_level assoc dir has write permission?
140
141    if (!-w $toplevel_assoc_dir) {
142    $gsdl_cgi->generate_error("Cannot write out resized image $dst_full_assoc_filename.");
143    }
144
145    # For now will assume it is writable
146
147    if (!-e $dst_full_assoc_filename) {
148    # generate resized image
149
150    # Better to make sure ImageMagick is installed
151   
152        my $resize = "-filter Lanczos -resize $dst_width"."x"."$dst_height!";
153    # use of "!" forces convert to produce exactly these dimensions, rather
154    # than preserving aspect ratio.  In actual fact, it is intended that
155    # the width and height values passed in *do* preserve the aspect ratio
156    # Doing it this way makes it easier for the web browser to know (ahead of time) the
157    # width and height of the image that will be generated (useful for putting into
158    # <img> and <div> tags
159
160
161    my $cmd = "\"".&util::get_perl_exec()."\" -S gs-magick.pl convert \"$src_full_assoc_filename\" ";
162    $cmd .= "-rotate 90 " if ($orientation eq "landscape");
163
164    $cmd .= "$resize \"$dst_full_assoc_filename\"";
165
166    `$cmd`;
167
168    # generate resized image in assoc file area (if writable)
169    # otherwise in (collection's??) tmp directory
170    }
171
172    my $mime_type = $self->get_mime_type($dst_file);
173   
174    if (defined $mime_type) {
175    # now output it with suitable mime header
176    print STDOUT "Content-type:$mime_type\n\n";
177
178    if (open(IMGIN,"<$dst_full_assoc_filename")) {
179        binmode IMGIN;
180        binmode STDOUT;
181       
182        my $data;       
183        while (read(IMGIN,$data,1024) != 0) {
184        print STDOUT $data;
185        }
186
187        close(IMGIN);
188
189        #system("cat \"$dst_full_assoc_filename\"");
190    }
191    else {
192        $gsdl_cgi->generate_error("Unable to open $dst_full_assoc_filename for output");
193    }
194    }
195    else {
196    $gsdl_cgi->generate_error("Unrecognised image mime-type for $dst_file");
197    }
198
199}
200
201
2021;
Note: See TracBrowser for help on using the browser.