#!/usr/bin/perl -w # # Bad things with lj # use LWP::UserAgent; use URI::Escape; use Date::Parse; use POSIX; # strftime # get username and password from the command line my ( $username, $password ) = ( @ARGV ); die "Dude. Who the hell are you?" unless $username; die "What's the good word?" unless $password; my $ua = new LWP::UserAgent(); $ua->agent( "Mozilla/4.0 (compatible; MSIE 5.0); Windows 98; DigExt)" ); $ua->env_proxy(); # This grabs all the moods, pictures, friends/access groups my %foo = login(); if ( %foo ) { for my $k ( sort keys %foo ) { print "$k: $foo{$k}\n"; } } #exit; print "\nend of THAT nonsense\n\n"; #syncitems(); # Get things we should know about from lj using syncitems: sub syncitems { my %lines; my $req = new HTTP::Request POST => 'http://www.livejournal.com/interface/flat'; $req->add_content( "user=$username&" ); $req->add_content( "password=$password&" ); $req->add_content( "mode=syncitems&" ); $req->add_content( "ver=1&" ); #$req->add_content( "lastsync=" yyyy-mm-dd hh:mm:ss ); $req->header( 'Content-Type', 'application/x-www-form-urlencoded' ); $res = $ua->request( $req ); if ( $res->is_success ) { my $page = $res->content; %lines = split( /\n/, $page ); } else { $! = $res->code; return; } # Check result my $res = $lines{'success'} || 'FAIL'; if ( $res ne 'OK' ) { my $err = $lines{'errmsg'} || 'Unknown error'; $! = $err; return; } # Don't need this any more delete $lines{'success'}; # do we need more syncing? my $sync_count = $lines{'sync_count'} || 0; my $sync_total = $lines{'sync_total'} || 0; if ( $sync_count != $sync_total ) { warn "Sync count ($sync_count) != sync total ($sync_total)\n"; } # Don't need these any more. delete $lines{'sync_count'}; delete $lines{'sync_total'}; # We should now have a list of things that need retrieving, and # their posting dates. # Let's order them by posting date: my @allitems = keys %lines; my @dates = grep /^sync_.*_time$/, @allitems; @dates = sort { my $da = str2time( $lines{$a} ); my $db = str2time( $lines{$b} ); $da <=> $db; } @dates; for my $date ( @dates ) { my ( $number ) = $date =~ /sync_(.*)_time/; # This stuff is LJ-specific gubbins that I should use with syncitems # print $lines{$date}; # print ": "; # print $lines{"sync_$ {number}_item"}; # print " - "; # print $lines{"sync_$ {number}_action"}; # print "\n"; my %events = getevents( $number ); if ( %events && $events{'events_count'} == 1 ) { print "Date: " . $events{'events_1_eventtime'} . "\n"; print "Security: " . ( $events{'events_1_security'} || "public" ) . "\n"; print "Allowmask: " . ( $events{'events_1_allowmask'} || "public" ). "\n"; print "Subject: " . ( $events{'events_1_subject'} || "" ). "\n"; print "From: " . ( $events{'events_1_poster'} || $username ) . "\n"; print "ID: " . $events{'itemid'} . "\n"; # http://goathack.livejournal.org:8006/doc/server/ljp.csp.proplist.html for my $prop ( 1 .. $events{'prop_count'}) { print $events{"prop_$ {prop}_name"} . ": " . $events{"prop_$ {prop}_value"} . "\n"; } $events{'events_1_event'} =~ s/\+/ /gs; print uri_unescape( $events{'events_1_event'}), "\n"; } else { warn "getevents failed on $number\n"; warn "no events recovered\n" unless %events; } print "\n"; } %lines; } sub getevents { my %lines; my $itemid = shift; my $req = new HTTP::Request POST => 'http://www.livejournal.com/interface/flat'; $req->add_content( "user=$username&" ); $req->add_content( "password=$password&" ); $req->add_content( "mode=getevents&" ); $req->add_content( "selecttype=one&" ); $req->add_content( "lineendings=unix&" ); $req->add_content( "itemid=$itemid&" ); $req->add_content( "ver=1&" ); #$req->add_content( "lastsync=" yyyy-mm-dd hh:mm:ss ); $req->header( 'Content-Type', 'application/x-www-form-urlencoded' ); $res = $ua->request( $req ); if ( $res->is_success ) { my $page = $res->content; %lines = split( /\n/, $page ); $lines{'itemid'} = $itemid; } else { $! = $res->code; return; } # Check result my $res = $lines{'success'} || 'FAIL'; if ( $res ne 'OK' ) { my $err = $lines{'errmsg'} || 'Unknown error'; #$! = $err; print STDERR "Error: $err\n"; return; } # Don't need this any more delete $lines{'success'}; %lines; } sub login { my %lines; my $itemid = shift; my $req = new HTTP::Request POST => 'http://www.livejournal.com/interface/flat'; $req->add_content( "user=$username&" ); $req->add_content( "password=$password&" ); $req->add_content( "mode=login&" ); $req->add_content( "ver=1&" ); $req->add_content( "getmoods=0&" ); # send highest mood we know about $req->add_content( "getpickws=1&" ); # list of picture keywords $req->add_content( "getpickwurls=1" ); # list of picture urls $req->header( 'Content-Type', 'application/x-www-form-urlencoded' ); $res = $ua->request( $req ); if ( $res->is_success ) { my $page = $res->content; %lines = split( /\n/, $page ); } else { $! = $res->code; return; } # Check result my $res = $lines{'success'} || 'FAIL'; if ( $res ne 'OK' ) { my $err = $lines{'errmsg'} || 'Unknown error'; #$! = $err; print STDERR $err . "\n"; return; } # Don't need this any more delete $lines{'success'}; %lines; }