git.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/local/get.t

   1 #
   2 # Test retrieving a file with a 'file://' URL,
   3 #
   4
   5 if ($^O eq "MacOS") {
   6     print "1..0\n";
   7     exit;
   8 }
   9
  10
  11 # First locate some suitable tmp-dir.  We need an absolute path.
  12 $TMPDIR = undef;
  13 for ("/tmp/", "/var/tmp", "/usr/tmp", "/local/tmp") {
  14     if (open(TEST, ">$_/test-$$")) {
  15         close(TEST);
  16         unlink("$_/test-$$");
  17         $TMPDIR = $_;
  18         last;
  19     }
  20 }
  21 $TMPDIR ||= $ENV{TEMP} if $^O eq 'MSWin32';
  22 unless ($TMPDIR) {
  23    # Can't run any tests
  24    print "1..0\n";
  25    print "ok 1\n";
  26    exit;
  27 }
  28 $TMPDIR =~ tr|\\|/|;
  29 print "1..2\n";
  30
  31 use LWP::Simple;
  32 require LWP::Protocol::file;
  33
  34 my $orig = "$TMPDIR/lwp-orig-$$";          # local file
  35 my $copy = "$TMPDIR/lwp-copy-$$";           # downloaded copy
  36
  37 # First we create the original
  38 open(OUT, ">$orig") or die "Cannot open $orig: $!";
  39 binmode(OUT);
  40 for (1..100) {
  41     print OUT "This is line $_ of $orig\n";
  42 }
  43 close(OUT);
  44
  45
  46 # Then we make a test using getprint(), so we need to capture stdout
  47 open (OUT, ">$copy") or die "Cannot open $copy: $!";
  48 select(OUT);
  49
  50 # do the retrieval
  51 getprint("file://localhost" . ($orig =~ m|^/| ? $orig : "/$orig"));
  52
  53 close(OUT);
  54 select(STDOUT);
  55
  56 # read and compare the files
  57 open(IN, $orig) or die "Cannot open '$orig': $!";
  58 undef($/);
  59 $origtext = <IN>;
  60 close(IN);
  61 open(IN, $copy) or die "Cannot open '$copy': $!";
  62 undef($/);
  63 $copytext = <IN>;
  64 close(IN);
  65
  66 unlink($copy);
  67
  68 if ($origtext eq $copytext) {
  69     print "ok 1\n";
  70 }
  71 else {
  72     print "not ok 1\n";
  73 }
  74
  75
  76 # Test getstore() function
  77
  78 getstore("file:$orig", $copy);
  79
  80 # Take a look at the new copy
  81 open(IN, $copy) or die "Cannot open '$copy': $!";
  82 undef($/);
  83 $copytext = <IN>;
  84 close(IN);
  85
  86 unlink($orig);
  87 unlink($copy);
  88
  89 if ($origtext eq $copytext) {
  90     print "ok 2\n";
  91 }
  92 else {
  93     print "not ok 2\n";
  94 }