source: trollforge/troll/LJ.pm @ 386 Tweet

#!/usr/bin/perl
# mao @ irc.hardchats.com
# simple class for working with livejournal

package LJ;
use strict;
use warnings;

use Mouse;
use LWP;
use LWP::UserAgent;
use HTTP::Request;

has 'user' => (is => 'rw', isa => 'Str');
has 'password' => (is => 'rw', isa => 'Str');
has 'server' => (is => 'rw', isa => 'Str', default => 'livejournal.com');
has 'http_proxy' => (
        is => 'rw',
        isa => 'Str',
        predicate => 'use_proxy'
        );

# LJ::post("Subj", "test");
sub post {
        my $self = shift;
        my $subj = shift;
        my $body = shift;
        my @tiem = _getTiem();
        my $params = {
            mode       => "postevent",
            user       => $self->user,
            password   => $self->password,
            subject        => $subj,
            event          => $body,
            version    => 1,
            clientversion => "JavaEE-ProBlogger",
            year => $tiem[0],
            mon => $tiem[1],
            day => $tiem[2],
            hour => $tiem[3],
            min => $tiem[4]
        };
        my $user_a = LWP::UserAgent->new(agent => "JavaEE-ProBlogger 2000");
        my $req = HTTP::Request->new(POST => "http://".$self->server."/interface/flat");
        $req->content(_encode($params));
        my $res = $user_a->request($req);
        print $res->content;
        return undef unless $res;
        return split(/\n/, $res->content);
}

sub _getTiem {
        my @curTime = localtime;
        $curTime[5]+=1900; # year
        $curTime[4]+=1; # month 
        return ( $curTime[5], $curTime[4], $curTime[3], $curTime[2], $curTime[1] ); 
}



# LJ::comment("http://lj.rossia.org/users/yaroslavz/80368.html?replyto=378608", "body text, "subject text");
# LJ::comment("http://lj.rossia.org/users/yaroslavz/80368.html" ...
# LJ::comment("http://lj.rossia.org/users/yaroslavz/80368.html?mode=reply" ...
# LJ::comment("http://ttt.livejournal.com/84144.html", ...);
sub comment {
        my $self = shift;
        
        my $reply_url = my $comment_url =shift;
        my $body = shift;
        my $subj = shift;
        
        my $journal; my $post_id; my $parent;
        
        # validating the url
        my $server = $self->server;
        if($reply_url =~ /http:\/\/$server\/users\/(.*?)\/(\d*).html/) {
                $journal = $1; $post_id = $2;
        } elsif ($reply_url =~ /http:\/\/(.*?)\.$server\/(\d*).html/)   {
                $journal = $1; $post_id = $2;
        #} elsif ($reply_url =~ /http:\/\/community\.$server\/(.*?)\/(\d*).html/ {
        #       $journal = $1; $post_id = $2;
        } else {
                return "nope";
        }
        #return "ya";
        # if there is no ?mode=reply in url, we should add it
        $reply_url .= "?mode=reply" unless ($reply_url =~ /\?mode=reply$/);

        my $chal;
        my $user_a = LWP::UserAgent->new(agent => "JavaEE-ProBlogger 2000");
        $user_a->proxy(['http']=>$self->http_proxy); # if($self->use_proxy);
        
        my $req = HTTP::Request->new(GET => $reply_url);
        my $res = $user_a->request($req);
        if($res->content =~ /id='login_chal' value='(.*?)' \/>/) {
                $chal = $1; 
        } else {
                return undef;
        }
        if($res->content =~ /type='hidden' name="replyto" value="(\d+)" \/>/)
        {
                $parent = $1;
        } else {
                $parent = 0;
        }
        
        
        my $params = {
            replyto                     => $parent,
            parenttalkid        => $parent,
            itemid              => $post_id,
            journal                     => $journal,
            usertype            => "user",
            userpost            => $self->user,
            password            => $self->password,
            subject                     => $subj,
            body                        => $body,
            chal                        => $chal,
            subjecticon         => "no",
        };
        
        $req = HTTP::Request->new(POST => "http://".$self->server."/talkpost_do.bml");
        $req->content(_encode($params));
        $req->content_type('application/x-www-form-urlencoded');
        
        $res = $user_a->request($req);
        return undef unless $res;
        return $res->content;
}

# LOL STOLEN FROM NET::LIVEJOURNAL LOL FITZPATIKK IS GAY
sub _encode {
    my $val = shift;
    $val = "" unless defined $val;
    if (ref $val) {
        my $ret = "";
        while (my ($k, $v) = each %$val) {
            $ret .= _encode($k) . "=" . _encode($v) . "&";
        }
        chop $ret;
        return $ret;
    } else {
        $val =~ s/([^a-zA-Z0-9_\,\-.\/\\\: ])/uc sprintf("%%%02x",ord($1))/eg;
        $val =~ tr/ /+/;
        return $val;
    }
}

1;