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
|
#
# Test retrieving a file with a 'file://' URL,
#
# First locate some suitable tmp-dir. We need an absolute path.
$TMPDIR = undef;
for ("/tmp/", "/var/tmp", "/usr/tmp", "/local/tmp") {
if (open(TEST, ">$_/test-$$")) {
close(TEST);
unlink("$_/test-$$");
$TMPDIR = $_;
last;
}
}
$TMPDIR ||= $ENV{TEMP} if $^O eq 'MSWin32';
unless ($TMPDIR) {
# Can't run any tests
print "1..0\n";
print "ok 1\n";
exit;
}
$TMPDIR =~ tr|\\|/|;
print "1..2\n";
use LWP::Simple;
require LWP::Protocol::file;
my $orig = "$TMPDIR/lwp-orig-$$"; # local file
my $copy = "$TMPDIR/lwp-copy-$$"; # downloaded copy
# First we create the original
open(OUT, ">$orig") or die "Cannot open $orig: $!";
for (1..100) {
print OUT "This is line $_ of $orig\n";
}
close(OUT);
# Then we make a test using getprint(), so we need to capture stdout
open (OUT, ">$copy") or die "Cannot open $copy: $!";
select(OUT);
# do the retrieval
getprint("file://localhost" . ($orig =~ m|^/| ? $orig : "/$orig"));
close(OUT);
select(STDOUT);
# read and compare the files
open(IN, $orig) or die "Cannot open '$orig': $!";
undef($/);
$origtext = <IN>;
close(IN);
open(IN, $copy) or die "Cannot open '$copy': $!";
undef($/);
$copytext = <IN>;
close(IN);
unlink($copy);
if ($origtext eq $copytext) {
print "ok 1\n";
} else {
print "not ok 1\n";
}
# Test getstore() function
getstore("file:$orig", $copy);
# Take a look at the new copy
open(IN, $copy) or die "Cannot open '$copy': $!";
undef($/);
$copytext = <IN>;
close(IN);
unlink($orig);
unlink($copy);
if ($origtext eq $copytext) {
print "ok 2\n";
} else {
print "not ok 2\n";
}
|
