#!/usr/bin/perl

use warnings;
use strict;
use Getopt::Std;
use WWW::Mechanize;
use File::Basename;
use File::Path 2.06_05 qw(make_path);
use Pod::Usage;

my $url_pattern="^http:\/\/(.*)\.rajce\.idnes\.cz\/(.*)";

$|++;

my %opt;
getopts('hvu:', \%opt);  

if($opt{h}){
	pod2usage(-verbose => 2, -output => '-');
	exit;
}

if(!$opt{u} or $opt{u} !~ /$url_pattern/ or $opt{h}){
	pod2usage(-verbose => 1, -output => '-');
	exit;
}

my ($username,$album) = $opt{u} =~ $url_pattern;

my $url = "http://$username.rajce.idnes.cz/$album";

my $bot = WWW::Mechanize->new(autocheck => 1, agent => 'Mozilla/5.0 (Windows NT 5.0; WOW64; rv:6.0) Gecko/20100101 Firefox/6.0');
$bot->env_proxy();
$bot->add_header('Accept-Encoding'=>'text/html');
$bot->cookie_jar(HTTP::Cookies->new());

my $gal = $bot->get($url);

my $storageurl = $gal->content();
$storageurl =~ s/.*var storage = "([^"]*)";.*/$1/s;

my @images = $bot->find_all_links(tag => "a", url_regex => qr/$storageurl/ );

my $outdir = "$username/$album";

info("Creating directory $outdir\n",%opt);
make_path($outdir);

foreach my $imglink (@images){
	info("Downloding ".basename($imglink->url())." ...",%opt);
	$bot->get($imglink->url, ':content_file' => "$outdir/".basename($imglink->url()) );
	sleep 1;
	info(" OK\n",%opt);
}

sub info{
	my ($message,%opt) = @_;
	if($opt{v}){
		print "$message";
	}
}
__END__
=head1 NAME

rajce-get - Download images from rajce.net.

=head1 SYNOPSIS

rajce-get [-h] [-v] -u URL

=head1 OPTIONS AND ARGUMENTS

	 -h - Help
	 -v - Verbose mode
	 -u http://username.rajce.idnes.cz/album - Address of requested album

=head1 DESCRIPTION

This program will download images from rajce.net. Images are saved in
directory username/album

Behind proxy server try:

export http_proxy=http://login:password@proxyserver:port

=head1 AUTHOR

Petr Kletecka, C<< <pek at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<pek at cpan.org>

=head1 LICENSE AND COPYRIGHT

Copyright 2011 Petr Kletecka.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

=head1 SEE ALSO

http://search.cpan.org/perldoc?WebService::Rajce

=cut