root/gsdl/trunk/perllib/downloaders/WgetDownload.pm @ 17207

Revision 17207, 6.1 KB (checked in by kjdon, 12 years ago)

BasDownload? renamed to BaseDownload?, also tidied up the constructors

  • Property svn:keywords set to Author Date Id Revision
Line 
1###########################################################################
2#
3# WgetDownload.pm -- Download base module that handles calling Wget
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 WgetDownload;
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 BaseDownload;
35use strict;
36use IPC::Open2;
37use Cwd;
38
39sub BEGIN {
40    @WgetDownload::ISA = ('BaseDownload');
41}
42
43my $arguments =
44     [ { 'name' => "proxy_on",
45    'desc' => "{WgetDownload.proxy_on}",
46    'type' => "flag",
47    'reqd' => "no",
48    'hiddengli' => "yes"},
49      { 'name' => "proxy_host", 
50    'desc' => "{WgetDownload.proxy_host}",         
51    'type' => "string",
52    'reqd' => "no",
53    'hiddengli' => "yes"},
54      { 'name' => "proxy_port",
55    'desc' => "{WgetDownload.proxy_port}",         
56    'type' => "string",
57    'reqd' => "no",
58    'hiddengli' => "yes"},
59      { 'name' => "user_name", 
60    'desc' => "{WgetDownload.user_name}",         
61    'type' => "string",
62    'reqd' => "no",
63    'hiddengli' => "yes"},
64      { 'name' => "user_password",
65    'desc' => "{WgetDownload.user_password}",         
66    'type' => "string",
67    'reqd' => "no",
68    'hiddengli' => "yes"}];
69
70my $options = { 'name'     => "WgetDownload",
71        'desc'     => "{WgetDownload.desc}",
72        'abstract' => "yes",
73        'inherits' => "yes",
74        'args'     => $arguments };
75
76
77sub new {
78    my ($class) = shift (@_);
79    my ($getlist,$inputargs,$hashArgOptLists) = @_;
80    push(@$getlist, $class);
81
82    push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
83    push(@{$hashArgOptLists->{"OptList"}},$options);
84
85    my $self = new BaseDownload($getlist,$inputargs,$hashArgOptLists);
86
87    return bless $self, $class;
88}
89
90sub checkWgetSetup
91{
92    my ($self,$blnGliCall) = @_;
93    #TODO: proxy detection??
94   
95    if((!$blnGliCall) && $self->{'proxy_on'})
96    {
97    &checkProxySetup($self);
98    }
99    &checkURL($self);
100}
101
102sub getWgetOptions
103{
104    my ($self) = @_;
105    my $strOptions = "";
106   
107    if ($self->{'proxy_on'} && $self->{'proxy_host'} && $self->{'proxy_port'})
108    {
109
110    $strOptions .= " -e httpproxy=$self->{'proxy_host'}:$self->{'proxy_port'} ";
111
112    if ($self->{'user_name'} && $self->{'user_password'})
113    {
114        $strOptions .= "--proxy-user=$self->{'user_name'}"." --proxy-passwd=$self->{'user_password'}";
115    }
116    }
117
118    if ($self->{'proxy_on'}) {
119    $strOptions .= " --proxy ";
120    }
121
122    return $strOptions;
123}
124
125# Checking for proxy setup: proxy server, proxy port, proxy username and password.
126sub checkProxySetup
127{
128    my ($self) = @_;
129    ($self->{'proxy_on'}) || &error("checkProxySetup","The proxy is not on? How could that be happening?");
130    # Setup .wgetrc by using $self->{'proxy_host'} and $self->{'proxy_port'}
131    # Test if the connection is succeful. If the connection wasn't succeful then ask user to supply username and password.
132
133}
134
135sub useWget
136{
137    my ($self, $cmdWget,$blnShow, $working_dir) = @_;
138
139    my ($strReadIn,$strLine,$command);
140    $strReadIn = "" unless defined $strReadIn;
141
142    my $current_dir = cwd();
143    my $changed_dir = 0;
144    if (defined $working_dir && -e $working_dir) {
145    chdir "$working_dir";
146    $changed_dir = 1;
147    }
148    my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget");
149    $command = "\"$wget_file_path\" $cmdWget |";
150
151    open(*WIN,$command) || die "wget request failed: $!\n";
152
153    while (defined($strLine=<WIN>))
154    {
155    if($blnShow)
156    {
157        print STDERR "$strReadIn\n";
158    }
159
160    $strReadIn .= $strLine;
161    }
162
163    close(WIN);
164    if ($changed_dir) {
165    chdir $current_dir;
166    }
167   
168    return $strReadIn;
169}
170
171
172sub useWgetMonitored
173{
174    my ($self, $cmdWget,$blnShow, $working_dir) = @_;
175
176
177    my $current_dir = cwd();
178    my $changed_dir = 0;
179    if (defined $working_dir && -e $working_dir) {
180    chdir "$working_dir";
181    $changed_dir = 1;
182    }
183    my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget");
184    my $command = "\"$wget_file_path\" $cmdWget 2>&1 |";
185
186###    print STDERR "**** wget cmd = $command\n";
187
188    open(*WIN,$command) || die "wget request failed: $!\n";
189
190    my $full_text = "";
191    my $error_text = "";
192    my @follow_list = ();
193    my $line;
194
195    while (defined($line=<WIN>))
196    {
197    if((defined $blnShow) && $blnShow)
198    {
199        print STDERR "$line";
200    }
201
202    if ($line =~ m/^Location:\s*(.*?)\s*\[following\]\s*$/i) {
203        my $follow_url = $1;
204        push(@follow_list,$follow_url);
205    }
206
207    if ($line =~ m/ERROR\s+\d+/) {
208        $error_text .= $line;
209    }
210
211    $full_text .= $line;
212    }
213
214    close(WIN);
215
216    my $command_status = $?;
217    if ($command_status != 0) {
218    $error_text .= "Exit error: $command_status";
219    }
220
221    if ($changed_dir) {
222    chdir $current_dir;
223    }
224   
225    my $final_follow = pop(@follow_list); # might be undefined, but that's OK
226   
227    return ($full_text,$error_text,$final_follow);
228}
229
230
231# TODO: Check if the URL is valid?? Not sure what should be in this function yet!!
232sub checkURL
233{
234    my ($self) = @_;
235    if ($self->{'url'} eq "")
236    {
237    &error("checkURL","no URL is specified!! Please specifies the URL for downloading.");
238    }
239}
240
241sub error
242{
243    my ($strFunctionName,$strError) = @_;
244    {
245    print "Error occoured in WgetDownload.pm\n".
246        "In Function:".$strFunctionName."\n".
247        "Error Message:".$strError."\n";
248    exit(-1);
249    }
250}
251
2521;
Note: See TracBrowser for help on using the browser.