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!

• Download imageshack_upload.pl
• Enviar nova versão

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";
}

Web crawler simples em Perl

Sarg Diario

Tweetin - Poste tweets pelo terminal

Avisar por e-mail se o IP da conexão ADSL mudar

Obtendo a temperatura com Perl