source: trunk/gsdl/perllib/downloaders/WgetDownload.pm@ 12587

Last change on this file since 12587 was 12465, checked in by shaoqun, 18 years ago

fixed th bugs on windows

  • Property svn:keywords set to Author Date Id Revision
File size: 5.0 KB
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 BasDownload;
35use strict;
36use IPC::Open2;
37
38sub BEGIN {
39 @WgetDownload::ISA = ('BasDownload');
40}
41
42my $arguments =
43 [ { 'name' => "proxy_on",
44 'desc' => "{WgetDownload.proxy_on}",
45 'type' => "flag",
46 'reqd' => "no",
47 'hiddengli' => "yes"},
48 { 'name' => "proxy_host",
49 'desc' => "{WgetDownload.proxy_host}",
50 'type' => "string",
51 'reqd' => "no",
52 'hiddengli' => "yes"},
53 { 'name' => "proxy_port",
54 'desc' => "{WgetDownload.proxy_port}",
55 'type' => "string",
56 'reqd' => "no",
57 'hiddengli' => "yes"},
58 { 'name' => "user_name",
59 'desc' => "{WgetDownload.user_name}",
60 'type' => "string",
61 'reqd' => "no",
62 'hiddengli' => "yes"},
63 { 'name' => "user_password",
64 'desc' => "{WgetDownload.user_password}",
65 'type' => "string",
66 'reqd' => "no",
67 'hiddengli' => "yes"}];
68
69my $options = { 'name' => "WgetDownload",
70 'desc' => "{WgetDownload.desc}",
71 'abstract' => "yes",
72 'inherits' => "yes",
73 'args' => $arguments };
74
75
76sub new {
77 my ($class) = shift (@_);
78 my ($getlist,$inputargs,$hashArgOptLists) = @_;
79 push(@$getlist, $class);
80
81 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
82 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
83
84 my $self = (defined $hashArgOptLists)? new BasDownload($getlist,$inputargs,$hashArgOptLists): new BasDownload($getlist,$inputargs);
85
86 return bless $self, $class;
87}
88
89sub checkWgetSetup
90{
91 my ($self,$blnGliCall) = @_;
92 #TODO: proxy detection??
93
94 if((!$blnGliCall) && $self->{'proxy_on'})
95 {
96 &checkProxySetup($self);
97 }
98 &checkURL($self);
99}
100
101sub getWgetOptions
102{
103 my ($self) = @_;
104 my $strOptions = "";
105
106 if($self->{'proxy_on'} && $self->{'proxy_host'} && $self->{'proxy_port'}
107 && $self->{'user_name'} && $self->{'user_password'}
108 )
109 {
110 $strOptions = " -e httpproxy=$self->{'proxy_host'}:$self->{'proxy_port'} --proxy-user=$self->{'user_name'}"." --proxy-passwd=$self->{'user_password'} -Y on ";
111 }
112
113 return $strOptions;
114}
115
116# Checking for proxy setup: proxy server, proxy port, proxy username and password.
117sub checkProxySetup
118{
119 my ($self) = @_;
120 ($self->{'proxy_on'}) || &error("checkProxySetup","The proxy is not on? How could that be happening?");
121 # Setup .wgetrc by using $self->{'proxy_host'} and $self->{'proxy_port'}
122 # Test if the connection is succeful. If the connection wasn't succeful then ask user to supply username and password.
123
124}
125
126sub useWget
127{
128 my ($self, $cmdWget,$blnShow) = @_;
129
130 my ($os,$strReadIn,$strLine,$command);
131
132 $os = $ENV{'GSDLOS'};
133
134
135 if ($os =~ /windows/i){
136 $command = "\"$ENV{'GSDLHOME'}\\bin\\windows\\wget\" $cmdWget |";
137 }
138 else{
139 $command = "$ENV{'GSDLHOME'}/packages/wget/wget-1.9/src/wget $cmdWget |";
140 }
141
142
143
144 open(*WIN,$command) || die "wget request failed: $!\n";
145
146
147
148 while (defined($strLine=<WIN>))
149 {
150
151
152 if($blnShow)
153 {
154 print STDERR "$strReadIn\n";
155 }
156
157 $strReadIn .= $strLine;
158 }
159
160 close(WIN);
161
162 return $strReadIn;
163}
164
165# TODO: Check if the URL is valid?? Not sure what should be in this function yet!!
166sub checkURL
167{
168 my ($self) = @_;
169 if ($self->{'url'} eq "")
170 {
171 &error("checkURL","no URL is specified!! Please specifies the URL for downloading.");
172 }
173}
174
175sub error
176{
177 my ($strFunctionName,$strError) = @_;
178 {
179 print "Error occoured in WgetDownload.pm\n".
180 "In Function:".$strFunctionName."\n".
181 "Error Message:".$strError."\n";
182 exit(-1);
183 }
184}
185
1861;
Note: See TracBrowser for help on using the repository browser.