source: gsdl/trunk/perllib/downloaders/BaseDownload.pm@ 17528

Last change on this file since 17528 was 17528, checked in by ak19, 16 years ago

New subroutine setIsGLI to store whether or not the download is run from within GLI (or from a command prompt). This is necessary since Downloads using Wget that are launched via GLI require sockets to enable premature termination of wget, whereas when downloads are run by executing downloadfrom.pl from the cmd line, the WgetDownload.pm's signal handler for Ctrl-C (SIGINT) is called instead.

  • Property svn:keywords set to Author Date Id Revision
File size: 7.0 KB
Line 
1###########################################################################
2#
3# BaseDownload.pm -- base class for all the Download modules
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) 2006 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute 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 BaseDownload;
27
28eval {require bytes};
29
30use strict;
31no strict 'subs';
32
33use gsprintf 'gsprintf';
34use printusage;
35use parse2;
36
37# suppress the annoying "subroutine redefined" warning that various
38# gets cause under perl 5.6
39$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
40
41my $arguments = [];
42
43my $options = { 'name' => "BaseDownload",
44 'desc' => "{BaseDownload.desc}",
45 'abstract' => "yes",
46 'inherits' => "no" };
47
48sub new
49{
50 my $class = shift (@_);
51 my ($downloadlist,$args,$hashArgOptLists) = @_;
52 push(@$downloadlist, $class);
53 my $strDownloadName = (defined $downloadlist->[0]) ? $downloadlist->[0] : $class;
54
55 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
56 push(@{$hashArgOptLists->{"OptList"}},$options);
57
58 my $self = {};
59 $self->{'download_type'} = $strDownloadName;
60 $self->{'option_list'} = $hashArgOptLists->{"OptList"};
61 $self->{"info_only"} = 0;
62
63 # Check if gsdlinfo is in the argument list or not - if it is, don't parse
64 # the args, just return the object.
65 foreach my $strArg (@{$args})
66 {
67 if($strArg eq "-gsdlinfo")
68 {
69 $self->{"info_only"} = 1;
70 return bless $self, $class;
71 }
72 }
73
74 delete $self->{"info_only"};
75
76 if(parse2::parse($args,$hashArgOptLists->{"ArgList"},$self) == -1)
77 {
78 my $classTempClass = bless $self, $class;
79 print STDERR "<BadDownload d=$self->{'download_name'}>\n";
80 &gsprintf(STDERR, "\n{BaseDownload.bad_general_option}\n", $self->{'download_name'});
81 $classTempClass->print_txt_usage(""); # Use default resource bundle
82 die "\n";
83 }
84
85 return bless $self, $class;
86
87}
88
89sub download
90{
91 my ($self) = shift (@_);
92 my ($hashGeneralOptions) = @_;
93 &error("download","No download specified for $hashGeneralOptions->{download_mode}.\n");
94}
95
96
97sub print_xml_usage
98{
99 my $self = shift(@_);
100 my $header = shift(@_);
101 my $high_level_information_only = shift(@_);
102
103 # XML output is always in UTF-8
104 gsprintf::output_strings_in_UTF8;
105
106 if ($header) {
107 &PrintUsage::print_xml_header("download");
108 }
109 $self->print_xml($high_level_information_only);
110}
111
112
113sub print_xml
114{
115 my $self = shift(@_);
116 my $high_level_information_only = shift(@_);
117
118 my $optionlistref = $self->{'option_list'};
119 my @optionlist = @$optionlistref;
120 my $downloadoptions = shift(@$optionlistref);
121 return if (!defined($downloadoptions));
122
123 gsprintf(STDERR, "<DownloadInfo>\n");
124 gsprintf(STDERR, " <Name>$downloadoptions->{'name'}</Name>\n");
125 my $desc = gsprintf::lookup_string($downloadoptions->{'desc'});
126 $desc =~ s/</&amp;lt;/g; # doubly escaped
127 $desc =~ s/>/&amp;gt;/g;
128 gsprintf(STDERR, " <Desc>$desc</Desc>\n");
129 gsprintf(STDERR, " <Abstract>$downloadoptions->{'abstract'}</Abstract>\n");
130 gsprintf(STDERR, " <Inherits>$downloadoptions->{'inherits'}</Inherits>\n");
131 unless (defined($high_level_information_only)) {
132 gsprintf(STDERR, " <Arguments>\n");
133 if (defined($downloadoptions->{'args'})) {
134 &PrintUsage::print_options_xml($downloadoptions->{'args'});
135 }
136 gsprintf(STDERR, " </Arguments>\n");
137
138 # Recurse up the download hierarchy
139 $self->print_xml();
140 }
141 gsprintf(STDERR, "</DownloadInfo>\n");
142}
143
144
145sub print_txt_usage
146{
147 my $self = shift(@_);
148
149 # Print the usage message for a download (recursively)
150 my $descoffset = $self->determine_description_offset(0);
151 $self->print_download_usage($descoffset, 1);
152}
153
154sub determine_description_offset
155{
156 my $self = shift(@_);
157 my $maxoffset = shift(@_);
158
159 my $optionlistref = $self->{'option_list'};
160 my @optionlist = @$optionlistref;
161 my $downloadoptions = pop(@$optionlistref);
162 return $maxoffset if (!defined($downloadoptions));
163
164 # Find the length of the longest option string of this download
165 my $downloadargs = $downloadoptions->{'args'};
166 if (defined($downloadargs)) {
167 my $longest = &PrintUsage::find_longest_option_string($downloadargs);
168 if ($longest > $maxoffset) {
169 $maxoffset = $longest;
170 }
171 }
172
173 # Recurse up the download hierarchy
174 $maxoffset = $self->determine_description_offset($maxoffset);
175 $self->{'option_list'} = \@optionlist;
176 return $maxoffset;
177}
178
179
180sub print_download_usage
181{
182 my $self = shift(@_);
183 my $descoffset = shift(@_);
184 my $isleafclass = shift(@_);
185
186 my $optionlistref = $self->{'option_list'};
187 my @optionlist = @$optionlistref;
188 my $downloadoptions = shift(@$optionlistref);
189 return if (!defined($downloadoptions));
190
191 my $downloadname = $downloadoptions->{'name'};
192 my $downloadargs = $downloadoptions->{'args'};
193 my $downloaddesc = $downloadoptions->{'desc'};
194
195 # Produce the usage information using the data structure above
196 if ($isleafclass) {
197 if (defined($downloaddesc)) {
198 gsprintf(STDERR, "$downloaddesc\n\n");
199 }
200 gsprintf(STDERR, " {common.usage}: download $downloadname [{common.options}]\n\n");
201 }
202
203 # Display the download options, if there are some
204 if (defined($downloadargs)) {
205 # Calculate the column offset of the option descriptions
206 my $optiondescoffset = $descoffset + 2; # 2 spaces between options & descriptions
207
208 if ($isleafclass) {
209 gsprintf(STDERR, " {common.specific_options}:\n");
210 }
211 else {
212 gsprintf(STDERR, " {common.general_options}:\n", $downloadname);
213 }
214
215 # Display the download options
216 &PrintUsage::print_options_txt($downloadargs, $optiondescoffset);
217 }
218
219 # Recurse up the download hierarchy
220 $self->print_download_usage($descoffset, 0);
221 $self->{'option_list'} = \@optionlist;
222}
223
224sub url_information
225{
226 my ($self) = @_;
227 print STDERR "There is no extra information provided for this Download.\n";
228 return "";
229}
230
231# method to set whether or not we're running the download scripts from GLI
232sub setIsGLI()
233{
234 my ($self, $is_gli) = @_;
235
236 $self->{'gli'} = $is_gli;
237}
238
239sub error
240{
241 my ($strFunctionName,$strError) = @_;
242 {
243 print "An error occurred in BaseDownload.pm\n".
244 "In Function: ".$strFunctionName."\n".
245 "Error Message: ".$strError."\n";
246 exit(-1);
247 }
248}
249
2501;
Note: See TracBrowser for help on using the repository browser.