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 my $enc = find_encoding($coding);
  17
  18 my @URLs;
  19 if ($target !~ /^http/ && -f $target) {
  20     open(my $fh, "<$target");
  21     @URLs = <$fh>;
  22 }
  23 else {
  24     push @URLs, $target;
  25 }
  26
  27 foreach my $url (@URLs) {
  28     chomp $url;
  29     my $tmpfile = tmpnam();
  30     my $res = $ua->mirror($url, $tmpfile);
  31
  32     if ($res->is_success) {
  33         my $filename = $res->filename;
  34         my $decoder = Encode::Guess->guess($filename);
  35         if (ref($decoder)) {
  36             $filename = $enc->encode($decoder->decode($filename));
  37         }
  38
  39         my $suffix = 1;
  40         my $savename = $filename;
  41         while (-e $savename) {
  42             $savename = "$filename.$suffix";
  43             $suffix++;
  44         }
  45         rename($tmpfile, $savename);
  46     }
  47     else {
  48         unlink($tmpfile);
  49     }
  50 }