Upload de múltiplos arquivos para Imageshack.us

Publicado por Yves Junqueira Marques Teixeira 07/01/2005

[ Hits: 7.279 ]

Download imageshack_upload.pl




Esse script automatiza o envio de imagens para o serviço gratuito imageshack.us.
Facilita muito a vida de quem tem dezenas de foto pra compartilhar mas tem preguiça de enviar uma foto de cada vez.
Peço por favor não abusar do serviço e sempre que possível visitar as propagandas lá do site deles. Ou, melhor ainda, fazer uma doação pra eles, usando paypal. Sejam conscientes!

  



Esconder código-fonte

#!/usr/bin/perl -w
#######################################################
# imageshack_upload.pl
# - Yves Junqueira, Jan/2005
# Script para enviar diversas imagens para o serviço
# imageshack.us
# Favor não abusar! Contribua com alguns cliques nas
# propagandas daquele site.
#######################################################
# Utilização:
#
#    $ perl imageshack_upload.pl vol.jpg 
#      Enviando vol.jpg... Feito.
#      IMAGEM: http://img119.exs.cx/img119/7908/vol3jp.jpg
#
use strict;
use WWW::Mechanize;

my $url = "http://www.imageshack.us/";
my $verb = 0;

die "Uso: $0 <arquivo1> [arquivo2] ... [arquivoN]" unless @ARGV > 0;
my $mech = WWW::Mechanize->new();
$mech->agent_alias("Linux Mozilla");
$mech->get($url);
 
foreach (@ARGV) {
print "Enviando $_... ";
my $r = $mech->submit_form(
   form_number => 1,
   fields  => { "fileupload" => $_ },
   );
($mech->success) ? print "Feito.\n" : 
   warn $mech->response->status_line;
my $l = image_link($r);

print "IMAGEM: $l\n";
$mech->back;
}

sub image_link {
  my $r = shift;
  my $c = $r->content;

if ($verb == 1) { print "\n------------\n$c\n------------\n"; }
  if ($c =~ m{Here is a direct link to your image\.<br />\s+<textarea cols="100" rows="1" name="select" onClick='highlight\(this\);'>([^>]*)</text}s) {
return $1;
  }
  die "Resposta desconhecida\n---------------------------\n$c\n";
}

Scripts recomendados

Web crawler simples em Perl

Sarg Diario

Postando mensagem no Facebook com Perl

Google Tradutor

PDF completo com todas as páginas do Diário Oficial do Estado de Goiás


  

Comentários
[1] Comentário enviado por juliansoares em 16/02/2012 - 11:00h

esta dando esse erro no script

Can't locate WWW/Mechanize.pm in @INC (@INC contains: /etc/perl /usr/local/lib/perl/5.14.2 /usr/local/share/perl/5.14.2 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.14 /usr/share/perl/5.14 /usr/local/lib/site_perl .) at imageshack_upload.pl line 17.
BEGIN failed--compilation aborted at imageshack_upload.pl line 17.


Contribuir com comentário




Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts