Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

FetLife picture downloader

By: a guest on Dec 18th, 2011  |  syntax: Perl  |  size: 1.63 KB  |  views: 671  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. #!/usr/bin/env perl
  2. # Download all FetLife pictures from a profile.
  3. #
  4. # Usage instructions:
  5. # * Fill in the constants.
  6. # * Make a folder named "images".
  7. # * Run the script.
  8.  
  9. use strict;
  10. use warnings;
  11. use WWW::Mechanize;
  12.  
  13. use constant {
  14.     USERNAME => 'username',
  15.     PASSWORD => 'password',
  16.     USERID   => 'fetlife-userid'
  17. };
  18.  
  19. my $mech = WWW::Mechanize->new();
  20.  
  21. main($mech);
  22.  
  23. sub login {
  24.     my $mech = shift;
  25.  
  26.     $mech->get('https://fetlife.com/login');
  27.  
  28.     $mech->submit_form(
  29.         with_fields => {
  30.             'nickname_or_email' => USERAME,
  31.             'password' => PASSWORD
  32.         }
  33.     );
  34. }
  35.  
  36. sub getPicturesOf {
  37.     my $mech = shift;
  38.     my $uid = shift;
  39.  
  40.     $mech->get("https://fetlife.com/users/$uid/pictures");
  41.  
  42.     my $next = $mech->find_link(text_regex => qr/Next /);
  43.     while (defined($next)) {
  44.         $next = $next->url;
  45.         downloadPictures($mech, $uid);
  46.         $mech->get("https://fetlife.com/$next");
  47.         $next = $mech->find_link(text_regex => qr/Next /);
  48.     }
  49.     downloadPictures($mech, $uid);
  50. }
  51.  
  52. sub downloadPictures {
  53.     my $mech = shift;
  54.     my $uid = shift;
  55.  
  56.     my @images = $mech->find_all_images(url_regex => qr{https://flpics\d.a.ssl.fastly.net/\d+/$uid/});
  57.  
  58.     map {
  59.         my $imgurl = $_->url;
  60.         $imgurl =~ s/\d+\.jpg$/720.jpg/;
  61.         if ($imgurl =~ m{/([^/]+)$}) {
  62.             print "Downloading $1\n";
  63.             $mech->get($imgurl, ":content_file" => "images/$1");
  64.         } else {
  65.             print "No go.\n";
  66.         }
  67.     } @images;
  68.  
  69. }
  70.  
  71. sub main {
  72.     my $mech = shift;
  73.  
  74.     login($mech);
  75.     getPicturesOf($mech, USERID);
  76. }