PERL   26

fiendpics

Guest on 10th June 2022 01:21:27 PM

  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4.  
  5. # Take your LJ username and password as arguments;
  6. # print to stdout an HTML page containing the userpics
  7. # of all your friends.
  8.  
  9. use RPC::XML;
  10. use RPC::XML::Client;
  11. use LWP::Simple;
  12. use HTML::TokeParser;
  13.  
  14. my $client = RPC::XML::Client->new(
  15.         '/interface/xmlrpc'
  16. );
  17.  
  18. my $username = shift @ARGV or die("Need username");
  19. my $password = shift @ARGV or die("Need password");
  20.  
  21. my $logindata = {
  22.         username => $username,
  23.         password => $password,
  24.         ver      => 1,
  25. };
  26.  
  27. # Set @friends to contain LJ usernames of all your friends.
  28. my @friends = get_friends_list($logindata);
  29.  
  30. local $|=1;
  31. print STDERR "Fetching friends userpics...\n";
  32.  
  33. # Read their userpics into a hash.
  34. my %info = %{get_friendspics(@friends)};
  35.  
  36. # Print a summary page to stdout.
  37.  
  38. print <<HTML;
  39. <!DOCTYPE html
  40. PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
  41. "http://www.w3.org/TR/html4/loose.dtd"
  42. >
  43. <html>
  44. <head>
  45. <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" >
  46. <title></title>
  47. </head>
  48. <body bgcolor="white" text="black" link="blue" vlink="purple" alink="red">
  49. HTML
  50.  
  51.  
  52.  
  53. for my $friend (keys %info) {
  54.  
  55. print <<HTML;
  56. <br clear="all">
  57. <h3><a href="/users/$friend">$friend</a></h3>
  58. <br clear="all">
  59. HTML
  60.  
  61.         for my $url (@{$info{$friend}}) {
  62.                 print "<img src=\"$url\">\n";
  63.         }
  64. }
  65.  
  66. print <<HTML;
  67. </body>
  68. </html>
  69. HTML
  70.  
  71. # Done.
  72. exit 0;
  73.  
  74. # Take a hashref of login data, return an array of friends usernames.
  75.  
  76. sub get_friends_list {
  77.         my $logindata = shift;
  78.         my $response = $client->send_request(
  79.                 RPC::XML::request->new('LJ.XMLRPC.getfriends',$logindata));
  80.         die_if_rpc_fault($response);
  81.  
  82.         my @friends = map { $_->{'username'} }
  83.                         @{$response->value->{'friends'}};
  84.         return @friends;
  85.  
  86. }
  87.  
  88. # Take an RPC::XML response, and check if it contains a fault.
  89. # If so, print some diagnostics and die.
  90.  
  91. sub die_if_rpc_fault {
  92.         my $response = shift;
  93.         if ($response->is_fault) {
  94.                 die("Unable to login:\n".
  95.                 "faultString=\"". $response->value->{'faultString'} ."\"\n".
  96.                 "faultCode=\"". $response->value->{'faultCode'} ."\"\n");
  97.         }
  98. }
  99.  
  100. # Take an LJ username; fetch their userpics page,
  101. # screenscrape it for their userpics.
  102. # Return an array containing userpic URLs.
  103.  
  104. sub get_userpics {
  105.  
  106.         my $username = shift;
  107.  
  108.         my $picsurl = "/allpics.bml?user=$username";
  109.         my $picspage = get($picsurl) or die("Unable to fetch $picsurl");
  110.         my $stream = HTML::TokeParser->new(\$picspage);
  111.         my $class='';
  112.         my @urls = ();
  113.  
  114.         # Find <span class="heading">.
  115.  
  116.         while ( ($class ne 'heading') &&
  117.                 (my $nexttag = $stream->get_tag("span"))) {
  118.                 my ($tag,$attr,$attrseq,$text) = @$nexttag;
  119.                 if (defined($attr)) {
  120.                         $class = $attr->{'class'} || '';
  121.                 }
  122.         }
  123.  
  124.         # Now find all img tags.
  125.  
  126.         while ( my $nexttag = $stream->get_tag("img")) {
  127.                 my ($tag,$attr,$attrseq,$text) = @$nexttag;
  128.                 if (defined($attr)) {
  129.                         if (defined(my $url = $attr->{'src'})) {
  130.                                 if ($url =~ /userpic/) {
  131.                                         push @urls,$url;
  132.                                 }
  133.                         }
  134.                 }
  135.         }
  136.  
  137.         return @urls;
  138. }
  139.  
  140. # Take a list of Lj usernames.
  141. # Return a reference to a hash, each key of which is an LJ username.
  142. # Each value is a reference to an array containing the URLs
  143. # of their userpics.
  144.  
  145. sub get_friendspics {
  146.         my %info = ();
  147.  
  148.         map {
  149.                 print STDERR "Fetching $_ ...\n";
  150.                 $info{$_} = [ get_userpics($_) ] } @_;
  151.         return \%info;
  152. }

Raw Paste

Login or Register to edit or fork this paste. It's free.