source: gsdl/trunk/perllib/downloaders/WebDownload.pm@ 17530

Last change on this file since 17530 was 17530, checked in by ak19, 12 years ago

Fixed not being able to run wget from the cmd-line via downloadfrom.pl on Linux (since the cache-dir was empty, the -P flag took the url to download from to be the directory-prefix and this made wget assume that the url itself was missing). Tested that wget process is killed upon Ctrl-C being pressed.

  • Property svn:keywords set to Author Date Id Revision
File size: 6.2 KB
Line 
1###########################################################################
2#
3# WebDownload.pm -- base class for all the import plugins
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) 1999 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 WebDownload;
27
28eval {require bytes};
29
30# suppress the annoying "subroutine redefined" warning that various
31# plugins cause under perl 5.6
32$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
33
34use WgetDownload;
35
36sub BEGIN {
37 @WebDownload::ISA = ('WgetDownload');
38}
39
40use strict; # every perl program should have this!
41no strict 'refs'; # make an exception so we can use variables as filehandles
42
43my $arguments =
44 [ { 'name' => "url",
45 'disp' => "{WebDownload.url_disp}",
46 'desc' => "{WebDownload.url}",
47 'type' => "string",
48 'reqd' => "yes"},
49 { 'name' => "depth",
50 'disp' => "{WebDownload.depth_disp}",
51 'desc' => "{WebDownload.depth}",
52 'type' => "int",
53 'deft' => "0",
54 "range" => "0,",
55 'reqd' => "no"},
56 { 'name' => "below",
57 'disp' => "{WebDownload.below_disp}",
58 'desc' => "{WebDownload.below}",
59 'type' => "flag",
60 'reqd' => "no"},
61 { 'name' => "within",
62 'disp' => "{WebDownload.within_disp}",
63 'desc' => "{WebDownload.within}",
64 'type' => "flag",
65 'reqd' => "no"},
66 { 'name' => "html_only",
67 'disp' => "{WebDownload.html_only_disp}",
68 'desc' => "{WebDownload.html_only}",
69 'type' => "flag",
70 'reqd' => "no"}
71 ];
72
73my $options = { 'name' => "WebDownload",
74 'desc' => "{WebDownload.desc}",
75 'abstract' => "no",
76 'inherits' => "yes",
77 'args' => $arguments };
78
79
80my $self;
81
82sub new
83{
84 my ($class) = shift (@_);
85 my ($getlist,$inputargs,$hashArgOptLists) = @_;
86 push(@$getlist, $class);
87
88 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
89 push(@{$hashArgOptLists->{"OptList"}},$options);
90
91 my $self = new WgetDownload($getlist,$inputargs,$hashArgOptLists);
92
93 return bless $self, $class;
94}
95
96sub download
97{
98 my ($self) = shift (@_);
99 my ($hashGeneralOptions) = @_;
100
101
102 # Download options
103 my $strOptions = $self->generateOptionsString();
104 my $strWgetOptions = $self->getWgetOptions();
105
106 # Setup the command for using wget
107 my $cache_dir = "";
108 if($hashGeneralOptions->{'cache_dir'}) { # don't provide the prefix-dir flag to wget unless the cache_dir is specified
109 if ($ENV{'GSDLOS'} eq "windows") {
110 $cache_dir = "-P \"".$hashGeneralOptions->{'cache_dir'}."\" ";
111 }
112 else {
113 $cache_dir = "-P ".$hashGeneralOptions->{'cache_dir'};
114 }
115 }
116 #my $cmdWget = "-N -k -x -t 2 -P \"".$hashGeneralOptions->{"cache_dir"}."\" $strWgetOptions $strOptions ".$self->{'url'};
117 my $cmdWget = "-N -k -x -t 2 $strWgetOptions $strOptions $cache_dir " .$self->{'url'};
118
119 # Download the web pages
120 # print "Start download from $self->{'url'}...\n";
121 print STDERR "<<Undefined Maximum>>\n";
122
123 if ($ENV{'GSDLOS'} eq "windows") {
124 my $strResponse = $self->useWget($cmdWget,1);
125 } else {
126 my $strResponse = $self->useWget($cmdWget,1,$hashGeneralOptions->{"cache_dir"} );
127
128 }
129
130 # if ($strResponse ne ""){print "$strResponse\n";}
131 print STDERR "Finish download from $self->{'url'}\n";
132
133 print STDERR "<<Finished>>\n";
134
135 return 1;
136}
137
138sub generateOptionsString
139{
140 my ($self) = @_;
141 my $strOptions;
142
143 (defined $self) || &error("generateOptionsString","No \$self is defined!!\n");
144 (defined $self->{'depth'})|| &error("generateOptionsString","No depth is defined!!\n");
145
146
147 if($self->{'depth'} == 0)
148 {
149 $strOptions .= " ";
150 }
151 elsif($self->{'depth'} > 0)
152 {
153 $strOptions .= "-r -l ".$self->{'depth'}." ";
154 }
155 else
156 {
157 $self->error("setupOptions","Incorrect Depth is defined!!\n");
158 }
159
160 if($self->{'below'})
161 {
162 $strOptions .="-np ";
163 }
164
165 if($self->{'html_only'})
166 {
167 $strOptions .="-A .html,.htm,.shm,.shtml,.asp,.php,.cgi,*?*=* ";
168 }
169 else{
170
171 $strOptions .="-p ";
172 }
173
174 if (!$self->{'within'}){
175 $strOptions .="-H ";
176 }
177
178 return $strOptions;
179
180}
181
182sub url_information
183{
184 my ($self) = shift (@_);
185
186 my $strOptions = $self->getWgetOptions();
187
188 my $strBaseCMD = $strOptions." -q -O - \"$self->{'url'}\"";
189
190
191 my $strIdentifyText = $self->useWget($strBaseCMD);
192
193 if (!defined $strIdentifyText or $strIdentifyText eq "" ){
194 print STDERR "Server information is unavailable.\n";
195 print STDERR "<<Finished>>\n";
196 return;
197 }
198
199 while ($strIdentifyText =~ m/^(.*)<title>(.*?)<\/title>(.*)$/si)
200 {
201 $strIdentifyText = $1.$3;
202 print STDERR "Page Title: $2\n";
203 }
204
205 while ($strIdentifyText =~ m/^(.*)<meta (.*?)>(.*)$/si)
206 {
207 $strIdentifyText = $1.$3;
208 my $strTempString = $2;
209 print STDERR "\n";
210
211 while($strTempString =~ m/(.*?)=[\"|\'](.*?)[\"|\'](.*?)$/si)
212 {
213 # Store the infromation in to variable, since next time when we do
214 # regular expression, we will lost all the $1, $2, $X....
215 $strTempString = $3;
216 my $strMetaName = $1;
217 my $strMetaContain = $2;
218
219 # Take out the extra space in the beginning of the string.
220 $strMetaName =~ s/^([" "])+//m;
221 $strMetaContain =~ s/^([" "])+//m;
222
223 print STDERR "$strMetaName: $strMetaContain\n\n";
224
225 }
226
227 }
228
229 print STDERR "<<Finished>>\n";
230
231}
232
233
234sub error
235{
236 my ($strFunctionName,$strError) = @_;
237 {
238 print "Error occoured in WebDownload.pm\n".
239 "In Function:".$strFunctionName."\n".
240 "Error Message:".$strError."\n";
241 exit(-1);
242 }
243}
244
2451;
246
Note: See TracBrowser for help on using the repository browser.