#!/usr/bin/perl

use strict;

use warnings;

use feature qw(say);

use HTTP::Cookies;

use WWW::Mechanize;

use Getopt::Euclid;

use Term::ReadPassword;

use constant COOKIE   => "$ENV{HOME}/.legendas.tv.cookie";

use constant PT_BR => 1;

use constant EN    => 2;

use constant ES    => 3;

use constant PT    => 10;

use constant ALL   => 99;

use constant OTHER => 100;

use constant SELECT_LANG => PT_BR;

sub clean {

    my $cookie = shift;

    say ' * limpando cookie';

    $cookie->clear;

}

my $cookie = HTTP::Cookies->new(file => COOKIE, autosave => 1);

my $logged = 0;

$cookie->scan(sub {

      my ($key, $expires) = ($_[1], $_[8]);

      return unless $key eq 'Auth';

      $logged = ($expires > time ? 1 : 0);

});

my $browser = WWW::Mechanize->new(cookie_jar => $cookie);

say ' * acessando legendas.tv';

$browser->get('http://legendas.tv');

unless ($logged) {

   say ' * entre com seu login e senha';

   print '   login: '; chomp(my $LOGIN = <STDIN>);

   my $PASSWORD = read_password('   senha: ');

   say ' * logando';

   $browser->submit_form(

      form_name   => 'form1',

      form_number => 1,

      fields      => { txtLogin => $LOGIN, txtSenha => $PASSWORD, chkLogin => 1 },

      button      => 'entrar',

   );

   $browser->follow_link( text_regex => qr/clique aqui caso/i );

}

say " * pesquisando $ARGV{'<filme>'}";

$browser->submit_form(

   form_name   => 'form1',

   form_number => 1,

   fields      => { txtLegenda => $ARGV{'<filme>'}, selTipo => 1, int_idioma => SELECT_LANG },

   button      => 'btn_buscar',

);

my $result = $browser->content;

my @film = ();

while ($result =~ m/<span onmouseover.*?gpop\('([^']+)','([^']+)','([^']+)','(\d+)','\d+','(\d+MB)',.*?abredown\('(\w+)'\)/sigo) {

   push @film, {filme => $1, descricao => $2, release => $3, cds => $4, size => $5, id => $6};

}

if (@film > 0) {

   say " * ", scalar(@film), " legenda(s) encontrada(s)";

}

else {

   say " * nenhuma legenda encontrada!";

   clean($cookie) if defined $ARGV{'-c'};

   exit -1;

}

my $response = 's';

while ($response eq 's') {

   for my $index (0 .. $#film) {

      my $n = $index + 1;

      say "\n ", $n, " $film[$index]->{release}";

      say "   $film[$index]->{filme} - $film[$index]->{descricao}";

      say "   tamanho: $film[$index]->{size}, cds: $film[$index]->{cds}";

   }

   print "\n   Selecione uma legenda para baixar: (q para sair) ";

   chomp(my $n = <STDIN>);

   last if $n eq 'q';

   my $index = $n - 1;

   say "\n * baixando legenda $film[$index]->{release}";

   $browser->get("http://legendas.tv/info.php?d=$film[$index]->{id}&c=1");

   say ' * arquivo ' . $browser->response->filename . ' salvo';

   $browser->save_content('./'. $browser->response->filename);

   print "\n   baixar outra legenda? (s/n)";

   chomp($response = <STDIN>);

}

clean($cookie) if defined $ARGV{'-c'};

exit 0;

__END__

=head1 NAME

legendas.tv - pesquisa e baixa legendas do site legendas.tv

=head1 VERSION

0.03

=head1 USAGE

legendas.tv <filme> [options]

=head1 REQUIRED ARGUMENTS

=over

=item <filme>

Nome do filme

=for Euclid

   filme.type: string, length(filme) > 2

=back

=head1 OPTIONS

=over

=item -c

Limpa o cache

=back

=head1 DEPENDENCIES

L<HTTP::Cookies>,

L<WWW::Mechanize>,

L<Getopt::Euclid>,

L<Term::ReadPassword>

=head1 TODO

Exibir legendas das proximas paginas quando houver paginação

=head1 AUTHOR

Joenio Costa <joenio@perl.org.br>

=head1 COPYRIGHT

Copyright (c) 2008, Joenio Costa. All Rights Reserved.

This program is free software: you can redistribute it and/or modify

it under the terms of the GNU General Public License version 3 as

published by the Free Software Foundation.