#!/usr/bin/perl
# lj-edit-friends - a simple script for add or delete
# LiveJournal friends using by LJ XML-RPC interface.
# dimio (dimio.org), see more on: http://dimio.org/?p=1434
# See more about LJ XML-RPC on:
# livejournal.com/doc/server/ljp.csp.xml-rpc.protocol.html
require 5.008_008;
use warnings;
use strict;
use utf8;
use Digest::MD5 qw (md5_hex);
use LWP::UserAgent;

our $VERSION = '0.04';
# set 'print' like a 'say'
$\ = $/;

usage( $ARGV[0] ) if !@ARGV || $ARGV[0] =~ m{^-{0,2}(h|help)$}i;

my $options = {
	frlist_file	=> shift,
	friend_mode	=> shift || 'add', # 'add' or 'delete'

	login		=> shift || 'test',
	password	=> shift || 'test',
	
	rpc_host	=> 'http://www.livejournal.com/interface/xmlrpc',
};

my $friends_list = read_friends_list( $options->{frlist_file} );

my $ua = LWP::UserAgent->new (
	agent	=> "LJ XML-RPC Client v. $VERSION",
	timeout	=> 360,
);

my $challenge = get_challenge( $options, $ua );

print lj_editfriends( $options, $ua, $challenge, $friends_list );

####################################################################
sub usage {
	my $help = shift;

	print "$0 ver. $VERSION, dimio (dimio.org)$/" if $help;
	print <<EOF;
USAGE:
perl $0 <file> [mode] [lj_login] [lj_pass]
file		- path to file with a list of friends (required)
mode		- 'add' or 'delete' friends (optional, by default is 'add')
lj_login	- login to LJ account, may be specified on $0 (optional, by default is 'test')
lj_pass		- password to LJ account, may be specified on $0 (optional, by default is 'test')

h|help		- show help and exit
EOF
	exit;
}

sub lj_editfriends {
	my $options = shift;
	my $ua = shift;
	my $challenge = shift;
	my $friends_list = shift;

	my $resp_content = '<?xml version="1.0"?>
		<methodCall>
		<methodName>LJ.XMLRPC.editfriends</methodName>
		<params>
		<param>
		<value><struct>

		<member><name>username</name>
		<value><string>'. $options->{login} .'</string></value>
		</member>

		<member><name>auth_method</name>
		<value><string>challenge</string></value>
		</member>

		<member><name>auth_challenge</name>
		<value><string>'. $challenge .'</string></value>
		</member>

		<member><name>auth_response</name>
		<value><string>'. md5_hex( $challenge . md5_hex( $options->{password} )) .'</string></value>
		</member>

		<member><name>ver</name>
		<value><int>1</int></value>
		</member>

		<member><name>'. $options->{friend_mode} .'</name>
		<value><array>
		<data>';

		if ( $options->{friend_mode} eq 'add' ){
			$resp_content .= lj_addfriends( $friends_list );
		}
		elsif ( $options->{friend_mode} eq 'delete' ){
			$resp_content .= lj_deletefriends( $friends_list );
		}
		else {
			print "Illegal mode option \"$options->{friend_mode}\", see usage: $/";
			usage();
		}

		$resp_content .=
		'</data>
		</array></value>
		</member>

		</struct></value>
		</param>
		</params>
		</methodCall>';

	my $response = $ua->post( 
		$options->{rpc_host},
		Content => $resp_content,
	);
	die( $response->status_line )
		unless $response->is_success;

	return $response->decoded_content;
}

sub lj_deletefriends {
	my $friends_list = shift;

	my $resp_content;
	foreach( @{ $friends_list } ){
		$resp_content .=
		'<value><string>'. $_ .'</string></value>';
	}

	return $resp_content;
}

sub lj_addfriends {
	my $friends_list = shift;

	my $resp_content;
	foreach( @{ $friends_list } ){
		$resp_content .=
		'<value><struct>
		<member><name>username</name>
		<value><string>'. $_ .'</string></value>
		</member>
		</struct></value>';
	}

	return $resp_content;
}

sub get_challenge {
	my $options = shift;
	my $ua = shift;

	my $response = $ua->post( 
		$options->{rpc_host},
		Content => 
		'<?xml version="1.0"?>
		<methodCall>
		<methodName>LJ.XMLRPC.getchallenge</methodName>
		<params>
		<param>
		<value><struct>
		</struct></value>
		</param>
		</params>
		</methodCall>',
	);
	die( $response->status_line )
		unless $response->is_success;

	my $challenge = $1
		if $response->decoded_content =~ m#<string>([\w:]{3,})<\/string>#;

	return $challenge;
}

sub read_friends_list {
	my $file = shift;

	my $fh;
	open( $fh, '<', $file )
		or die "Can't open < $file: $!";

	# my @friends = <$fh>;
	my @friends;
	while ( <$fh> ){
		chomp;
		s/^\s+//;
		s/\s+$//;
		next if m{^(#.*|$)};
		s/^friend\s+//;
		s/(add|remove)\s+//;

		push @friends, $_;
	}

	close( $fh )
		or warn "Can't close $file: $!";

	return \@friends;
}