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

Last change on this file since 14918 was 14918, checked in by dmn, 15 years ago

davidb's to allow for proxy's without authentication

  • 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;
37use Cwd;
38
39sub BEGIN {
40 @WgetDownload::ISA = ('BasDownload');
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 if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
83 if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};
84
85 my $self = (defined $hashArgOptLists)? new BasDownload($getlist,$inputargs,$hashArgOptLists): new BasDownload($getlist,$inputargs);
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 $strOptions .= " -Y on ";
119
120 return $strOptions;
121}
122
123# Checking for proxy setup: proxy server, proxy port, proxy username and password.
124sub checkProxySetup
125{
126 my ($self) = @_;
127 ($self->{'proxy_on'}) || &error("checkProxySetup","The proxy is not on? How could that be happening?");
128 # Setup .wgetrc by using $self->{'proxy_host'} and $self->{'proxy_port'}
129 # Test if the connection is succeful. If the connection wasn't succeful then ask user to supply username and password.
130
131}
132
133sub useWget
134{
135 my ($self, $cmdWget,$blnShow, $working_dir) = @_;
136
137 my ($strReadIn,$strLine,$command);
138 $strReadIn = "" unless defined $strReadIn;
139
140 my $current_dir = cwd();
141 my $changed_dir = 0;
142 if (defined $working_dir && -e $working_dir) {
143 chdir "$working_dir";
144 $changed_dir = 1;
145 }
146 my $wget_file_path = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "wget");
147 $command = "\"$wget_file_path\" $cmdWget |";
148
149 open(*WIN,$command) || die "wget request failed: $!\n";
150
151 while (defined($strLine=<WIN>))
152 {
153 if($blnShow)
154 {
155 print STDERR "$strReadIn\n";
156 }
157
158 $strReadIn .= $strLine;
159 }
160
161 close(WIN);
162 if ($changed_dir) {
163 chdir $current_dir;
164 }
165
166 return $strReadIn;
167}
168
169# TODO: Check if the URL is valid?? Not sure what should be in this function yet!!
170sub checkURL
171{
172 my ($self) = @_;
173 if ($self->{'url'} eq "")
174 {
175 &error("checkURL","no URL is specified!! Please specifies the URL for downloading.");
176 }
177}
178
179sub error
180{
181 my ($strFunctionName,$strError) = @_;
182 {
183 print "Error occoured in WgetDownload.pm\n".
184 "In Function:".$strFunctionName."\n".
185 "Error Message:".$strError."\n";
186 exit(-1);
187 }
188}
189
1901;
Note: See TracBrowser for help on using the repository browser.