?

Log in

No account? Create an account
Perl/Tk LJ client. - LiveJournal Client Discussions [entries|archive|friends|userinfo]
LiveJournal Client Discussions

[ userinfo | livejournal userinfo ]
[ archive | journal archive ]

Perl/Tk LJ client. [Dec. 25th, 2004|07:42 pm]
LiveJournal Client Discussions

lj_clients

[lordindra]
Basic posting client... User security levels, moods, post to communities, thats about it. Adding moods and user pics should be fairly trivial.

Uses the XMLRPC::Lite module for network stuff, Tk and Tk::DialogBox for the GUI. Code isn't terribly well commented, but it should be fairly straightforward(for Perl). There may be some stub comments or code left in there for currently unimplemented features, but they won't affect the features that are functional.

Note the license data in the beginning of the code. There are three licenses that may apply, depending on what you want to do. For complete reimplementation of the design with original code(such as porting to another language), I only ask a credit to my original design be given. For actual use of the full code, or a substantial portion, its GPL. For use of a small portion(10% unchanged, 20% significantly altered), its BSD. If none of these situations apply, or you want a different license to apply to your use, contact me for guidance/request for a special license- I will generally be open to most open source uses, but proprietary uses, or uses that don't credit my work, I will probably not be open to those.


#!/usr/bin/perl -w
#LiveJournal Anywhere- The *TRULY* Cross Platform LiveJournal posting client.
#Live Journal is a trademark of Live Journal(http://www.livejournal.com)

#Copyright 2003 George E Worroll Jr<george.worroll@gmail.com>

#License information:

#For reimplementation of the underlying design with 100% original code:
#- A credit must be included in your source code comments, and accompanying
#README or equivalent documentation files.  

#For using the actual code:

#Licensed under GNU GPL.  Full license text in the file COPYING.TXT or 
#http://www.gnu.org/licenses/gpl.html

#This program is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2 of the License, or
#(at your option) any later version.
#
#This program is distributed 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.  See the
#GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with this program; if not, write to the Free Software
#Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#Special license for trivial use: If you take less than 10% of the code 
#unchanged, or up to 20% with significant changes, you can use it under 
#the terms of a modified BSD license as follows:

#Copyright (c) <2003>, 
#All rights reserved.

#Redistribution and use in source and binary forms, with or without 
#modification, are permitted provided that the following conditions 
#are met:
#
#   * Redistributions of source code must retain the above copyright 
#     notice, this list of conditions and the following disclaimer.
#   * Redistributions in binary form must reproduce the above 
#     copyright notice, this list of conditions and the following 
#     disclaimer in the documentation and/or other materials provided 
#     with the distribution.
#   * The names of contributors to this project may not be used to 
#     endorse or promote products derived from this software without 
#     specific prior written permission.

#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
#AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
#IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
#ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
#LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
#CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
#SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
#INTERRUPTION) HOWEVER CAUSED AND ON #ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING#NEGLIGENCE OR OTHERWISE) 
#ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, #EVEN IF ADVISED OF
#THE POSSIBILITY OF SUCH DAMAGE.

#pragmata
use strict;
use diagnostics;

#modules
use Tk;
use Tk::DialogBox;
use XMLRPC::Lite;

#init code


#Configuration globals
#TODO: Move the values for these into a configuration file.
use constant LIVEJOURNAL => 'http://www.livejournal.com/interface/xmlrpc';
our $default_font = "-adobe-helvetica-medium-r-*--*-120-*-*-*-p-*-*"; 
our $app_name = "LiveJournal Anywhere Version 0.1.0 Alpha";

#Global variables for the postevent routine
our $mood;
our $journal;
our $picture;

our $user_mask = 0x00000000; #bitfield denoting which groups of friends can see this post
our $security = 'public'; #security level of post.  if a friends only, use the usemask
                          #to determine which groups of friends can see
our %groups; #translation table from group name to numerical ID


#********************************************************************************
#Set Up the client
#********************************************************************************
our $client = XMLRPC::Lite->proxy(LIVEJOURNAL)
             ->on_fault(sub{die "Failed to create client: $!\n"});


#********************************************************************************
#Main Window
#********************************************************************************


#line 50
our $whole_app = MainWindow->new();
$whole_app->title("$app_name");

#--------------------------------------------------------------------------------
#Widgets
#--------------------------------------------------------------------------------



#Next two widgets are the label and entry box for the post subject
my $lbl_sub = $whole_app->Label(text   => 'Subject',
                              anchor => 'n',
			      relief => 'groove',
			      width  => 10,
                              height => 1);

our $ent_sub = $whole_app->Entry(width  => 60);

$lbl_sub->grid($ent_sub);

#second row
#this widget is for the main text of the entry
our $txt_ent = $whole_app->Text(width  	=> 80,
				height 	=> 30,
				wrap	=> 'word');
our $lst_groups = $whole_app->Listbox(height     => 30,
				      selectmode => 'extended');
$txt_ent->grid("-", $lst_groups);

#This row of widgets holds various posting options
our $frame_display_opts = $whole_app->Frame();

our $com_moods = $frame_display_opts->Menubutton(text => 'Moods');
$com_moods->grid();

our $com_picture = $frame_display_opts->Menubutton(text => 'Picture');
$com_picture->grid();

our $ent_music = $frame_display_opts->Entry("width" => 20);
$ent_music->grid();


our $frame_post_opts = $whole_app->Frame();
our $com_journals = $frame_post_opts->Menubutton(text => 'Journals');
$com_journals->grid();

our $com_security = $frame_post_opts->Menubutton(text => 'Security');
$com_security->grid();

our $btn_post = $frame_post_opts->Button(text => "Post Entry",
				  command => \&post_entry);
$btn_post->grid();




$frame_display_opts->grid("-",$frame_post_opts);


#--------------------------------------------------------------------------------
#Login Dialog box 
#--------------------------------------------------------------------------------

our $login_dialog = $whole_app->DialogBox(-title => 'Login',
                                         -buttons => ['Login'],
					);
$login_dialog->add("Label", -text => "User Name")->pack();
our $user_name = $login_dialog->add("Entry", -width => 20)->pack();

$login_dialog->add("Label", -text => "Password")->pack();
our $password = $login_dialog->add("Entry", -width => 20)->pack();

my $activate = $login_dialog->Show;
if ($activate eq "Login"){
	&login;
}else{
	die "done fucked up";
}





#********************************************************************************
#Event Loop
#********************************************************************************
MainLoop();


#********************************************************************************
#Event handlers
#********************************************************************************

sub login{
	#Logs user in and retrieves various information
	my $name = $user_name->get;
	my $pass = $password->get;

	my $login_result = $client->call('LJ.XMLRPC.login',
			                 {username  => $name,
                                          password  => $pass,
					  getmoods  => 0,
					  getpickws => 1});
	
	my $login_info = $login_result->result;
	my %login_crap = %$login_info;
	my $full_name = $login_crap{fullname};
	
	my $mood_crap = $login_crap{moods};
	my @mood_list = @$mood_crap;
	&fill_mood_list(@mood_list);

	my $journal_crap = $login_crap{usejournals};
	my @journal_list = @$journal_crap;
	&fill_journal_list(@journal_list);

	my $group_crap = $login_crap{friendgroups};
	my @group_list = @$group_crap;
	&fill_groups_list(@group_list);

	#Fill security level menu
	$com_security->radiobutton(-label   => 'Public',
				   value    => 'public',
				   variable => \$security);
	$com_security->radiobutton(-label   => 'Friends Only',
				   value    => 'friends',
				   variable => \$security);
	$com_security->radiobutton(-label   => 'Private',
				   value    => 'private',
				   variable => \$security);	
	$com_security->radiobutton(-label   => 'Friends Group',
				   value    => 'usemask',
				   variable => \$security);
#	$lst_groups->activate(0);

#	&fill_picture_list($login_crap{pickws});

	$whole_app->title("$full_name");
}

#--------------------------------------------------------------------------------
#Utility functions for logon
#--------------------------------------------------------------------------------
sub fill_mood_list{
	
	my @moods = sort { $a->{name} cmp $b->{name} } @_;
	my $count = @moods;

	my $mood_name;
	my $mood_ID;
	my %mood_hash;

	for (@moods){
		%mood_hash = %$_;
		$mood_name = $mood_hash{name};
		$mood_ID   = $mood_hash{id};
		$com_moods->radiobutton(-label   => $mood_name,
					value    => $mood_ID,
				        variable => \$mood);
	}
}

sub fill_groups_list{	
	my @groups = sort { $a->{name} cmp $b->{name} } @_;

	my $group_name;
	my $group_ID;
	my %group_hash;

	for (@groups){
	        %group_hash = %$_;
		$group_name = $group_hash{name};
		$group_ID   = $group_hash{id};
		$lst_groups->insert('end', $group_name);
		$groups{$group_name} = $group_ID;
	}
}

sub fill_journal_list{
	
	my @journals = sort @_;

	my $user = $user_name->get;
	$com_journals->radiobutton(-label   => $user,
				   value    => $user,
				   variable => \$journal);
	for (@journals){
		$com_journals->radiobutton(-label   => $_,
					value    => $_,
				        variable => \$journal);
	}
}

sub fill_picture_list{

}

sub post_entry{
	#Posts an entry to the selected journal

	#-Get the data to use for postevent

	#--Get user information
	my $name  = $user_name->get or die"name" ;  
	my $pass  = $password->get or die "pass";

	#--Get post information
	my $entry = $txt_ent->get('0.0', 'end') or die "entry";
	my $sub   = $ent_sub->get or die "sub";

	#--Get the current date and time
	my $year = 1900 + (localtime)[5];
	my $mon  = 1 + (localtime)[4];
	my $day  = (localtime)[3];
	my $hour = (localtime)[2];
	my $min  = (localtime)[1];
	
	#decide who can see the entry
	if($security eq 'usemask'){
	    #Zero out the bit fields
	    my $bits = 0x00000000;    #this field holds the bit value of one group
	    my $mask = 0x00000000;    #this field holds the temporary allowmask
	    my @groups_list = $lst_groups->curselection();
	    
	    #build the allowmask
	    #get the index of each selection, then get the selection and translate to a bit position
	    for(@groups_list){     
	        $bits = 2**($groups{$lst_groups->get($_)} - 1);
		$mask |= $bits;
	    }
	    $user_mask = $mask << 1;  #shift the temp one to the left to get the positions right
	}elsif($security eq 'friends'){
	    $user_mask = 0x00000001;
	    $security = 'usemask';
	}elsif($security eq 'private'){
	    #do nothing, everything set
	}elsif($security eq 'public'){
	    #as above, no special processing
	}

	    
	
	
	#posts the entry
	#die "made it to the post sub";
	$client->call('LJ.XMLRPC.postevent',
		      {username    => $name,
		       password    => $pass,
		       event       => $entry,
		       lineendings => 'pc',
                       subject     => $sub,
		       year        => $year,
		       mon         => $mon,
                       day         => $day,
                       hour        => $hour,
                       min         => $min,
		       security    => $security,
		       allowmask   => $user_mask,
		       props       => ({current_moodid => $mood}),
		       usejournal  => $journal });
}

linkReply

Comments:
From: ex_kolen
2004-12-26 09:17 pm (UTC)
looks cool
(Reply) (Thread)