« Linux Journal Julio 2006: Heinemeier, Ruby y Rails
Rails Day 2006 »

Interfaces gráficas en Perl: Como embellecer a un camello

Publicado por josevnz 4 Junio 2006 en General, How To's, Perl, Software Libre / Abierto, XML, linux. english • español

Perl Tk no es un milagro
En mi blog escribí hace tiempo un articulo que mostraba como bajarse todas las imagenes públicas de una persona en Flickr utilizando Perl y Java, todo eso usando el API de Flick. Para refrescar la memoria les coloco aquí lo que hize con el módulo 'Flickr::API'; Si no lo tiene y utiliza Linux, entonces utilice CPAN para montarlo: perl -MCPAN -e 'install Flickr::API':

PLAIN TEXT
CODE:
  1. Running make install
  2. Installing /usr/lib/perl5/site_perl/5.8.6/Flickr/API.pm
  3. Installing /usr/lib/perl5/site_perl/5.8.6/Flickr/API/Response.pm
  4. Installing /usr/lib/perl5/site_perl/5.8.6/Flickr/API/Request.pm
  5. Installing /usr/share/man/man3/Flickr::API.3pm
  6. Installing /usr/share/man/man3/Flickr::API::Response.3pm
  7. Installing /usr/share/man/man3/Flickr::API::Request.3pm
  8. Writing /usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi/auto/Flickr/API/.packlist
  9. Appending installation info to /usr/lib/perl5/5.8.6/i386-linux-thread-multi/perllocal.pod
  10.   /usr/bin/make install  -- OK

El código erá muy sencillo, sólo le pasabas como parametros la clave de Flickr y el usuario de el cual te quieras bajar las fotos y listo:

PLAIN TEXT
PERL:
  1. #!/usr/bin/perl
  2. use strict;
  3. use Flickr::API;
  4. use Data::Dumper;
  5. use LWP::UserAgent;
  6.  
  7. # Put your Flickr key here:
  8. use constant API_KEY  => 'xxx';
  9. use constant PER_PAGE => 500;
  10. use constant PAGE     => 1;
  11. use constant DEBUG    => 0;
  12.  
  13. if (! defined $ARGV[0]) {
  14.         die "[ERROR]: Please provide the user ID!";
  15. } else {
  16.         printf "Getting list of public pictures for '%s'\n", $ARGV[0];
  17. }
  18. my $api = new Flickr::API({
  19.                 'key' => API_KEY}
  20.                 );
  21. my $ua = LWP::UserAgent->new;
  22. # Get the user NSID first
  23. my $response = $api->execute_method(
  24.         'flickr.people.findByUsername', {
  25.                 'username'  => $ARGV[0]
  26.         });
  27. if (! $response->{success}) {
  28.         die "[ERROR]: " . $response->{error_message} . " ($ARGV[0])";
  29. }
  30. # Parse the tree and get the NSID
  31. my %tree = %{$response->{tree}};
  32. # Cheat with 'print Dumper($tree);' to get the value I want right away
  33. my $id = $tree{children}->[1]->{attributes}->{nsid};
  34. if (DEBUG) {
  35.         printf "%s\n", $id;
  36. }
  37. # Get now the list of public photos
  38. $response = $api->execute_method(
  39.         'flickr.photos.search', {
  40.                 'user_id'  => $id
  41.         });
  42. %tree = %{$response->{tree}};
  43. # Get the photo information. For that we get a more manageable structure
  44. my @subtree = @{$tree{children}->[1]->{children}};
  45. if (DEBUG) {
  46.         print Dumper(\@subtree);
  47. }
  48. foreach my $ref (@subtree) {
  49.         my $attributes = $$ref{attributes};
  50.         next if $attributes == undef;
  51.         # Construct the URL like this:
  52.         # http://photos{server-id}.flickr.com/{id}_{secret}_o.(jpg|gif|png)
  53.         my $url = "http://photos" .
  54.                 $$attributes{'server'} .
  55.                 ".flickr.com/" .
  56.                 $$attributes{'id'} .
  57.                 "_" .
  58.                 $$attributes{'secret'} .
  59.                 "_o.jpg";
  60.         printf "Downloading: %s -> %s...", $$attributes{'title'}, $url;
  61.         $ua->mirror(
  62.                 $url,
  63.                 $$attributes{'id'} . "_" . $$attributes{'secret'} . "_o.jpg"
  64.                 );
  65.         if ($response->is_success) {
  66.                 printf "OK\n";
  67.         } else {
  68.                 printf "ERROR\n";
  69.         }
  70.  
  71. }
  72. __END__
  73.  
  74. =head1 NAME
  75.  
  76. DownloadPictures.plx - A program that downloads all the public pictures for
  77. a given user, from Flickr.com
  78.  
  79. =head1 DESCRIPTION
  80.  
  81. This program uses the API as described in 'http://www.flickr.com/services/api/',
  82. and uses the Perl module Flickr::API (http://search.cpan.org/~iamcal/Flickr-API/).
  83.  
  84. How to use:
  85.  
  86. ./DownloadPublicPictures.plx <flickr user name>
  87.  
  88. =head1 AUTHOR
  89.  
  90. Jose Vicente Nunez Zuleta
  91.  
  92. =head1 BLOG
  93.  
  94. El Angel Negro - http://elangelnegro.blogspot.com
  95.  
  96. =head1 LICENSE
  97.  
  98. GPL
  99.  
  100. =cut

El script es sencillo, fácil de usar y feo :). El script trabaja más o menos así:

PLAIN TEXT
CODE:
  1. Getting list of public pictures for 'josevnz'
  2. Downloading: Picture -> http://photos48.flickr.com/154791207_7f1c2cb3e5_o.jpg...OK
  3. Downloading: bombones 005 -> http://photos55.flickr.com/151559225_c38baad4ff_o.jpg...OK
  4. Downloading: bombones 004 -> http://photos49.flickr.com/151558983_8bcec2dcc1_o.jpg...OK
  5. Downloading: bombones 003 -> http://photos47.flickr.com/151558718_5d7be20c4d_o.jpg...OK
  6. Downloading: bombones 002 -> http://photos52.flickr.com/151558495_4445aab3d2_o.jpg...OK
  7. Downloading: bombones 001 -> http://photos44.flickr.com/151558324_d362c91b31_o.jpg...OK
  8. Downloading: backup index -> http://photos52.flickr.com/145892133_f3da092eaa_o.jpg...OK
  9. Downloading: Stop -> http://photos49.flickr.com/141706199_5189a46d1e_o.jpg...OK
  10. Downloading: Cross -> http://photos46.flickr.com/141706096_af843c443c_o.jpg...OK

Seria mejor tener un script que mostrara los resultados en una ventana aparte, así que para reusar el código escrito en Perl usamos Perl Tk.

NOTA: Si usted utiliza Fedora 4 entonces puede instalar Perl TK de la siguiente manera (como root):

PLAIN TEXT
CODE:
  1. [root@localhost ~]# yum install perl-Tk
  2. Setting up Install Process
  3. Setting up repositories
  4. livna                     100% |=========================|  951 B    00:00
  5. updates-released          100% |=========================|  951 B    00:00

El código completo que hace el truco es el siguiente:

PLAIN TEXT
PERL:
  1. #!/usr/bin/perl
  2. use strict;
  3. use Flickr::API;
  4. use Data::Dumper;
  5. use LWP::UserAgent;
  6. use Tk;
  7. use Tk::ProgressBar;
  8. use Tk::ROText;
  9. use Tk::Balloon;
  10. use Tk::DialogBox;
  11.  
  12. # Put your Flickr key here:
  13. use constant API_KEY  => 'xxxx';
  14. use constant PER_PAGE => 500;
  15. use constant PAGE     => 1;
  16. use constant DEBUG    => 0;
  17.  
  18. my $flickrId;
  19. my $percent_done;
  20.  
  21. printf "Starting application...\n";
  22. my $mainWindow = MainWindow->new(-title => 'KodeGeek.com: Download Flickr public pictures');
  23. $mainWindow->geometry('+500+300');
  24. # Create a simple menu
  25. my $menu = $mainWindow->Frame()->pack(-side => 'top', -fill => 'x');
  26. my $filemenu = $menu->Menubutton(
  27.   -text => 'File',
  28.   -underline => 0
  29. )->pack(-side => 'left');
  30. $filemenu->command(
  31.   -label => 'Quit',
  32.   -underline => 0,
  33.   -accelerator => 'Meta+Q',
  34.   -command => \&quit
  35. );
  36. my $frame = $mainWindow->Frame()->pack(-side => 'bottom', -fill => 'both');
  37. # Create the main window contents. Use more frames to align the components
  38. my $topFrame = $frame->Frame()->pack(-side => 'top', -fill => 'both');
  39. my $label = $topFrame->Label(
  40.   -text => 'Flickr user ID'
  41. )->pack(-side => "left")->pack();
  42. my $text = $topFrame->Entry(
  43.   -textvariable => \$flickrId
  44. )->pack(-side => "right", -fill => "x", -expand => 'x')->pack();
  45. my $bText = $mainWindow->Balloon();
  46. $bText->attach($text,-balloonmsg => "Please, type the Flickr ID with public photos");
  47. my $textArea = $frame->Scrolled(
  48.   'ROText',
  49.   -width => 60,
  50.   -height => 30
  51. )->pack(-side => "bottom", -fill => "y")->pack();
  52. my $download = $frame->Button(
  53.   -text => 'Download pictures',
  54.   -command => [\&getPhotos, \$flickrId, $mainWindow, $textArea, $text]
  55. )->pack(-side => "bottom", -fill => "x")->pack(-padx=>15, -pady=>15);
  56. my $dBaloom = $mainWindow->Balloon();
  57. $dBaloom->attach($download,-balloonmsg => "Click here to download the photos!");
  58.  
  59. MainLoop();
  60.  
  61. # Quit the app
  62. sub quit() {
  63.  $mainWindow->destroy();
  64.  printf "Exiting application...\n";
  65.  exit;
  66. }
  67.  
  68. # Get the public photos from Flickr
  69. sub getPhotos {
  70.     my $id       = ${$_[0]};
  71.     my $mainWindow = $_[1];
  72.     my $textArea = $_[2];
  73.  
  74.     $mainWindow->update();
  75.     my $api = new Flickr::API({
  76.                     'key' => API_KEY}
  77.                     );
  78.     my $ua = LWP::UserAgent->new;
  79.     # Get the user NSID first
  80.     my $response = $api->execute_method(
  81.             'flickr.people.findByUsername', {
  82.                     'username'  => $id
  83.             });
  84.     if (! $response->{success}) {
  85.             $textArea->insert('end', sprintf "[ERROR]: %s (%s)\n", $response->{error_message}, $id);
  86.             return;
  87.     }
  88.     $download->configure(-state => 'disabled');
  89.     $filemenu->configure(-state => 'disabled');
  90.     $text->configure(-state => 'disabled');
  91.     $text->delete('1.0', 'end');
  92.     # Parse the tree and get the NSID
  93.     my %tree = %{$response->{tree}};
  94.     # Cheat with 'print Dumper($tree);' to get the value I want right away
  95.     my $id = $tree{children}->[1]->{attributes}->{nsid};
  96.     if (DEBUG) {
  97.             printf "%s\n", $id;
  98.     }
  99.     # Get now the list of public photos
  100.     $response = $api->execute_method(
  101.             'flickr.photos.search', {
  102.                     'user_id'  => $id
  103.             });
  104.     %tree = %{$response->{tree}};
  105.     # Get the photo information. For that we get a more manageable structure
  106.     my @subtree = @{$tree{children}->[1]->{children}};
  107.     if (DEBUG) {
  108.             print Dumper(\@subtree);
  109.     }
  110.     my $position = 0;
  111.    
  112.     # Collect the real list of URL to download:
  113.     my %urlList = ();
  114.     # Get the list of photos
  115.     $textArea->insert('end', "Getting list of photos from Flickr\n");
  116.     $mainWindow->update();
  117.     foreach my $ref (@subtree) {
  118.             my $attributes = $$ref{attributes};
  119.             next if $attributes == undef;
  120.             # Construct the URL like this:
  121.             # http://photos{server-id}.flickr.com/{id}_{secret}_o.(jpg|gif|png)
  122.             my $url = "http://photos" .
  123.                     $$attributes{'server'} .
  124.                     ".flickr.com/" .
  125.                     $$attributes{'id'} .
  126.                     "_" .
  127.                     $$attributes{'secret'} .
  128.                     "_o.jpg";
  129.             $urlList{$url}->{DEST}  = $$attributes{'id'} . "_" . $$attributes{'secret'} . "_o.jpg";
  130.             $urlList{$url}->{TITLE} = $$attributes{'title'};
  131.     } # end for-each
  132.     $textArea->insert('end', sprintf "Preparing to download %d photos.\n",scalar(keys %urlList));
  133.     $mainWindow->update();
  134.     for my $url (keys %urlList) {
  135.             $textArea->insert('end', sprintf "%s -> %s...", $urlList{$url}->{TITLE}, $url);
  136.             $ua->mirror($url, $urlList{$url}->{DEST});
  137.             if ($response->is_success) {
  138.                     $textArea->insert('end', sprintf "OK\n");
  139.             } else {
  140.                     $textArea->insert('end', sprintf "ERROR\n");
  141.             }
  142.             $mainWindow->update();
  143.     }
  144.     $filemenu->configure(-state => 'normal');
  145.     $download->configure(-state => 'normal');
  146.     $text->configure(-state => 'normal');
  147. }
  148.  
  149. __END__
  150.  
  151. =head1 NAME
  152.  
  153. flickr_download_public_pic.pl - A program that downloads all the public pictures for
  154. a given user, from Flickr.com
  155.  
  156. =head1 DESCRIPTION
  157.  
  158. This program uses the API as described in 'http://www.flickr.com/services/api/',
  159. and uses the Perl module Flickr::API (http://search.cpan.org/~iamcal/Flickr-API/).
  160.  
  161. =head1 AUTHOR
  162.  
  163. Jose Vicente Nunez Zuleta
  164.  
  165. =head1 BLOG
  166.  
  167. KodeGeek - http://kodegeek.com
  168.  
  169. =head1 LICENSE
  170.  
  171. GPL
  172.  
  173. =cut

Algunas cosas interesantes:

  • La función que hacia la llamada a Flickr::API fué re-escrita para recibir información acerca de los componentes gráficos que hay que actualizar. No es la mejor práctica, pero hace el trabajo y mantiene el código simple
  • Note como llamamos a la función '$mainWindow->update()'. La idea es actualizar los componentes gráficos cada vez que hay un cambio.
  • La lista de componentes gráficos es bastante completa. Pueden darle un vistazo en el sitio de CPAN. Sin embargo la documentación realmente apesta.
  • Perl TK y Java Swing son muy similares; En Perl Tk podemos controlar la ubicación de los componentes usando un layout manager como pack() (o grid el cual no mostré en el ejemplo).
  • El manejo de eventos se hace utilizando callbacks (-command, -textvariable)

Finalmente los dejo con unos articulos interesantes sobre el tema, los cuales espero despertarán aún más su curiosidad:

Por cierto, se puede bajar el código fuente desde acá.

0 Respuestas a “Interfaces gráficas en Perl: Como embellecer a un camello”

Canal RSS de esta entrada Dirección Trackback
  1. Ningún Comentario

Añade un Comentario


« Linux Journal Julio 2006: Heinemeier, Ruby y Rails
Rails Day 2006 »

Buscar

Artículos relacionados

Comparte este artículo

RSS feeds

Suscríbete a nuestros RSS Feeds