"Fossies" - the Fresh Open Source Software Archive 
Member "install-tl-20231204/tlpkg/TeXLive/TLDownload.pm" (21 Dec 2021, 5429 Bytes) of package /linux/misc/install-tl-unx.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
1 # $Id: TLDownload.pm 61372 2021-12-21 22:46:16Z karl $
2 # TeXLive::TLDownload.pm - module for abstracting the download modes
3 # Copyright 2009-2021 Norbert Preining
4 # This file is licensed under the GNU General Public License version 2
5 # or any later version.
6
7 use strict; use warnings;
8
9 package TeXLive::TLDownload;
10
11 use TeXLive::TLUtils;
12 use TeXLive::TLConfig;
13
14 my $svnrev = '$Revision: 61372 $';
15 my $_modulerevision;
16 if ($svnrev =~ m/: ([0-9]+) /) {
17 $_modulerevision = $1;
18 } else {
19 $_modulerevision = "unknown";
20 }
21 sub module_revision {
22 return $_modulerevision;
23 }
24
25 # since Net::HTTP and Net::FTP are shipped by the same packages
26 # we only test for Net::HTTP, if that fails, let us know ;-)
27 our $net_lib_avail = 0;
28 eval { require LWP; };
29 if ($@) {
30 debug("LWP is not available, falling back to wget.\n");
31 $net_lib_avail = 0;
32 } else {
33 require LWP::UserAgent;
34 require HTTP::Status;
35 $net_lib_avail = 1;
36 ddebug("LWP available, doing persistent downloads.\n");
37 }
38
39
40 sub new
41 {
42 my $class = shift;
43 my $self = {};
44 $self->{'initcount'} = 0;
45 bless $self, $class;
46 $self->reinit();
47 return $self;
48 }
49
50
51
52
53 sub reinit {
54 my $self = shift;
55
56 # Irritatingly, as of around version 6.52, when env_proxy is set, LWP
57 # started unconditionally complaining if the environment contains
58 # differing case-insensitive like foo=1 and FOO=2. Even on systems
59 # that have case-sensitive environments, and even about variables that
60 # have nothing whatsoever to do with LWP (like foo).
61 #
62 # So, only pass env_proxy=>1 when creating the UserAgent if there are
63 # in fact *_proxy variables (case-insensitive, just in case) set in
64 # the environment.
65 #
66 my @env_proxy = ();
67 if (grep { /_proxy/i } keys %ENV ) {
68 @env_proxy = ("env_proxy", 1);
69 }
70 #
71 my $ua = LWP::UserAgent->new(
72 agent => "texlive/lwp",
73 # use LWP::ConnCache, and keep 1 connection open
74 keep_alive => 1,
75 timeout => $TeXLive::TLConfig::NetworkTimeout,
76 @env_proxy,
77 );
78 $self->{'ua'} = $ua;
79 $self->{'enabled'} = 1;
80 $self->{'errorcount'} = 0;
81 $self->{'initcount'} += 1;
82 }
83
84 sub enabled {
85 my $self = shift;
86 return $self->{'enabled'};
87 }
88 sub disabled
89 {
90 my $self = shift;
91 return (!$self->{'enabled'});
92 }
93 sub enable
94 {
95 my $self = shift;
96 $self->{'enabled'} = 1;
97 # also reset the error conter
98 $self->reset_errorcount;
99 }
100 sub disable
101 {
102 my $self = shift;
103 $self->{'enabled'} = 0;
104 }
105 sub initcount
106 {
107 my $self = shift;
108 return $self->{'initcount'};
109 }
110 sub errorcount
111 {
112 my $self = shift;
113 if (@_) { $self->{'errorcount'} = shift }
114 return $self->{'errorcount'};
115 }
116 sub incr_errorcount
117 {
118 my $self = shift;
119 return(++$self->{'errorcount'});
120 }
121 sub decr_errorcount
122 {
123 my $self = shift;
124 if ($self->errorcount > 0) {
125 return(--$self->{'errorcount'});
126 } else {
127 return($self->errorcount(0));
128 }
129 }
130
131 sub reset_errorcount {
132 my $self = shift;
133 $self->{'errorcount'} = 0;
134 }
135
136 sub get_file {
137 my ($self,$url,$out,$size) = @_;
138 #
139 # automatically disable if error count is getting too big
140 if ($self->errorcount > $TeXLive::TLConfig::MaxLWPErrors) {
141 $self->disable;
142 }
143 # return if disabled
144 return if $self->disabled;
145 #
146 my $realout = $out;
147 my ($outfh, $outfn);
148 if ($out eq "|") {
149 ($outfh, $outfn) = tl_tmpfile();
150 $realout = $outfn;
151 }
152 my $response = $self->{'ua'}->get($url, ':content_file' => $realout);
153 if ($response->is_success) {
154 $self->decr_errorcount;
155 if ($out ne "|") {
156 return 1;
157 } else {
158 # seek to beginning of file
159 seek $outfh, 0, 0;
160 return $outfh;
161 }
162 } else {
163 debug("TLDownload::get_file: response error: "
164 . $response->status_line . " (for $url)\n");
165 $self->incr_errorcount;
166 return;
167 }
168 }
169
170
171
172 1;
173 __END__
174
175
176 =head1 NAME
177
178 C<TeXLive::TLDownload> -- TeX Live persistent downloads via LWP
179
180 =head1 SYNOPSIS
181
182 use TeXLive::TLDownload;
183
184 $TeXLive::TLDownload::net_lib_avail
185 my $dl = TeXLive::TLDownload->new();
186 $dl->get_file($relpath, $output [, $expected_size ]);
187 if ($dl->enabled) ...
188 if ($dl->disabled) ...
189 $dl->enable;
190 $dl->disable;
191 $dl->errorcount([n]);
192 $dl->incr_errorcount;
193 $dl->decr_errorcount;
194 $dl->reset_errorcount;
195
196 =head1 DESCRIPTION
197
198 The C<TeXLive::TLDownload> is a wrapper around the LWP modules that
199 allows for persistent connections and different protocols. At load
200 time it checks for the existence of the LWP module(s), and sets
201 C<$TeXLive::TLDownload::net_lib_avail> accordingly.
202
203 =head2 Using proxies
204
205 Please see C<LWP::UserAgent> for details, in a nut shell one can
206 specify proxies by setting C<I<protocol>_proxy> variables.
207
208 =head2 Automatic disabling
209
210 The TLDownload module implements some automatic disabling feature.
211 Every time a download did not succeed an internal counter (errorcount)
212 is increased, everytime it did succeed it is decreased (to a minimum of 0).
213 If the number of error goes above the maximal error count, the download
214 object will be disabled and get_file always returns undef.
215
216 In this cases the download can be reset with the reset_errorcount and
217 enable function.
218
219 =head1 SEE ALSO
220
221 LWP
222
223 =head1 AUTHORS AND COPYRIGHT
224
225 This script and its documentation were written for the TeX Live
226 distribution (L<https://tug.org/texlive>) and both are licensed under the
227 GNU General Public License Version 2 or later.
228
229 =cut
230
231 ### Local Variables:
232 ### perl-indent-level: 2
233 ### tab-width: 2
234 ### indent-tabs-mode: nil
235 ### End:
236 # vim:set tabstop=2 expandtab: #