liblivejournal-perl-1.3.orig/0040755000175000001440000000000007704633631015642 5ustar decklinusersliblivejournal-perl-1.3.orig/t/0040755000175000001440000000000007254246004016077 5ustar decklinusersliblivejournal-perl-1.3.orig/t/CVS/0040755000175000001440000000000007254246043016535 5ustar decklinusersliblivejournal-perl-1.3.orig/t/CVS/Root0100644000175000001440000000002307254245757017406 0ustar decklinusers/usr/local/cvsroot liblivejournal-perl-1.3.orig/t/CVS/Repository0100644000175000001440000000001607254245757020644 0ustar decklinuserslivejournal/t liblivejournal-perl-1.3.orig/t/CVS/Entries0100644000175000001440000000004707254246043020067 0ustar decklinusers/lj.t/1.2/Thu Mar 15 23:11:31 2001// D liblivejournal-perl-1.3.orig/t/lj.t0100755000175000001440000000103507254246043016673 0ustar decklinusers#!/usr/bin/perl -w # $Id: lj.t,v 1.2 2001/03/15 23:11:31 archon Exp $ BEGIN { $| = 1; print "1..3\n"; } END {print "not ok 1\n" unless $loaded;} use LiveJournal; $loaded = 1; print "ok 1\n"; # we just want to try login() my $login = "bogus"; my $pass = "bogus"; print "2..3\n"; my %hash = ( user => $login, password => $pass, ); my $lj = LiveJournal->new(\%hash); if ($lj) { print "ok 2\n"; print "3..3\n"; my $log = $lj->login(); if ($log) { print "ok 3\n"; } else { print "not ok 3\n"; } } else { print "not ok 2\n"; } liblivejournal-perl-1.3.orig/tlj0100755000175000001440000000744707256470366016400 0ustar decklinusers#!/usr/bin/perl -w # $Id: tlj,v 1.4 2001/03/22 21:39:02 archon Exp $ use strict; use LiveJournal; use Data::Dumper; # This file is an example of the basic use of LiveJournal.pm functionality. # It probably won't work correctly unless certain sections are commented # out or provided with valid data. It's just a script I use for debugging # while writing the module. - archon sub main { =comment my %hash = ( user => q/bogus/, password => q/bogus/, ); my $lj = LiveJournal->new(\%hash); =cut my $lj = LiveJournal::LiveJournalrc->new(); if ($lj) { my %lhash = ( # getmoods => 0, # getmenus => 1, # getpickws => 1, ); my $log = $lj->login(\%lhash); $lj->parse_login($log); # print Dumper $lj; =comment my $access = $lj->access(); print Dumper $access; my $friend_group = $lj->friend_group(); print Dumper $friend_group; my $friend_group_max = $lj->friend_group_max(); print Dumper $friend_group_max; my $menu = $lj->menu(); print Dumper $menu; my $mood = $lj->mood(); print Dumper $mood; my $name = $lj->name(); print Dumper $name; my $pic_keyword = $lj->pic_keyword(); print Dumper $pic_keyword; =cut my $friend = LiveJournal::Friend->new(); if ($friend) { =comment my $cf = $friend->check(); print Dumper $cf if $cf; my %eghash = ( 2 => { name => 'halb', } ); my $eg = $friend->editgroups(\%eghash); print Dumper $eg if $eg; my $gfg = $friend->getgroups(); print Dumper $gfg if $gfg; =cut my ($gf) = $friend->get(1, 1); if ($gf) { $friend->parse($gf); } print Dumper $friend->friends(); =comment my $aftg = $friend->add_friend_to_group("bogon", 2); print Dumper $aftg; my ($ig) = $friend->friends_by_group(); print Dumper $ig if $ig; my ($nf) = $friend->numfriends(); print "Number of friends: $nf\n"; my ($fgm) = $friend->friend_group_max(); print "$fgm\n"; my @del = qw/2/; my $dg = $friend->deletegroups(\@del); print Dumper $dg if $dg; my %fh = ( archon => { fg => q/#000000/, bg => q/#FFFFFF/, }, ); my ($af) = $friend->edit(\%fh); print Dumper $af if ($af); my @fra; push @fra, 'archon'; my ($rf) = $friend->remove(\@fra); print Dumper $rf if $rf; my @faa = qw/mayzie #668833 #AA8822/; my ($af) = $friend->add(@faa); print Dumper $af if $af; =comment my ($fo) = $friend->friendof(); if ($fo) { $friend->parse($fo); print Dumper $friend; } =cut } else { print "Couldn't make friends\n"; } my $journal = LiveJournal::Journal->new(); if ($journal) { =comment my ($dc) = $journal->getdaycounts(); print Dumper $dc if $dc; my ($si) = $journal->syncitems(); print Dumper $si if $si; my %ghash = ( selecttype => 'lastn', howmany => 1, usejournal => 'colin', ); my ($ge) = $journal->get(\%ghash); print Dumper $ge if $ge; my ($rp) = $journal->remove(\@id); print Dumper $rp if $rp; local $/ = undef; my $content = ; $/ = "\n"; local $/ = undef; my $content = ; $/ = "\n"; my %phash = ( event => $journal->escape($content), subject => "LiveJournal.pm v1.4", security => "public", prop_current_moodid => 90, prop_current_music => "Pearl Jam - Black", usejournal => 'lj_perl', ); my ($pe) = $journal->post(\%phash); print Dumper $pe if $pe; =comment local $/ = undef; my $content = ; $/ = "\n"; my $itemid = 1915598; my %ehash = ( itemid => $itemid, event => $journal->escape($content), usejournal => 'lj_dev', subject => 'This is a new subject', ); my $ee = $journal->edit(\%ehash); print Dumper $ee if $ee; =cut } } else { die "Unable to establish connection with LiveJournal server.\n"; } } main(); __DATA__ liblivejournal-perl-1.3.orig/TODO0100644000175000001440000000165007256470353016333 0ustar decklinusers$Id: TODO,v 1.4 2001/03/22 21:38:51 archon Exp $ =head1 TODO =over 4 =item _send_mode () Should we throw an error if $response is not success? carp? =item lastupdate () Should this be encapsulated? =item lastsync () Should this be encapsulated? =item is_success() Return if an operation was successful. Useful? =item Front ends to Journal::get and Journal::post Do we need these? =item Multi-user support Right now, we only support one user at a time. When the base class is instantiated, the login and password are stored and accessable for the subclasses. In order to change users, we have to reinstantiate each of the classes. The alternative is to pass the login/password data each time any of the class objects are instantiated. =item Documentation Could probably use some more organization =item LiveJournal::Database a class that supports storing/retrieving information from various formats =back =cut liblivejournal-perl-1.3.orig/LICENSE0100444000175000001440000001373707244413366016655 0ustar decklinusers The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End liblivejournal-perl-1.3.orig/README0100644000175000001440000000172707256470300016520 0ustar decklinusers$Id: README,v 1.4 2001/03/22 21:38:08 archon Exp $ This is LiveJournal.pm. It is an object oriented Perl implementation of the LiveJournal protocol documented at http://www.livejournal.com/developer/protocol.bml. This release is protocol complete, which means it should completely support all modes. ################################ Installation instructions: $ perl Makefile.PL $ make $ make test $ make install $ perldoc LiveJournal ################################ NOTES: See the ChangeLog for details. Feel free to email me with suggestions, requests, bugs, tautologies, or questions after you've read the documentation (; . Also, I would appreciate knowing if you do use this module. Patches welcome and happy LiveJournalling! Credits: - Brad 'bradfitz' Fitz for unconfusing me - Joe 'piman' Wreschnig for his idea providing ventures into Perl-LiveJournal land Frank Sheiness liblivejournal-perl-1.3.orig/LiveJournal.pm0100644000175000001440000007003007256470253020430 0ustar decklinusers# $Id: LiveJournal.pm,v 1.5 2001/03/22 21:37:47 archon Exp $ package LiveJournal::Friend; use strict; use Carp; @LiveJournal::Friend::ISA = qw/LiveJournal/; sub check { my ($self) = shift; my $content = $self->_new_modeline('checkfriends'); $content .= "&lastupdate=" . $self->lastupdate(); my $response = $self->_send_mode($content); if ($response) { my $hash = {split("\n", $response->{'_content'})}; if ($hash->{'success'} eq "OK") { $self->lastupdate($hash->{'lastupdate'}); } return $hash; } else { return undef; } } sub getgroups { my ($self) = shift; my $content = $self->_new_modeline('getfriendgroups'); my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{_content})}; } else { return undef; } } sub friends_by_group { my ($self) = shift; my %ret; for my $friend (@{$self->friends()}) { if (exists ($friend->{'groupmask'})) { $ret{$friend->{'user'}} = [grep { $friend->{'groupmask'} & (2 ** $_)} 1 .. $self->friend_group_max()]; } } return \%ret; } sub add_friend_to_group { my ($self, $user, $group) = @_; my ($response); if (defined ($user) and exists $self->{'_friend_group'}->{$group}) { foreach my $friend (@{$self->friends()}) { if ($friend->{'user'} eq $user) { my $oldmask = $friend->{'groupmask'} ? $friend->{'groupmask'} : 1; my $newmask = $oldmask ^ (1 << $group); if ($newmask < $oldmask) { carp ("$user is already in group $group"); return undef; } $response = $self->editgroups({$group => {$user => $newmask}}); last; } } } return $response; } sub remove_friend_from_group { my ($self, $user, $group) = @_; my $response; if (defined ($user) and exists $self->{'_friend_group'}->{$group}) { my ($count) = 0; foreach my $friend (@{$self->friends()}) { if ($friend->{'user'} eq $user) { my $oldmask = $friend->{'groupmask'} ? $friend->{'groupmask'} : 1; my $newmask = $oldmask ^ (1 << $group); if ($newmask > $oldmask) { carp ("$user is not in group $group"); return undef; } $response = $self->editgroups({$group => {$user => $newmask}}); last; } $count++; } } return $response; } sub editgroups { my ($self, $args) = @_; my $content = $self->_new_modeline('editfriendgroups'); while (my ($k, $v) = each (%$args)) { for (keys (%$v)) { if ($_ eq "name" or $_ eq "sort" or $_ eq "public") { $content .= "&efg_set_" . $k . "_$_=" . $v->{$_}; } else { $content .= "&editfriend_groupmask_" . $_ . "=" . $v->{$_}; } } } my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{_content})}; } else { return undef; } } sub _cleargroups { my ($self, $numbers) = @_; my $friends = $self->friends; for my $num (@$numbers) { for my $friend (@$friends) { if (exists ($friend->{'groupmask'}) and ($friend->{'groupmask'} & (2 ** $num))) { $self->remove_friend_from_group($friend->{'user'}, $num); $friend->{'groupmask'} ^= $num; } } } $self->friends($friends); } sub deletegroups { my ($self, $numbers) = @_; my $content = $self->_new_modeline('editfriendgroups'); for my $num (@$numbers) { $content .= "&efg_delete_" . $num . "=1"; } my $response = $self->_send_mode($content); if ($response->{'_content'}->{'success'} eq "OK") { $self->_cleargroups($numbers); } if ($response) { return {split("\n", $response->{'_content'})}; } else { return undef; } } sub edit { my ($self, $hash) = @_; my $content = $self->_new_modeline('editfriends'); my $num = 1; while (my ($k, $v) = each(%$hash)) { $content .= sprintf("&editfriend_add_%d_user=%s", $num, $k); for my $c (qw/fg bg/) { if (exists ($v->{$c})) { if ($v->{$c} =~ /^#[0-9A-F]{6}$/) { $content .= sprintf("&editfriend_add_%d_%s=%s", $num, $c, $v->{$c}); $num++; } else { carp ("$c must be specified in #RRGGBB format in LiveJournal::Friend->edit().") } } } } my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{_content})}; } else { return undef; } } sub add { my ($self, $friend, $fg, $bg) = @_; my %hash; if (defined ($friend)) { $hash{$friend} = {}; } else { carp ("LiveJournal::Friend->add() requires a username."); return undef; } if (defined ($fg)) { $hash{$friend}{'fg'} = $fg; } if (defined ($bg)) { $hash{$friend}{'bg'} = $bg; } my $response = $self->edit(\%hash); return $response; } sub remove { my ($self, $users) = @_; my $content = $self->_new_modeline('editfriends'); for my $user (@$users) { $content .= "&editfriend_delete_" . $user . "=1"; } my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{_content})}; } else { return undef; } } sub get { my ($self, $friendof, $groups) = @_; my $content = $self->_new_modeline('getfriends'); if ($friendof) { $content .= "&includefriendof=1"; } if ($groups) { $content .= "&includegroups=1"; } my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{'_content'})}; } else { return undef; } } sub parse { my ($self, $args) = @_; my %hash; if ($args) { while (my ($k, $v) = each (%$args)) { if ($k =~ /(\w+)_(\d+)_(.*)/) { $hash{$1}[$2 - 1]{$3} = $v; $hash{$1}[$2 -1]{'number'} = $2 if ($3 eq "name"); } elsif ($k =~ /frgrp_(\d+)_(\w+)/) { $self->friend_group($1, $2, $v); } elsif ($k eq "frgrp_maxnum") { $self->friend_group_max($v); } } if (exists ($hash{'friend'})) { $self->numfriends(scalar(@{$hash{'friend'}})); } $self->friends($hash{'friend'}); } else { carp ("LiveJournal::Friend->parse() requires an arguement."); } } sub friendof { my ($self) = @_; my $content = $self->_new_modeline('friendof'); my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{'_content'})}; } else { return undef; } } sub numfriends { my ($self) = shift; if (@_) { $self->{'_numfriends'} = shift; } else { return $self->{'_numfriends'}; } } # XXX Should this be encapsulated? sub lastupdate { my ($self) = shift; if (@_) { ${$self->{'_lastupdate'}} = shift; } else { return ${$self->{'_lastupdate'}}; } } sub friends { my ($self) = shift; if (@_) { my $arg = shift; @{$self->{'_friends'}} = @$arg; } else { return $self->{'_friends'}; } } package LiveJournal::Journal; use strict; use Carp; @LiveJournal::Journal::ISA = qw/LiveJournal/; sub edit { my ($self, $args) = @_; my $content = $self->_new_modeline('editevent'); for (qw/itemid event/) { unless (exists $args->{$_}) { carp ("Missing required value: $_ in LiveJournal::Journal->edit()"); return undef; } } if (exists ($args->{'subject'}) and length($args->{'subject'}) > 255) { carp ("Subject too long; truncated to 255 chars in LiveJournal::Journal->edit()."); substr($args->{subject}, 254) = ''; } while (my ($k, $v) = each (%$args)) { $content .= "&" . $k . "=" . $v; } my (undef, $min, $hour, $day, $mon, $year) = localtime(time); $year += 1900; $mon = sprintf("%02d", $mon + 1); $day = sprintf("%02d", $day); $min = sprintf("%02d", $min); $content .= "&year=$year"; $content .= "&mon=$mon"; $content .= "&day=$day"; $content .= "&hour=$hour"; $content .= "&min=$min"; my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{_content})}; } else { return undef; } } sub remove { my ($self, $itemids) = @_; unless (defined($itemids)) { carp ("LiveJournal::Journal->remove() requires item ids to remove."); return undef; } my $content = $self->_new_modeline('editevent'); for my $id (@$itemids) { $content .= "&itemid=" . $id . "&event="; } my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{_content})}; } else { return undef; } } sub get { my ($self, $args) = @_; my $content = $self->_new_modeline('getevents'); unless (exists ($args->{'selecttype'})) { carp ("Missing required key 'selecttype' in LiveJournal::Journal->get() hash"); return undef; } if ($args->{'selecttype'} eq "syncitems" and not exists ($args->{'lastsync'})) { $args->{'lastsync'} = $self->lastsync(); } elsif ($args->{'selecttype'} eq "day") { unless (exists ($args->{'year'}) and exists ($args->{'month'}) and exists ($args->{'day'})) { ($args->{'day'}, $args->{'month'}, $args->{'year'}) = (localtime(time))[3,4,5]; $args->{'year'} += 1900; $args->{'month'}++; } } elsif ($args->{'selecttype'} eq "lastn") { if (exists ($args->{'howmany'})) { if ($args->{'howmany'} > 50) { $args->{'howmany'} = 50; } } else { $args->{'howmany'} = 20; } } elsif ($args->{'selecttype'} eq "one" and not exists $args->{'itemid'}) { carp ("selecttype of 'one' requires key 'itemid' in LiveJournal::Journal->get()"); return undef; } while (my ($k, $v) = each (%$args)) { $content .= "&" . $k . "=" . $v; } my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{'_content'})}; } else { return undef; } } sub post { my ($self, $args) = @_; my $content = $self->_new_modeline('postevent'); unless (exists ($args->{'event'})) { carp ("Missing required key 'event' in LiveJournal::Journal->post() hash"); return undef; } if (exists ($args->{'subject'}) and length($args->{subject}) > 255) { carp ("Subject too long; truncated to 255 chars in LiveJournal::Journal->post()."); substr($args->{subject}, 254) = ''; } while (my ($k, $v) = each (%$args)) { $content .= "&" . $k . "=" . $v; } my (undef, $min, $hour, $day, $mon, $year) = localtime(time); $year += 1900; $mon = sprintf("%02d", $mon + 1); $day = sprintf("%02d", $day); $min = sprintf("%02d", $min); $content .= "&year=$year"; $content .= "&mon=$mon"; $content .= "&day=$day"; $content .= "&hour=$hour"; $content .= "&min=$min"; my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{'_content'})}; } else { return undef; } } sub getdaycounts { my ($self, $usejournal) = @_; my $content = $self->_new_modeline('getdaycounts'); if (defined ($usejournal)) { $content .= "&usejournal=" . $usejournal; } my $response = $self->_send_mode($content); if ($response) { return {split("\n", $response->{'_content'})}; } else { return undef; } } sub syncitems { my ($self) = @_; my $content = $self->_new_modeline('syncitems'); $content .= "&lastsync=" . $self->lastsync(); my $response = $self->_send_mode($content); if ($response) { my $hash = {split("\n", $response->{'_content'})}; if ($hash->{'success'} eq "OK") { $self->lastsync($hash->{'lastsync'}); } return $hash; } else { return undef; } } # XXX Should this be encapsulated? sub lastsync { my ($self) = shift; if (@_) { ${$self->{'_lastsync'}} = shift; } else { return ${$self->{'_lastsync'}}; } } package LiveJournal::LiveJournalrc; use strict; use Carp; sub _parse_rc { my ($files) = shift; unless (defined ($files)) { for my $fname ("$ENV{'HOME'}/.livejournalrc", "$ENV{'HOME'}/.livejournal.rc", "/etc/livejournalrc") { if (-r $fname) { push @$files, $fname; last; } } unless ($files) { carp ("No livejournalrc file found"); return undef; } } my %rc; for my $file (@$files) { open (RC, $file) or do { carp ("Can't open config file '$file' for reading: $!"); return undef; }; while (defined (my $line = )) { $line =~ s/^\s+|\s+$//g; if ($line =~ /^([^:]+):\s*(.*)/) { $rc{$1} = $2; } } } return \%rc; } sub new { my (undef, $files) = @_; my $args = _parse_rc($files ? $files : undef); return undef unless defined ($args); my $self = LiveJournal->new($args); for (qw/datadir syncdir queuedir verbose/) { if (exists($args->{$_})) { $self->{"_$_"} = $args->{$_}; } } bless ($self, "LiveJournal"); return $self; } package LiveJournal; use strict; use LWP::UserAgent; use Carp; use vars qw($VERSION); $VERSION = "1.1"; sub _send_mode { my ($self, $content) = @_; my $request = HTTP::Request->new('POST', $self->{'_URI'}); $request->content_type('application/x-www-form-urlescaped'); $request->content_length(length($content)); $request->content($content); my $response = $self->{'_ua'}->request($request); if ($response->is_success()) { return $response; } else { # throw_error; # XXX ? return undef; } } sub _new_modeline { my ($self, $mode) = @_; if ($mode) { return (sprintf("mode=%s&user=%s&%spassword=%s", $mode, $self->escape($self->user()), (exists($self->{'_hpassword'}) ? 'h' : ''), $self->escape($self->password()))); } else { return undef; } } sub login { my ($self, $args) = @_; my $content = $self->_new_modeline('login'); $content .= "&clientversion=" . $self->version(); $content .= "&getmoods=" . $args->{'getmoods'} if (exists $args->{'getmoods'}); $content .= "&getmenus=1" if (exists $args->{'getmenus'}); $content .= "&getpickws=1" if (exists $args->{'getpickws'}); my $response = $self->_send_mode($content); if (defined($response)) { return {split("\n", $response->{_content})}; } else { return undef; } } sub escape { my ($self, $arg) = @_; $arg =~ s/([^a-zA-Z0-9\s])/uc(sprintf("%%%x", ord($1)))/ge; $arg =~ s/%20/+/g; return $arg; } sub parse_login { my ($self, $args) = @_; if ($args) { while (my ($k, $v) = each (%$args)) { if ($k =~ /access_\d+/) { $self->access($v); # } elsif ($k eq "access_count") { # $self->access_count($v); } elsif ($k =~ /frgrp_(\d+)_(\w+)/) { $self->friend_group($1, $2, $v); } elsif ($k eq "frgrp_maxnum") { $self->friend_group_max($v); } elsif ($k =~ /menu_(\d+)_(\d+)_(\w+)/) { $self->menu($1, $2, $3, $v); # } elsif ($k =~ /menu_(\d+)_count/) { # $self->menu_count($1, $v); } elsif ($k =~ /mood_(\d+)_(\w+)/) { $self->mood($1, $2, $v); } elsif ($k eq "mood_count") { $self->mood_count($v); } elsif ($k eq "name") { $self->name($v); } elsif ($k =~ /pickw_\d+/) { $self->pic_keyword($v); # } elsif ($k eq "pickw_count") { # $self->pic_count($v); } } } else { carp ("LiveJournal::->parse_login() requires an arguement."); } } { my ($args); my ($version, $lastupdate, $lastsync, $friend_group_max, $mood_count, $numfriends, $name, $command, $address, @friends, @access, %friend_group, @menu, @mood) = ("", "", "", 0, 0, 0, "", "", ""); sub new { my ($proto) = shift; my $class = ref($proto) || $proto; my $self = {}; if (@_) { $args = shift; } else { return undef unless $args; } if (exists($args->{'user'})) { $self->{'_user'} = $args->{'user'}; } else { return undef; } if (exists($args->{'hpassword'})) { $self->{'_hpassword'} = $args->{'hpassword'}; } elsif (exists($args->{'password'})) { $self->{'_password'} = $args->{'password'}; } else { return undef; } if (exists ($args->{'url'})) { $self->{'_URI'} = URI->new($args->{'url'}); } else { $self->{'_URI'} = URI->new("http://www.livejournal.com/cgi-bin/log.cgi"); } $self->{'_ua'} = LWP::UserAgent->new(); if (exists ($args->{'proxy'})) { $self->{'_ua'}->proxy('http', $args->{'proxy'}); } $self->{'_command'} = \$command; ${$self->{'_command'}} = $args->{'command'} if exists $args->{'command'}; $self->{'_address'} = \$address; ${$self->{'_address'}} = $args->{'address'} if exists $args->{'address'}; $self->{'_version'} = \"Perl-archlj/$VERSION"; $self->{'_lastupdate'} = \$lastupdate; $self->{'_lastsync'} = \$lastsync; $self->{'_numfriends'} = \$numfriends; $self->{'_friends'} = \@friends; $self->{'_access'} = \@access; $self->{'_friend_group'} = \%friend_group; $self->{'_friend_group_max'} = \$friend_group_max; $self->{'_menu'} = \@menu; $self->{'_mood'} = \@mood; $self->{'_mood_count'} = \$mood_count; $self->{'_name'} = \$name; bless ($self, $class); return $self; } } sub user { my ($self) = shift; return $self->{'_user'}; } sub password { my ($self) = shift; return (exists ($self->{'_password'}) ? $self->{'_password'} : $self->{'_hpassword'}); } sub version { my ($self) = shift; if (@_) { ${$self->{'_version'}} = shift; return 0; } else { return ${$self->{'_version'}}; } } sub access { my ($self) = shift; if (@_) { push @{$self->{'_access'}}, @_; } else { return $self->{'_access'}; } } sub friend_group { my ($self) = shift; if (@_) { my ($num, $type, $val) = @_; $self->{'_friend_group'}{$num}{$type} = $val; } else { return $self->{'_friend_group'}; } } sub friend_group_max { my ($self) = shift; if (@_) { ${$self->{'_friend_group_max'}} = shift; } else { return ${$self->{'_friend_group_max'}}; } } sub menu { my ($self) = shift; if (@_) { my ($menunum, $entrynum, $type, $val) = @_; $self->{'_menu'}[$menunum][$entrynum - 1]{$type} = $val; } else { return $self->{'_menu'}; } } sub mood { my ($self) = shift; if (@_) { my ($num, $type, $val) = @_; $self->{'_mood'}[$num - 1]{$type} = $val; } else { return $self->{'_mood'}; } } sub mood_count { my ($self) = shift; if (@_) { $self->{'_mood_count'} = shift; } else { return $self->{'_mood_count'}; } } sub name { my ($self) = shift; if (@_) { ${$self->{'_name'}} = shift; } else { return ${$self->{'_name'}}; } } sub pic_keyword { my ($self) = shift; if (@_) { push @{$self->{'_pic_keyword'}}, shift; } else { return $self->{'_pic_keyword'}; } } sub command { my ($self) = shift; if (@_) { ${$self->{'_command'}} = shift; } else { return ${$self->{'_command'}}; } } sub address { my ($self) = shift; if (@_) { ${$self->{'_address'}} = shift; } else { return ${$self->{'_address'}}; } } 1; =head1 NAME LiveJournal - A Perl implementation of the LiveJournal protocol =head1 SYNOPSIS use LiveJournal; my %info = ( user => 'foo', password => 'bar', ); my $lj = LiveJournal->new(\%info); my $response = $lj->login(); print "Logged in successfully\n" if ($response->{success} eq "OK"); ... my $friend = LiveJournal::Friend->new(); my $response = $friend->check(); ... my $journal = LiveJournal::Journal->new(); my $response = $journal->syncitems(); =head1 DESCRIPTION This module is implements the LiveJournal protocol. See http://www.livejournal.com/developer/protocol.bml for details. Data is requested from the server through I. Many methods return a hash reference containing key/value pairs returned by the server. Descriptions of possible responses can be found at http://www.livejournal.com/developer/modelist.bml =head1 CONSTRUCTOR =over 4 =item new (INFO) This is the constructor for a new LiveJournal object. C is a hash containing at least I and I (plaintext) or I (MD5 hash) key/value pairs. You may also include a I, for which the default is http://www.livejournal.com/cgi-bin/log.cgi. To use a proxy, add a I key and value. =item LiveJournal::livejournal->new([ FILES ]) If you want to use a file in the livejournalrc format to store your data, you can use this method instead. C is an array reference to the file(s) you want to load. If you don't specify any, it will use the first one found of ~/.livejournalrc, ~/.livejournal.rc, or /etc/livejournalrc. This will return an object in the LiveJournal class. =back =head1 BASE CLASS METHODS =over 4 =item login ([ INFO ]) Log in to the LiveJournal server. Returns a hash reference. The server returns whether the password is good or not, the user's name, an optional message to be displayed to the user, and the list of the user's friend groups. C is an optional hash reference containing the optional keys B, B, and B. B should exist and be the number of the highest mood ID you have cached/stored on the user's computer. For example, if you logged in last time with and got mood IDs 1, 2, 4, and 5, then send "5" as the value of "getmoods". The server will return every new mood that has an internal MoodID greater than 5. If you've never downloaded moods before, send "0". B should exist if you want to get a list/tree of web jump menus to show in your client. B should exist if you want to receive that list of picture keywords. =item user () Returns the username =item password () Returns the password or hpassword, whichever is set. =item version ([VERSION]) Returns the version string. You may alter the version string by passing a C. =item access ([ INFO ]) Sets/returns the journals that the user has the ability to post to. This method is called automatically by C. It returns a list reference containing each journal. =item friend_group ([ INFO ]) Sets/returns the friend group information. This method is called automatically by C. It returns a hash of hashes containing B and B key/value pairs. We use a hash instead of an array here because the group numbers start from 1 and it seemed more appropriate than having an undef 0 element or requiring adding 1 all the time. =item friend_group_max ([ MAX ]) Sets/returns the maximum friend_group number. This method is called automatically by C. =item menu ([ INFO ]) Sets/returns the menu text and URL information. This method is called automatically by C. You can use the list of lists of hashes it returns as data for menus. =item mood ([ INFO ]) Sets/returns the mood information. This method is called automatically by C. Returns a list of hashes containing the keys B and B for each mood. =item mood_count ([ COUNT ]) Sets/returns the number of moods. This method is called automatically by C. =item name ([ NAME ]) Sets/returns the name of the the logged in user. This method is called automatically by C. =item pic_keyword ([ KEYWORDS ]) Sets/returns the picture keywords. This method is called automatically by C. Returns a reference to a list of the keywords. =item escape (STRING) Use this method to escape strings. C is any string. All non-alphanumeric characters and non-whitespace are converted to their %hex values. Spaces are converted to B<+>s. =back =head1 FRIEND METHODS =over 4 =item check () Poll the server to see if the friends list has been updated. This request is extremely quick, and is the preferred way for users to see when their friends list is updated. Returns a hash reference. =item get ([ [ FRIENDOF ] [, GROUPS ] ]) Takes two optional arguements. If C is set to 1, you will also get back the info from the "friendof" mode. If C is set to 1, you will get the info from the "getfriendgroups" mode. This method returns a hash reference which should be passed to B to be more useful. B =item parse (FRIENDS) Takes one arguement: the hash reference returned from B. Returns a hash of lists of hashes containing the info (user, name, fg, bg, etc) for each friend such as: 'friend' =E [ { 'fg' =E '#000000', 'bg' =E '#FFFFFF', 'groupmask' =E '3', 'user' =E 'SomeUser', 'name' =E 'Some X. Name' } ] You should call B anytime you call B to keep your friend count up to date. =item edit (FRIENDS) This method is used to add and edit friends to your friends list. It takes a hash of hash references structure which has the B as the first level of keys. The second level contains optional B and B colors in #RRGGBB format. 'newfriend' =E { 'fg' =E '#000000', 'bg' =E '#FFFFFF', } B is the name of the new user. B should be the sum of C where n is incremented for each friend you are adding. =item add (FRIEND, [ FG [, BG ] ]) Use this method to add a user from your friends list. C is a username. C and C are foreground and background values in #RRGGBB format. =item remove (USERS) Use this method to remove users from your friends list. Pass it an array reference containing usernames. Returns a hash reference. =item friendof () This method returns a hash reference of the users that list you as a friend. This hash reference can be passed to B. =item lastupdate ([ LAST ]) Returns or sets the last time B was used. B sets this value so you don't have to. =item numfriends ([ NUMBER ]) This method sets and returns the number of friends you have. It is automatically called from B so you shouldn't have to worry about setting it manually. =item friends () Sets and returns your friends list. This method is called by C automatically to propagate the hash. =item getgroups () This method returns a hash reference containing information about your friend groups =item editgroups (INFO) Use this method to create or edit a friend group. You can modify the name, sort order, and public attributes of the group by passing a hashref containing the keys called B, B, or B and respective new values. You can also add a friend to a group or groups by passing their username as a key and the new groupmask as a value. =item deletegroups (NUMBERS) This method deletes a friend group. Pass it an array reference containing the numbers of the groups to delete. =item friends_by_group () Returns a hash of list references containing users and the groups they are members of. =item add_friend_to_group (USER, GROUP) Use this method to add a friend to a user group. C is the username of the person and C is the group number. =item remove_friend_from_group (USER, GROUP) Use this method to remove a friend from a user group. C is the username of the person and C is the group number. =head1 JOURNAL METHODS =item get (INFO) Use this method to download parts of a user's journal. C is a hash reference containing at least a key called B and a value of either B, B, B, or B. B will use the C method by default, otherwise pass it a date in the I format. If you use B, you may provide B, B, and B keys to specify which day. Default is today. The B value requires a B key which says how many of the most recent items to download. Maximum is 50. Default is 20. If you want a particular entry, you should use the B value and a complimentary B key containing the id of the item you want to grab. For further detail, see http://www.livejournal.com/developer/modeinfo.bml?getevents =item post (INFO) This method is used to post a journal entry. C is a hash reference containing at least an B key with a value of the post content. The date keys are created for you. For further detail, see http://www.livejournal.com/developer/modeinfo.bml?postevent =item edit (INFO) Used to edit user's past journal entry. C is a a hash reference containing at least the I and I being submitted. Other optional values are documented at http://www.livejournal.com/developer/modeinfo.bml?editevent =item remove (ITEMID) Used to delete a past journal entry. C is a scalar containing the unique item id to delete. =item syncitems () Returns a hash reference containing items (journal entries, to-do items, comments) that have been created or updated on LiveJournal since you last downloaded them. =item lastsync ([ LAST ]) Returns or sets the last time B was used. B sets this value so you don't have to. =item getdaycounts () This mode retrieves the number of journal entries per day. Useful for populating calendar widgets in GUI clients. =back =head1 AUTHOR Frank Sheiness http://feeding.frenzy.com/~rainking/ =head1 CREDITS =over =item * Brad 'bradfitz' Fitz for unconfusing me =item * Joe 'pinman' Wreschnig for his idea providing ventures into Perl-LiveJournal land =back =head1 URL =over =item * http://forbidden.dough.net/~archon/lj/ =head1 SEE ALSO =item * perl(1). =item * http://www.livejournal.com/developer/ =back =cut liblivejournal-perl-1.3.orig/Makefile.PL0100644000175000001440000000046107244414013017600 0ustar decklinusersuse ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'LiveJournal', 'AUTHOR' => 'Frank Sheiness ', 'ABSTRACT' => 'Implementation of LiveJournal protocol at www.livejournal.com', 'VERSION_FROM' => 'LiveJournal.pm', 'dist' => {COMPRESS=>'gzip', SUFFIX => 'gz'} ); liblivejournal-perl-1.3.orig/ChangeLog0100644000175000001440000000222107256470057017411 0ustar decklinusersVersion 1.3 - Added support for command and address in LiveJournalrc - Changed LiveJournal::Friend->edit() to use its own numbers instead of requiring that they be passed in - Added LiveJournal::Friend->add() as an interface to edit(). Used to add one friend Version 1.2 - Added friends_by_group() method. Couldn't think of a better name. - Added add_friend_to_group() method - Added remove_friend_from_group() method - Added _cleargroups method and fixed deletegroups() to use it - Fixed up LiveJournal::Friend->parse() to update everything. Also added a hash key for the number. There is probably a better way to handle all this. - Changed object data members to references so subclasses would be updated by changes to the base class - Added proxy support. Pass a 'proxy' key to LiveJournal->new(). Version 1.1 - LiveJournal::LiveJournalrc subclass and respective methods - LiveJournal::Friend->parse() no longer returns a value. It just sets the object's attribute accessable through friends() - Added parse_login() to be called after and with the results of login(). Sets several object attributes which have their own accessor methods.