-
Notifications
You must be signed in to change notification settings - Fork 35
/
NetGet.pm
154 lines (102 loc) · 3.33 KB
/
NetGet.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
package OmniPITR::Tools::NetGet;
use strict;
use warnings;
use OmniPITR::Tools qw( run_command );
use English qw( -no_match_vars );
use Data::Dumper;
use Carp;
use base qw( Exporter );
=head1 NAME
OmniPITR::Tools::NetGet - Module for getting files over HTTP
=cut
our $VERSION = '1.0.0';
our @EXPORT_OK = qw( download );
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK );
our $getter = undef;
=head1 SYNOPSIS
General usage is:
OmniPITR::Tools::NetGet->download( 'http://some/url', 'local.file' );
=head1 DESCRIPTION
This module is used for remote file access from OmniPITR. It's purpose is to abstract out whether HTTP transfer is done using LWP module, or one of supported shell tools (curl, wget).
In all of the cases, interface is the same: single download() call, with two parameters.
=cut
=head1 download()
Downloads given url, and saves response (without headers) in given file path.
Parameters:
=over
=item 1. url
=item 2. local file name (with path)
=back
=cut
sub download {
my ( $url, $local_filename ) = @_;
_pick_download_method();
return $getter->( $url, $local_filename );
}
=head1 _pick_download_method()
Helper function, which sets module-variable $getter to coderef for function
that actually does download.
=cut
sub _pick_download_method {
return if defined $getter;
eval {
require LWP::UserAgent;
import LWP::UserAgent;
};
if ( !$EVAL_ERROR ) {
$getter = \&_download_via_lwp;
return;
}
my $temp_dir = $ENV{ 'TMPDIR' } || '/tmp';
my $wget = run_command( $temp_dir, 'wget', '--version' );
if ( !$wget->{ 'error_code' } ) {
$getter = \&_download_via_wget;
return;
}
my $curl = run_command( $temp_dir, 'curl', '--version' );
if ( !$curl->{ 'error_code' } ) {
$getter = \&_download_via_curl;
return;
}
croak( 'There is none of: LWP::UserAgent perl module, wget program nor curl program available?!' );
}
=head1 _download_via_lwp
Actual downloading code, using LWP::UserAgent module.
=cut
sub _download_via_lwp {
my ( $url, $filename ) = @_;
open my $fh, '>', $filename or croak( "Cannot write to $filename: $OS_ERROR" );
binmode $fh;
my $agent = LWP::UserAgent->new();
my $response = $agent->get( $url );
my $code = $response->code;
croak( "Getting $url failed with HTTP/$code\n" ) if 200 != $code;
print $fh $response->decoded_content( 'charset' => 'none' );
close $fh;
return;
}
=head1 _download_via_wget
Actual downloading code, using wget program
=cut
sub _download_via_wget {
my ( $url, $filename ) = @_;
my $temp_dir = $ENV{ 'TMPDIR' } || '/tmp';
my $rc = run_command( $temp_dir, 'wget', '-O', $filename, $url );
croak( "Getting $url failed with " . $rc->{ 'stderr' } ) if $rc->{ 'error_code' };
return;
}
=head1 _download_via_curl
Actual downloading code, using curl program
=cut
sub _download_via_curl {
my ( $url, $filename ) = @_;
open my $fh, '>', $filename or croak( "Cannot write to $filename: $OS_ERROR" );
binmode $fh;
my $temp_dir = $ENV{ 'TMPDIR' } || '/tmp';
my $rc = run_command( $temp_dir, 'curl', '--silent', '--show-error', '--fail', '--location', $url );
croak( "Getting $url failed with " . $rc->{ 'stderr' } ) if $rc->{ 'error_code' };
print $fh $rc->{ 'stdout' };
close $fh;
return;
}
1;