#!/usr/local/bin/perl -w # $Id: ELJ.pm,v 1.9 2003/08/06 06:03:36 erik Exp $ package ELJ; require Exporter; use strict; use vars qw(@ISA @EXPORT); @ISA = qw/Exporter/; @EXPORT = qw//; use Digest::MD5 qw(md5_hex); use LWP::UserAgent; use CGI; use CGI::Carp; use Data::Dumper; # Global variables use vars qw($ua $q $debug $fast $user $pass); $ua = LWP::UserAgent->new; # used for requests $q = new CGI; $debug = 1; # set to 0 for new debugging $fast = undef; # gets set on login $user = undef; # gets set on login $pass = undef; # gets set on login sub MainLoop(\%;$) { my %methods = %{(shift)}; print $q->header(); print $q->start_html(-title=>"LJ Platform",-bgcolor=>'#ffffff'),"\n"; print '

LJ Platform

'; if($q->param && $q->param('username')) { my $method = $q->param('method'); DoWork($methods{$method},$q->param('optional')); print "

\n"; PrintForm(\%methods, @_); } else { PrintForm(\%methods, @_); } } sub PrintForm(\%;$) { my %methods = %{(shift)}; # call with optional argument of URL for submit action if (scalar(@_)>0) { my $arg = shift; print $q->start_form(-action=>$arg),"\n"; } else { print $q->start_form(),"\n"; } print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
\n"; print "Livejournal Name:\n"; print "\n"; print $q->textfield(-name=>'username', -size=>20); print "
\n"; print "Livejournal Password:\n"; print "\n"; print $q->password_field(-name=>'password', -size=>20); print "
\n"; print "Start (year / month / day):\n"; print "\n"; print $q->textfield(-name=>'syear', -size=>4); print " / "; print $q->textfield(-name=>'smonth', -size=>2); print " / "; print $q->textfield(-name=>'sday', -size=>2); print "
\n"; print "End (year / month / day):\n"; print "\n"; print $q->textfield(-name=>'eyear', -size=>4); print " / "; print $q->textfield(-name=>'emonth', -size=>2); print " / "; print $q->textfield(-name=>'eday', -size=>2); print "
\n"; print "Do what:"; print "\n"; my @keys = sort {$a cmp $b} keys %methods; print $q->popup_menu(-name=>'method', -values=> \@keys, -default=>$keys[0]); print "
\n"; print "Parameter: "; print $q->textfield(-name=>'optional',-size=>20); print "
\n"; print $q->submit(-label=>'Submit'); print "
\n"; print $q->end_form; print q|

This program is made available in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

|; print q||; print $q->end_html(); } sub DoWork(&$) { my $subroutine = shift; my $optional = shift; my $user = $q->param('username'); my $pw = $q->param('password'); my $startyear = $q->param('syear'); my $startmonth = $q->param('smonth'); my $startday = $q->param('sday'); my $endyear = $q->param('eyear'); my $endmonth = $q->param('emonth'); my $endday = $q->param('eday'); login($user,$pw); my $year = $startyear; my $month = $startmonth; my $day = $startday; while (Before($year,$month,$day,$endyear,$endmonth,$endday)) { my $response = GetDay($year, $month, $day); my %posts = ParseLJEvents($response); print "Finding entries on $year-$month-$day
\n"; foreach my $id (sort(keys(%posts))) { my $subject = ""; $subject = $posts{$id}{'subject'} if(defined($posts{$id}{'subject'})); $subject = $posts{$id}{'itemid'}*256 + $posts{$id}{'anum'} if($subject eq ""); # test for "(cannot be displayed)" # in body || subject and flag error if($posts{$id}{'body'} =~ /(cannot be displayed)/ || $subject =~ /(cannot be displayed)/) { print "Encoding error accessing ", mydecode($subject),""; next; } print "Invoking your subroutine on: ", mydecode($subject),""; my $error = &$subroutine($posts{$id},$optional); if( $error) { print "Error returned by your subroutine. Halting further execution
\n" unless ($error == 2); return 1; } print "
\n"; } ($year, $month, $day) = IncrementDay($year, $month, $day); } } sub login($$) { # call with user/pass ($user,$pass) = @_; #my $content = "&mode=login&user=$user&password=$pass&ver=1"; $pass = _password($pass); my $content = "&mode=login&user=$user&hpassword=$pass&ver=1"; my $req = HTTP::Request->new(POST=>"http://www.livejournal.com/interface/flat"); $req->content_type('application/x-www-form-urlencoded'); $req->content($content); my $result = $ua->request($req); if($result->content =~ m/success.FAIL/ms) { $result->content =~ m/errmsg.([^\t\n\r\f]*)/s; die "Login error, $1"; } $fast = $result->content =~ m/fastserver.1/s; } sub GetDay ($$$) { # Call with $year, $month, $day # Retrieves that year/month/day's entries from LiveJournal my ($year, $month, $day) = @_; my $content = "&ver1&user=$user&hpassword=$pass&lineendings=unix"; $content .= "&mode=getevents&selecttype=day&year=$year&month=$month&day=$day"; my $req = HTTP::Request->new(POST=>"http://www.livejournal.com/interface/flat"); $req->content_type('application/x-www-form-urlencoded'); if($fast) { $req->push_header('Cookie' => 'ljfastserver=1'); } $req->content($content); my $result = $ua->request($req); return $result->content; } sub IncrementDay($$$) { # call with $year, $month, $day, returns the next consecutive day as an array my ($year, $month, $day) = @_; my @days = ( 31, (!($year % 4)&&!($year%400))?29:28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ); if (++$day > $days[$month-1]) { $day = 1; if (++$month > 13) { $month = 1; ++$year; } } return ($year, $month, $day); } sub Before($$$$$$) { my ($syear,$smonth, $sday, $eyear, $emonth, $eday) = @_; # stop if gone past the end year return 0 if($syear > $eyear); # before end year return 1 if($syear < $eyear); # year is the same, need to check months # gone past months return 0 if($smonth > $emonth); # before end month return 1 if($smonth < $emonth); # year and month are the same, need to check days return 0 if($sday > $eday); return 1; } sub ParseLJEvents($) { # parse a stream of data as an LJ information # Ex: my $response = GetDay($year, $month, $day, $content); my $response = shift; my @input = split(/\n/,$response); my $string; my $p_listening = 0; # True if next line is a %posts value my $m_listening = 0; # True is next line is a %meta value my %meta; #temp to hold meta data my %backref; # temp to hold back refs my %posts; # post information - returned to caller my ($id, $flavor); foreach (@input) { if (/^events_(\d+)_(\w+)$/) { ($id, $flavor) = ($1, $2); $posts{$id} ||= {}; $p_listening = 1; } elsif (/^prop_(\d+)_(\w+)$/) { ($id,$flavor) = ($1,$2); $meta{$id} ||= []; $m_listening = 1; } elsif ($p_listening == 1) { # it appears that we get the event back in "safe" # HTML encoded form but everything else is not HTML POST safe, fix that... if ($flavor ne "event") { $string = myencode($_); } else { $string = $_ }; $posts{$id}{$flavor} = $string; if($flavor eq "itemid") { $backref{$_} = $id; } $p_listening = 0; } elsif ($m_listening == 1) { if($flavor eq "itemid") { $meta{$id}[0] = $_; } elsif ($flavor eq "name") {$meta{$id}[1] = $_; } elsif ($flavor eq "value") { # protect meta data for HTML POST $string = myencode($_); $meta{$id}[2] = $string; } $m_listening = 0; } elsif (m/success|OK|_count$|^\d+$/) { next; } else { print "uncaught event output '$_'
\n"; } } # use the backrefs to push in the meta values foreach (sort(keys %meta)) { $id = $backref{$meta{$_}[0]}; $flavor = "prop_" . $meta{$_}[1]; $posts{$id}{$flavor} = $meta{$_}[2]; } return (%posts); } sub myencode ($) { my $string = shift; $string = CGI::escape($string); $string =~ s/%20/+/g; return ($string); } sub mydecode ($) { my $string = shift; $string =~ s/\+/%20/g; $string = CGI::unescape($string); return ($string); } sub url (\%){ my %post = %{(shift)}; my $ditem = ($post{itemid}*256)+$post{anum}; my $string = "http://www.livejournal.com/users/" . $user . "/" . $ditem . ".html"; return $string; } sub ditem (\%){ my %post = %{(shift)}; my $ditem = ($post{itemid}*256)+$post{anum}; return $ditem; } sub _password($) { my $password = shift; return (md5_hex($password)); } sub EditEvent (\%){ my %post = %{(shift)}; my $content = "&ver1&user=$user&hpassword=$pass&lineendings=unix&mode=editevent"; foreach (sort keys(%post)) { if(m"eventtime") { # special handling for eventtime $post{$_} = mydecode($post{$_}); $post{$_} =~ m/^(....)-(..)-(..) (..):(..):..$/; $content .= "&year=$1&month=$2&day=$3&hour=$4&min=$5"; } elsif (m"prop_revnum|prop_revtime") { # I don't think the client is supposed to set these two props next; } else { $content .= "&" . $_ . "=" . $post{$_}; } } my $req = HTTP::Request->new(POST=>"http://www.livejournal.com/interface/flat"); $req->content_type('application/x-www-form-urlencoded'); if($fast) { $req->push_header('Cookie' => 'ljfastserver=1'); } $req->content($content); my $result = $ua->request($req); if($result->content =~ m/success.FAIL/ms) { $result->content =~ m/errmsg.([^\t\n\r\f]*)/s; die "Editing error, $1"; } } sub GetFriendsGroups () { my %friend; my $content = "&ver1&user=$user&hpassword=$pass&lineendings=unix&mode=getfriendgroups"; my $req = HTTP::Request->new(POST=>"http://www.livejournal.com/interface/flat"); $req->content_type('application/x-www-form-urlencoded'); if($fast) { $req->push_header('Cookie' => 'ljfastserver=1'); } $req->content($content); my $result = $ua->request($req); if($result->content =~ m/success.FAIL/ms) { $result->content =~ m/errmsg.([^\t\n\r\f]*)/s; die "Could not get friends groups, $1"; } my @input = split(/\n/,$result->content); my $id; my $namecoming = 0; foreach(@input) { if (/^frgrp_(\d+)_name$/) { $id = $1; $namecoming = 1; } elsif ($namecoming) { $friend{$id} = $_; $namecoming = 0; } } return %friend; } sub GetFriends () { my %friend; my $content = "&ver1&user=$user&hpassword=$pass&lineendings=unix&mode=getfriends"; my $req = HTTP::Request->new(POST=>"http://www.livejournal.com/interface/flat"); $req->content_type('application/x-www-form-urlencoded'); if($fast) { $req->push_header('Cookie' => 'ljfastserver=1'); } $req->content($content); my $result = $ua->request($req); if($result->content =~ m/success.FAIL/ms) { $result->content =~ m/errmsg.([^\t\n\r\f]*)/s; die "Could not get friends list, $1"; } my @input = split(/\n/,$result->content); my $id; my $flavor; my $datacoming = 0; foreach(@input) { if(/^friend_(\d+)_(\w+)$/) { ($id,$flavor) = ($1, $2); #next if($flavor =~ /groupmask|type|name/); $datacoming = 1; $friend{$id} ||= {}; } elsif ($datacoming) { $datacoming = 0; $friend{$id}{$flavor} = $_ ; } } return %friend; } sub PermutedFriends(%) { # need to permute off of the name my %friend = @_; use Data::Dumper; my %permuted; my ($outer, $inner); foreach $outer (keys %friend) { my $user = $friend{$outer}{'user'}; $permuted{$user} ||= {}; foreach $inner (keys %{$friend{$outer}}) { $permuted{$user}{$inner} = $friend{$outer}{$inner}; } $permuted{$user}{'fg'} = _r2h($friend{$outer}{'fg'}); $permuted{$user}{'bg'} = _r2h($friend{$outer}{'bg'}); } return %permuted; } sub _mymin { my $min = 255; foreach (@_) { if($_ < $min) {$min = $_}; } return $min; } sub _mymax { my $max = 0; foreach (@_) { if($_ > $max) {$max = $_}; } return $max; } sub _r2h($) { my $rgb = shift; return "white" if($rgb =~ /ffffff/); return "black" if($rgb =~ /000000/); $rgb =~ /#(..)(..)(..)/; my ($r, $g, $b) = (hex($1), hex($2), hex($3)); my ($h, $s, $v) = (0,0,0); my $min = _mymin($r,$g,$b); $v = _mymax($r,$g,$b); my $delta = $v - $min; if($v == 0) { $s = 0; } else { $s = $delta / $v; } if($s == 0) { $h = 0; # hack, should be NaN; } else { if($r == $v) {$h = 60.0 * ($g-$b)/$delta;} elsif($g == $v) {$h = 120.0 + 60.0 * ($b-$r)/$delta;} else {$h = 240.0 + 60.0 * ($r-$g)/$delta;} if($h < 0) {$h+=360.0;} } $v = $v/255.0; $h = $h/360.0; my $string = '"'. sprintf("%.2f", $h) . ' ' . sprintf("%.2f", $s); $string .= ' ' . sprintf("%.2f", $v) . '"'; return $string; } sub get_page($) { $_ = shift @_; $ua->agent("http://elo_sf.livejournal.com (elo_sf\@livejournal.com"); $ua->timeout(60); my $req = HTTP::Request->new(GET => $_ ); my $res = $ua->request($req); if ($res->is_success) { return $res->content; } else { my $tmp = $res->status_line; die ("HTTP Error ($tmp) retrieving: <$_>\n"); } } 1;