#!/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 '<h1>LJ Platform</h1>';

	if($q->param && $q->param('username')) {
		my $method = $q->param('method');
	
		DoWork($methods{$method},$q->param('optional'));
		print "<br /><hr />\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 "<div align=\"center\">\n";
	print "<table border=\"0\" bgcolor=\"#eeeeee\" cellpadding=\"5\" cellspacing=\"0\">\n";

	print "<tr>\n";
	print "<td align=\"right\">\n";
	print "Livejournal Name:\n";
	print "</td><td>\n";
	print $q->textfield(-name=>'username', -size=>20);
	print "</td></tr>\n";

	print "<tr>\n";
	print "<td align=\"right\">\n";
	print "Livejournal Password:\n";
	print "</td><td>\n";
	print $q->password_field(-name=>'password', -size=>20);
	print "</td></tr>\n";

	print "<tr>\n";
	print "<td align=\"right\">\n";
	print "Start (year / month / day):\n";
	print "</td><td>\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 "</td></tr>\n";

	print "<tr>\n";
	print "<td align=\"right\">\n";
	print "End (year / month / day):\n";
	print "</td><td>\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 "</td></tr>\n";

	print "<tr>\n";
	print "<td align=\"right\">\n";
	print "Do what:";
	print "</td><td>\n";
	my @keys = sort {$a cmp $b} keys %methods;
	print $q->popup_menu(-name=>'method', -values=> \@keys, -default=>$keys[0]);
        print "<br />\n";
	print "Parameter: ";
	print $q->textfield(-name=>'optional',-size=>20);
	print "</td></tr>\n";

	print "<tr>\n";
	print "<td align=\"center\" colspan=\"2\">\n";
	print $q->submit(-label=>'Submit');
	print "</td></tr>\n";

	print "</table></div>\n";
	print $q->end_form;


	print q|
<p><small>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.</small></p>
|;
	print q|<img src="../../counters/counter.cgi?counter=change" />|;
	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<br>\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 <a href=\"",url($posts{$id}),"\">", mydecode($subject),"</a>";
				next;
			}

			
			print "Invoking your subroutine on: <a href=\"",url($posts{$id}),"\">", mydecode($subject),"</a>";
			my $error = &$subroutine($posts{$id},$optional);

			if( $error) {
				print "Error returned by your subroutine. Halting further execution<br />\n" unless ($error == 2);
				return 1;
			}
			print "<br />\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 '$_'<br />\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;