#!/usr/bin/perl -w

#    get_de_zip.pl
#          
#    Copyright(C) Since 2006 Akira KAKINOHANA All Rights Reserved
#    Author :  Akira KAKINOHANA <kira@kirameister.net>
#    Distributed at : http://softwares.kirameister.net/
#    
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation version 3.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    For GNU General Public License, see <http://www.gnu.org/licenses/>.

use warnings;
use strict;
use Encode;
use LWP::Simple;
use URI::Title;
use Archive::Zip;
use Getopt::Std;

my %opts = ();
getopts ("n:qvh", \%opts);

if ( $opts{v} ){
  print " Get de ZIP script version 0.31 written by kira\@kirameister.net\n";
  exit;
}
if (exists $opts{h}){
  print '
 Get de ZIP script lets you automatically download the picture (*.jpg and *.png) files,
 which are linked by the specified address, on your local machine and zip them into one file.

Usage : $0 [qvhn:] Target_Address

 options :
  q : quiet mode
  v : show version
  h : show help
  n NAME : zip the file under specified name

';
    exit;
}

my $target_address = shift or die "Usage: $0 Target_Address \n";
my $page_title;
if (exists $opts{n}){
    $page_title = $opts{n};
    print STDERR "Page Title : " .  $page_title . "\n";
    $opts{n} = 0;
}else{
    $page_title = URI::Title::title($target_address);
    print STDERR "Page Title : " . encode('utf8', $page_title) . "\n";
}

$page_title =~ s/&/ and /g;
$page_title =~ s/\// - /g;

my $zipfilename = encode('utf8', $page_title) . ".zip";
$zipfilename = $page_title . ".zip" if (exists $opts{n});

my $returned_HTML = get($target_address) or die "Cannot retrieve the data from : $target_address\n";

warn "=== Data retrieval succeeded ===\n" unless (exists $opts{q});

my @list = split( /[<>]/, $returned_HTML );

warn "=== Matched addresses: \n" unless (exists $opts{q});
my %links;
my $i;
foreach $i (@list) {
    if ( $i =~ m/[aA].*? href=\"(http.*?\.[jJ][pP][gG])\"/ || $i =~ m/[aA].*? href=\"(http.*?\.[pP][nN][gG])\"/ || $i =~ m/[aA].*? href=(http.*?\.[jJ][pP][gG])/ || $i =~ m/[aA].*? href=(http.*?\.[pP][nN][gG])/ ){ # absolute path
	$links{$1} = 1;
	warn " $1\n" unless (exists $opts{q});
    }elsif ( $i =~ m/[aA].*? href=\"(.+?\.[jJ][pP][gG])\"/ || $i =~ m/[aA].*? href=\"(.+?\.[pP][nN][gG])\"/ || $i =~ m/[aA].*? href=(.+?\.[jJ][pP][gG])/ || $i =~ m/[aA].*? href=(.+?\.[pP][nN][gG])/ ){ # relative path
	#warn "base : $target_address \t url : $1\n";
	#$links{$1} = &dir_normalize($target_address, $1);
	$links{&dir_normalize($target_address, $1)} = 1;
	warn " " .&dir_normalize($target_address, $1) . "\n" unless (exists $opts{q});
    }
}
warn "===\n" unless (exists $opts{q});

die "No link found, quitting..\n" if (! %links);

warn "=== Storing the files ===\n" unless (exists $opts{q});
#exit; ## debugging..
my @removelist; 

my $zip = Archive::Zip->new();
foreach $i (keys %links) {
    $i =~ /^.*\/(.*?)$/;
    my $filename = $1;
    warn "storing the file : $filename\n" unless (exists $opts{q});
    getstore ($i , $filename) || print STDERR "No file found at $i , countiruing..\n";
    $zip -> addFile($filename);
    push (@removelist, $filename);
}

warn "=== File storing finished ===\n" unless (exists $opts{q});

print STDERR "=== Zipping the files .. " unless (exists $opts{q});
$zip -> writeToFileNamed ($zipfilename);
warn "Finished ===\n" unless (exists $opts{q});

print STDERR "=== Cleaning the files .. " unless (exists $opts{q});
foreach $i (@removelist){
    unlink ($i);
}
warn "Finished ===\n" unless (exists $opts{q});

sub dir_normalize{
    (my $base, my $url) = @_;
    if ($url =~ /^\.\//){
        $url =~ s/^\.\///;
        $url = &dir_normalize($base, $url);
    }elsif ($url =~ /^\.\.\//){ #still have to dig..
    #if ($url =~ /^\.\.\//){ #still have to dig..
	$url =~ s/^\.\.\///;
	$base =~ s/^(.*)\/.*?$/$1/;
	$url = &dir_normalize($base, $url);
	return $url;
    }else{ # no more digging
	$base =~ s/^(.*)\/.*?$/$1/;
	$url = $base . "/" . $url;
	return $url;
    }
}