misc/save.pl

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6
   7 use LWP::UserAgent;
   8 use Encode;
   9 use Encode::Guess qw/shift-jis euc-jp 7bit-jis/;
  10 use File::Temp qw/ :POSIX /;
  11
  12 my $target = shift @ARGV || die "$0: URL or file-of-url-list [coding]\n";
  13 my $coding = shift @ARGV || 'utf8';
  14
  15 my $ua  = LWP::UserAgent->new;
  16
  17 my @URLs;
  18 if ($target !~ /^http/ && -f $target) {
  19     open(my $fh, "<$target");
  20     @URLs = <$fh>;
  21 }
  22 else {
  23     push @URLs, $target;
  24 }
  25
  26 foreach my $url (@URLs) {
  27     chomp $url;
  28     my $tmpfile = tmpnam();
  29     my $res = $ua->mirror($url, $tmpfile);
  30
  31     if ($res->is_success) {
  32         my $filename = $res->filename;
  33         my $decoder = Encode::Guess->guess($filename);
  34         if (ref($decoder)) {
  35             print $decoder->name;
  36             $filename = encode(
  37                 $coding,
  38                 $decoder->decode($filename),
  39                 Encode::FB_HTMLCREF
  40             );
  41         }
  42         else {
  43             print "utf8?";
  44             $filename = encode(
  45                 $coding,
  46                 decode("utf8", $filename),
  47                 Encode::FB_HTMLCREF
  48             );
  49         }
  50         print ": $filename\n";
  51
  52         my $suffix = 1;
  53         my $savename = $filename;
  54         while (-e $savename) {
  55             $savename = "$filename.$suffix";
  56             $suffix++;
  57         }
  58         rename($tmpfile, $savename);
  59     }
  60     else {
  61         unlink($tmpfile);
  62     }
  63 }