#!/usr/bin/env perl
# -*-perl-*-
# Header comments and licensing info {{{1
#
# LiveJournal Client
# (see http://www.livejournal.com/)
# (protocol information at http://www.livejournal.com/developer/)
#
# This version by:
# C. A. "Sapphire Cat" Daelhousen
# http://www.livejournal.com/community/sclj
# $Id: sclj,v 1.11 2004/03/22 22:56:44 sapphirecat Exp $
#
# 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, in a file named "LICENSE"; if not, write to:
#    Free Software Foundation, Inc.
#    59 Temple Place, Suite 330
#    Boston, MA  02111-1307  USA
#

#################
#
# Initialize {{{1
#

package SCLJ;
# Version check {{{2
use 5.005; # Required by LWP

BEGIN { # Module inclusions, optional and required {{{2
	# Must-have modules (now first: even failure is optimized!)
	use URI::Escape;
	use LWP::UserAgent;
	use Text::Wrap;

	$has_Textile = $has_XMMS = $has_D_MD5 = $has_P_T = $has_T_RK = 0;

	if(eval "require Text::Textile") {
		eval "use Text::Textile qw(textile)";
		$has_Textile = 1;
	}

	if(eval "require Xmms::Remote") {
		eval "use Xmms::Remote";
		$has_XMMS = 1;
	}

	if(eval "require Digest::MD5") {
		eval "use Digest::MD5 qw(md5_hex)";
		$has_D_MD5 = 1;
	}

	if(eval "require POSIX::Termios") {
		eval "use POSIX::Termios";
		$termios = $POSIX::Termios->new;
		$termios->getattr(); # Fill with attributes for stdin
		%POSIX = ( 'lflag_orig' => $termios->getlflag );
		$has_P_T = 1;
	} elsif(eval "require Term::ReadKey") {
		eval "use Term::ReadKey";
		$has_T_RK = 1;
	}
	#elsif has Term::ReadLine::Gnu
	#elsif has Term::ReadLine::Perl
	#elsif has stty and SCLJ::ECHO_OFF and SCLJ::ECHO_ON don't fail
	#else set whine and cry flag
}

END { # Terminal resetting code {{{2
	if($has_P_T) {
		$termios->setlflag($POSIX{'lflag_orig'});
		$termios->setattr();
	} elsif($has_T_RK) {
		ReadMode('restore');
	} else {
		system($SCLJ::ECHO_ON);
	}
}

##########################################################
# Default values {{{2

$VERSION = '3.2';

$DOTDIR = '';
$EVENT_EXT = '.html';

# disable/enable echoing of input characters without any Term modules
# available. This has been tested on a random Sun server, Red Hat 7.0/7.3,
# some Gentoo versions, and FreeBSD 4.6.
$ECHO_OFF = '/bin/stty -echo';
$ECHO_ON = '/bin/stty echo';

%Defaults = (
	'columns' => 80, # screen width for Text::Wrap::wrap()
	'postquit' => 0, # Quit after posting if set
	'proxy' => undef, # Proxy host:port information from command line
	'dir' => "$ENV{'HOME'}/.sclj3", # Where to store per-(OS)user data files
	'editor' => $ENV{'VISUAL'} || $ENV{'EDITOR'} || 'emacs',
		# Text editor for editing events
	'timeout' => 45, # Network timeout
	'proxy_host' => undef, # proxy hostname (address), usable form
	'proxy_port' => undef,  # proxy port number, usable form
	'auth_mode' => 'plain' # traditional authentication method
);

##########################################################
# Main initialization driving code {{{2
my ($rc, $post, $opts, $ua, $success);

# We're not taint-safe, so we certainly can't run setuid. This is a more
# user-friendly error than Perl crashing on a taint check.
if($< != $>) {
	print STDERR "Can't update journal while running setuid.\n";
	exit 2;
}

# Options and immediate handling
$opts = SCLJ::Init::ParseOptions();
$DOTDIR = (exists $opts->{'dir'} ? $opts->{'dir'} : $Defaults{'dir'});
$Defaults{'tmpdir'} = SCLJ::IO::FindTempDir(); # needs $DOTDIR
if(defined $opts->{'proxy'} && $opts->{'proxy'} =~ /:/) {
	if(/^(.+):(\d+)$/) {
		$opts->{'proxy_host'} = $1;
		$opts->{'proxy_port'} = $2;
	} else {
		print "Ignoring proxy option: doesn't seem to be in 'host:port' form\n";
	}
}

# Get RC loaded
SCLJ::Init::DirCheck($DOTDIR);
$rc = SCLJ::Init::LoadRC($DOTDIR);

# Command line overrides RC, which overrides defaults
$rc = SCLJ::Core::HashMerge($opts, $rc, \%Defaults);
$Text::Wrap::columns = $rc->{'columns'};

# Create a new post and set its account
SCLJ::Init::Check(SCLJ::Core::LoadPostDefaults(\$post));
# SCLJ::Init handles undefined default account
SCLJ::Init::SetAccount(\$post, $rc);
# HashMerge with defaults guarantees we have these keys
$ua = SCLJ::Init::Net($rc->{'timeout'}, $rc->{'proxy_host'},
	$rc->{'proxy_port'});

# Transfer control to the UI {{{1
SCLJ::UI::Start( {
	'rc' => $rc,
	'post' => $post,
	'ua' => $ua }
);

###################
#
#  Subroutines {{{1
#

### Initialization Support {{{1
package SCLJ::Init;
# Parse the command-line options {{{2
sub ParseOptions {
	#my () = @_;
	my ($i, $optok, @expected, %opts);

	$optok = 1;
	for $i (0..$#ARGV) {
		$_ = $ARGV[$i];

		if($optok && /^-.+/) {
			# We don't have anything that needs this yet.
			# do { $optok = 0; next } if $_ eq '--';
			s/^-//;
			for(split(//)) {
				# Alphabetical order by option
				if   (/-/) { SCLJ::Core::PrintUsage(); } # Catch '--help' gracefully
				elsif(/d/) { push(@expected, \$opts{'dir'}); }
				elsif(/e/) { push(@expected, \$opts{'editor'}); }
				elsif(/p/) { push(@expected, \$opts{'proxy'}); }
				elsif(/t/) { push(@expected, \$opts{'tmpdir'}); }
				elsif(/q/) { $opts{'postquit'} = 1; }
				elsif(/w/) { push(@expected, \$opts{'columns'}); }
				else       { print "Warning: \"-$_\" option unrecognized.\n"; }
			}
		} elsif($optok && /^\+.+/) {
			s/^\+//;
			for(split(//)) {
				if   (/q/) { $opts{'postquit'} = 0; }
				else       { print "Warning: \"+$_\" option unrecognized.\n"; }
			}
		} elsif($optok && $#expected >= 0) {
			${$expected[0]} = $_;
			shift(@expected);
		# We don't support any non-options yet, so we don't need to care about
		# !$optok
		} else {
			SCLJ::Core::PrintUsage(); # Found something unexpected
		}

		# Didn't find something expected. This is why we don't just do
		# for(@ARGV).
		if($i == $#ARGV && $#expected >= 0) { SCLJ::Core::PrintUsage(); }
	}

	return \%opts;
}

# Check permissions of our hidden directory {{{2
sub DirCheck {
	my ($dir) = @_;
	my (@stats, $owner, $perms, $pass);

	if(!-e $dir) {
		return; # well, you can open and post without a dotdir...
	}

	$pass = 1;

	@stats = stat $dir;
	$owner = $stats[4];
	$perms = $stats[2] & 0777;
	if($owner != $>) {
		print STDERR "Ownership error: please run 'chown <user> $dir'.\n" .
			"<user> should be replaced by your username for your computer.\n";
		$pass = 0;
	}
	if($perms != 0700) {
		print STDERR "Permissions error: please run 'chmod 0700 $dir'.\n";
		$pass = 0;
	}

	exit 3 unless $pass;
}

# Initialize the RC hash from our dotdir {{{2
sub LoadRC {
	my ($dir, $defaults) = @_;

	my ($success, $message, $rc) = SCLJ::IO::HashLoad(1, "rc");

	if($success == 0) {
		print "Error opening rc file: $message\nTrying rc-less mode.\n";
		$rc = { 'rcless' => 1 };
	} elsif($success == -1) { # Not Found, don't complain
		$rc = { 'rcless' => 1 };
	} else {
		$rc->{'rcless'} = 0;
	}

	return $rc;
}

# Set the initial post's account no matter what {{{2
sub SetAccount {
	my ($postr, $rc) = @_;
	my ($success, $msg, @dirlist);

	@dirlist = SCLJ::IO::DirList(1, "accounts");
	$entries = $#dirlist + 1;

	if($entries == 0 && $rc->{'rcless'} != 1) {
		print "No accounts found; falling back to rc-less mode.\n";
		$rc->{'rcless'} = 1;
	}

	if($rc->{'rcless'} == 1) {
		OpenPost($postr);
	} elsif($entries == 1) {
		($success, $msg) = SCLJ::Core::SetAccount($$postr, $dirlist[0]);
		if($success != 1) {
			__Fail("Couldn't open only account: $msg");
		}
	} else {
		if(exists $rc->{'default_acct'}) {
			($success, $msg) = SCLJ::Core::SetAccount($$postr,
				$rc->{'default_acct'});
			if($success == 1) {
				return;
			} else {
				print "Couldn't load account \"$rc->{'default_acct'}\"\n";
			} # if successfully loaded
		} # if exists default_acct

		SelectAccount($postr, \@dirlist);
		$rc->{'default_acct'} = $postr->{'acct'}->{'alias'};
	} # if(1 entry)
}

# Open a post, looping on failure {{{2
sub OpenPost {
	my ($postr) = @_;
	my ($success, $msg, $post, $file);

	do {
		print "Open post: ";
		$file = SCLJ::IO::ReadLine();
		if(length $file == 0) {
			exit 1;
		}
		($success, $file) = SCLJ::UI::DirComplete($file, 1);
		if($success == -1) {
			exit 1;
		} elsif($success == 0) {
			print "$file\n";
		} else {
			($success, $msg, $post) = SCLJ::IO::HashLoad(0, $file);
			if($success == 1) {
				$$postr = $post;
			} else { # !success
				print "$msg\n";
			} # success of reading file
		} # success of completion
	} while(!exists ${$postr}->{'acct'});
}

# Select an account when multiple entries are present {{{2
sub SelectAccount {
	my ($postr, $dirlist) = @_;
	my ($success, $msg, $file);

	do {
		print Text::Wrap::wrap('', '', "Found " . ($#{$dirlist}+1) . " accounts:",
			join(", ", @{$dirlist}) . "."), "\n";
		print "Select account: ";
		$file = SCLJ::IO::ReadLine();
		if(length $file) {
			$file = SCLJ::UI::Complete($file, $dirlist);
			# Core::SetAccount passes back 0 for file not found, which will happen
			# in the case of no completions found.
			($success, $msg) = SCLJ::Core::SetAccount($$postr, $file);
			if($success == 0) {
				print "Couldn't open account: $msg\n";
			} # if success
		} else { # !length $file
			exit 1;
		} # if length $file
	} while(!exists ${$postr}->{'acct'});
}

# Initialize network-specific things {{{2
sub Net {
	my ($timeout, $proxy, $port) = @_;
	my ($ua);

	$ua = SCLJ::Net::MakeAgent($timeout);
	if(defined $proxy && defined $port) {
		$ua->proxy('http', "http://$proxy:$port/");
	}

	return $ua;
}

# Handle initialization errors in non-SCLJ::Init functions {{{2
sub Check {
	my($success, $msg) = @_;
	__Fail($msg) if $success == 0;
}

# Failed to initialize; quit. {{{2
sub __Fail {
	my ($specific) = @_;
	print STDERR Text::Wrap::wrap('', '', $specific), "\n";
	exit 2;
}

### User Interface {{{1
package SCLJ::UI;
## Core UI code (UI driver section) {{{2
# Start the UI {{{3
sub Start {
	my ($params) = @_;
	my ($line, $result, @tblkeys);

	$params->{'table'} = __GenNormalTable($params);
	@tblkeys = keys %{$params->{'table'}};
	$params->{'tablekeys'} = \@tblkeys;

	print "Enter 'help' for help.\n";
	while(1) {
		print "LJ: ";
		$line = SCLJ::IO::ReadLine();
		$result = Parse($params, $line);
		if($result->{'OK'} == 0) {
			print Text::Wrap::wrap('', '', $result->{'errmsg'}), "\n";
		}
	}
}

# Parse the command lines into commands {{{3
sub Parse {
	my ($p, $cmdline) = @_;
	my ($cmdtbl, $cmd, $data, $result);

	# Ignore blank lines.
	if(length($cmdline) == 0) {
		return { 'OK' => -1 };
	}

	$cmdtbl = $p->{'table'};

	# Split to command/args and complete the command.
	($cmd, $data) = split(/\s+/, $cmdline, 2);
	$cmd = Complete($cmd, $p->{'tablekeys'});

	# Ignore canceled completion.
	if(length($cmd) == 0) {
		return { 'OK' => -1 };
	}

	# Fail if the command doesn't exist.
	if(!exists $cmdtbl->{$cmd}) {
		$result = { 'errmsg' => "Unknown command \"$cmd\"." };
	} else {
		# Pass the command off to the appropriate handler.
		my $cmdfunc = $cmdtbl->{$cmd}->{'cmd'};
		my $cmdargs = $cmdtbl->{$cmd}->{'args'};
		$cmdargs .= ', ' if length($cmdargs);
		if(defined $data) {
			# Backslash-escape backslashes and the string terminator here, so that
			# they will be un-backslash-escaped in the eval.
			$data =~ s/([\\'])/\\$1/g;
			$data = "'$data'";
		} else {
			$data = "undef";
		}
		$cmdargs .= $data;
		$result = eval "\&$cmdfunc($cmdargs)";
		if(!defined $result) {
			$result = { 'errmsg' => "EVAL FAILED: $@" };
		}
	}

	if(exists $result->{'errmsg'}) {
		$result->{'OK'} = 0;
	} elsif(!exists $result->{'OK'}) {
		$result->{'OK'} = -1;
	}

	return $result;
}

## Core UI mode and data structure handling {{{2
# Generate a command table suitable for normal mode {{{3
sub __GenNormalTable {
	my %NORMAL_TBL = (
		'account' => { # {{{4
			'cmd' => 'Account',
			'args' => "\\\$p->{'post'}->{'acct'}, \\\$p->{'post'}->{'picture'}, " .
				"\\\$p->{'post'}->{'journal'}, \\\$p->{'post'}->{'allowmask'}, " .
				"\\\$p->{'post'}->{'security'}",
			'desc' => <<ENDDESC
"account foo" sets the account to foo. An account tells what username,
password, and server to use. Journal and picture will be set to the default,
and custom security will be set to private. Anything else will remain the
same. Accounts can be created, edited, renamed, and deleted with the "scljed"
program.
ENDDESC
		},
		'auth' => { # {{{4
			'cmd' => 'Auth',
			'args' => "\\\$p->{'rc'}->{'auth_mode'}",
			'desc' => <<ENDDESC
"auth plain" uses the traditional plaintext mode of logging in. "auth
challenge" uses the newer, more secure challenge/response style. This requires
both support from the server and the Digest::MD5 module.
ENDDESC
		},
		'backdate' => { # {{{4
			'cmd' => 'Backdate',
			'args' => "\\\$p->{'post'}->{'backdate'}",
			'desc' => <<ENDDESC
If backdate is "yes", this entry can be dated some time in the past, and
posted in your journal. It can't be posted in communities if this flag is set.
Backdating prevents the entry from showing on any "friends" pages. See also
"date", "time".
ENDDESC
		},
		'date' => { # {{{4
			'cmd' => 'Date',
			'args' => "\\\$p->{'post'}->{'date'}",
			'desc' => <<ENDDESC
"date 2003-01-30" uses a date of January 30, 2003 for this entry, instead of
the date when it is sent to the server. "date" alone sets it back to the date
of posting. Any non-numeric character separates the fields, so 2003/01/30 and
2003.01.30 are also accepted. See also "time", "backdate".
ENDDESC
		},
		'comments' => { # {{{4
			'cmd' => 'Comment',
			'args' => "\\\$p->{'post'}->{'comments'}",
			'desc' => <<ENDDESC
"comments no" removes the "Post a Comment" and "Read __ Comments" links for
this entry.
ENDDESC
		},
		'email' => { # {{{4
			'cmd' => 'Email',
			'args' => "\\\$p->{'post'}->{'emails'}",
			'desc' => <<ENDDESC
"email no" will prevent replies to this post from being emailed to you. This
has no effect unless you have turned on "Get message board replies" in your
user profile on the server.
ENDDESC
		},
		'event' => { # {{{4
			'cmd' => 'Event',
			'args' => "\\\$p->{'post'}->{'event'}, \$p->{'rc'}->{'editor'}, " .
				"\$p->{'rc'}->{'tmpdir'}",
			'desc' => <<ENDDESC
"event" loads the body of this entry into your editor. "event file" will read
the event in from "file" instead, replacing the current event.
ENDDESC
		},
		'format' => { # {{{4
			'cmd' => 'Format',
			'args' => "\\\$p->{'post'}->{'format'}",
			'desc' => <<ENDDESC
Entries can be formatted in any of three ways. "format html" selects HTML
mode, which is equivalent to LiveJournal's "don't auto-format" mode; "format
standard" treats the entry as standard text, where pressing Enter makes a new
line, which is the same as LiveJournal's auto-formatting; lastly, "format
paragraph" selects paragraph mode, where pressing Enter once is like a space,
but pressing it twice makes a new paragraph. The mode may be abbreviated to a
single character, for instance "format p" for paragraph mode.
ENDDESC
		},
		'help' => { # {{{4
			'cmd' => 'Help',
			'args' => "\$p->{'table'}",
			'desc' => <<ENDDESC
There is no more help on help itself.
ENDDESC
		},
		'journal' => { # {{{4
			'cmd' => 'Journal',
			'args' => "\\\$p->{'post'}->{'journal'}, ".
				"\$p->{'post'}->{'acct'}->{'journals'}",
			'desc' => <<ENDDESC
"journal foo" will make this entry appear in the community "foo". You must be
a member of that community for this to work.
ENDDESC
		},
		'list' => { # {{{4
			'cmd' => 'List',
			'args' => "{ 'moods' => \$p->{'post'}->{'acct'}->{'serv'}->{'moods'}, ".
					"'groups' => \$p->{'post'}->{'acct'}->{'frgrps'}, " .
					"'journals' => \$p->{'post'}->{'acct'}->{'journals'}, " .
					"'pictures' => \$p->{'post'}->{'acct'}->{'pics'} " .
				"}",
			'desc' => <<ENDDESC
Lists various bits of information about the account. "list moods" shows the
moods that have icons, "list groups" shows the friend groups, "list journals"
shows the available journals, and "list pictures" shows the pictures. Any of
these may be followed by prefixes to show only items beginning with those
prefixes. For example, "list moods m n" will show only moods beginning with m
and n. Everything completes, so "li mo m n" would be equivalent.
ENDDESC
		},
		'login' => { # {{{4
			'cmd' => 'Login',
			'args' => "\$p->{'post'}->{'acct'}, \$p->{'ua'}, " .
				"\$p->{'rc'}->{'auth_mode'}",
			'desc' => <<ENDDESC
"login" retrieves the latest list of moods, journals, friend groups, and
pictures from the server. "login save" will write this information to disk, at
which point using login will only be required when the information changes
(for instance, joining a community.)
ENDDESC
		},
		'mood' => { # {{{4
			'cmd' => 'Mood',
			'args' => "\\\$p->{'post'}->{'moodtxt'}, \\\$p->{'post'}->{'moodid'}, " .
				"\$p->{'post'}->{'acct'}->{'serv'}->{'moods'}",
			'desc' => <<ENDDESC
Sets the mood which will appear as the "current mood" for this post. If it
matches the beginning of one of the moods that server has icons for, then it
will have an icon as well. For instance, "mood like I wasted \$20" will simply
set the mood, but "mood misch" should set the mood to "mischievous" and give
it an icon. "mood" alone will remove the mood from the entry.
ENDDESC
		},
		'music' => { # {{{4
			'cmd' => 'Music',
			'args' => "\\\$p->{'post'}->{'music'}",
			'desc' => <<ENDDESC
"music foo" sets the music which will appear as the "current music" for this
entry to "foo". "music detect" will attempt to get the current music from
XMMS. "music" alone will remove the music from the entry.
ENDDESC
		},
		'open' => { # {{{4
			'cmd' => 'Open',
			'args' => "\\\$p->{'post'}",
			'desc' => <<ENDDESC
"open foo" opens an entry that was saved in a file named "foo" and allows for
further editing of it. See also "save".
ENDDESC
		},
		'password' => { # {{{4
			'cmd' => 'Password',
			'args' => "\$p->{'post'}->{'acct'}->{'alias'}, " .
				"\\\$p->{'post'}->{'acct'}->{'pass'}, " .
				"\\\$p->{'post'}->{'acct'}->{'crypt_pass'}",
			'desc' => <<ENDDESC
"password foo" sets the password to "foo". Using "password" and pressing Enter
will read the password without printing it on the screen; this is recommended.
ENDDESC
		},
		'picture' => { # {{{4
			'cmd' => 'Picture',
			'args' => "\\\$p->{'post'}->{'picture'}, " .
				"\$p->{'post'}->{'acct'}->{'pics'}",
			'desc' => <<ENDDESC
"picture foo" will set the picture to "foo", where foo is one of the picture
keywords for the current account. "picture" alone will set the default
picture. You need to have uploaded pictures at the website of the server for
this to work.
ENDDESC
		},
		'post' => { # {{{4
			'cmd' => 'Post',
			'args' => "\$p->{'post'}, \$p->{'ua'}, \$p->{'rc'}->{'auth_mode'}, " .
				"\$p->{'rc'}->{'postquit'}",
			'desc' => <<ENDDESC
Sends this entry to the server. sclj will usually create a new, blank entry
afterward, unless "quit after posting" was set with scljed, or the -q option
was used.
ENDDESC
		},
		'quit' => { # {{{4
			'cmd' => 'Quit',
			'args' => '',
			'desc' => <<ENDDESC
Quits sclj.
ENDDESC
		},
		'reset' => { # {{{4
			'cmd' => 'Reset',
			'args' => "\\\$p->{'post'}, \$p->{'rc'}, \$p->{'rc'}->{'default_acct'}",
			'desc' => <<ENDDESC
Throws away the current post, and creates a new blank one.
ENDDESC
		},
		'screen' => { # {{{4
			'cmd' => 'Screen',
			'args' => "\\\$p->{'post'}->{'screen'}",
			'desc' => <<ENDDESC
Sets which comments on this entry will be screened. "screen" alone will use
the journal's default setting. "screen everyone" will screen all comments;
"screen anonymous" will screen comments by anonymous users; "screen outsiders"
will screen comments by people who are not friends; and "screen none" will
screen no comments. The screening level may be abbreviated to a single
character, for instance "screen a" to screen anonymous comments.
ENDDESC
		},
		'save' => { # {{{4
			'cmd' => 'Save',
			'args' => "\$p->{'post'}",
			'desc' => <<ENDDESC
"save foo" saves the current entry to a file named "foo". This file may be
taken to any computer that also has sclj 3.0 (or better), opened, and posted,
even if that computer does not have your account information on it. See also
"open".
ENDDESC
		},
		'security' => { # {{{4
			'cmd' => 'Security',
			'args' => "\\\$p->{'post'}->{'security'}, \\\$p->{'post'}{'allowmask'}, ".
				"\$p->{'post'}->{'acct'}->{'frgrps'}",
			'desc' => <<ENDDESC
"security public", "security friends", and "security private" set the entry to
be viewable by anyone, any of your friends, or only you, respectively.
"security custom foo bar" sets the entry to be viewable by any friends in
groups "foo" or "bar".  The groups must be set up on the server's website
already.
ENDDESC
		},
		'subject' => { # {{{4
			'cmd' => 'Subject',
			'args' => "\\\$p->{'post'}->{'subject'}",
			'desc' => <<ENDDESC
"subject foo" sets the subject of this entry to "foo". "subject" alone will
remove the subject from the entry.
ENDDESC
		},
		'time' => { # {{{4
			'cmd' => 'Time',
			'args' => "\\\$p->{'post'}->{'time'}",
			'desc' => <<ENDDESC
"time 15:17" uses a time of 3:17 PM for this entry, instead of the time when
it is sent to the server. "time" alone sets it back to the time of posting.
Any non-numeric character separates the fields, so 15.17 is also accepted. See
also "date", "backdate".
ENDDESC
		},
		'values' => { # {{{4
			'cmd' => 'Values',
			'args' => "\$p->{'post'}, \$p->{'rc'}->{'auth_mode'}",
			'desc' => <<ENDDESC
Displays all of the current settings for this entry, such as mood, music,
security, subject, and the first few lines of the event text.
ENDDESC
		},
		'version' => { # {{{4
			'cmd' => 'Version',
			'args' => '',
			'desc' => <<ENDDESC
Simply shows a message containing the version number of sclj.
ENDDESC
		},
	); #}}}
	return (\%NORMAL_TBL);
}

## Information commands {{{2
# Give help on the commands {{{3
sub Help {
	my ($tbl, $arg) = @_;
	my (@arglist, @keys, $msg, $j, $text);

	@keys = keys %{$tbl};
	$msg = '';
	if(defined $arg) { # Do long help for the requested commands
		@arglist = split(/\s+/, $arg);
		for $i (@arglist) {
			$j = Complete($i, \@keys);
			if(length($j) == 0) {
				return { 'OK' => -1 };
			} elsif(exists $tbl->{$j}) {
				$text = $tbl->{$j}->{'desc'};
				$text =~ s/\n/ /g;
				$msg .= "$j:\n" . Text::Wrap::wrap('  ', '', $text) . "\n";
			} else {
				$msg .= "$i is not a command.\n";
			}
		}
	} else { # Do short help for all commands
		$msg .= "Commands may be abbreviated to the first two letters. ".
			"Commands are:\n";
		$msg .= Text::Wrap::wrap('', '', join(", ", sort(@keys))) . "\n";
		$msg .= Text::Wrap::wrap('', '',
			"\"help command\" will give more detailed help on that command, e.g. " .
			"\"help mood\".") . "\n";
	}

	print $msg;
	return { 'OK' => 1 };
}

# Show the list of moods/journals/etc., with text wrapping. {{{3
sub List {
	my ($parmhash, $prefix) = @_;
	my ($tmp, $i, $which, @keys, @results, @prefixes, $array, %hack);

	# Take the first field as which thing to list
	if(defined $prefix) {
		($which, $prefix) = split(/\s+/, $prefix, 2);
	}

	if(!defined $which) {
		return {
			'errmsg' => "\"list\" requires an argument; see \"help list\"."
		};
	}

	@keys = keys %{$parmhash};
	$which = Complete($which, \@keys);
	if(!exists($parmhash->{$which})) {
		return { 'errmsg' => "Can't list $which; see \"help list\"." };
	}

	$array = [];
	if($which eq 'groups') {
		@{$array} = values %{$parmhash->{$which}};
	} elsif($which eq 'moods') {
		@{$array} = keys %{$parmhash->{$which}};
	} else {
		$array = $parmhash->{$which};
	}

	if(defined $prefix) {
		@prefixes = split(/\s+/, $prefix);
		for $i (@{$array}) {
			for $prefix (@prefixes) {
				# Hack to avoid duplicating mood names in @moods if two prefixes
				# overlap
				$hack{$i} = 1 if $i =~ /^\Q$prefix\E/;
			}
		}
		@results = keys %hack;
		$tmp = " beginning with " . join('/', @prefixes);
	} else { # No prefix: show all
		@results = @{$array};
		$tmp = '';
	}

	if($#results >= 0) {
		print "The following ${which}${tmp} are available:\n";
		print Text::Wrap::wrap('', '', join(", ", sort(@results)) );
		print "\n";
	} else {
		print "There are no ${which}${tmp} for this account.\n";
	}

	return { 'OK' => 1 };
}

# Show current values for all user-defined fields {{{3
sub Values {
	my ($post, $authmode, $trash) = @_;
	print "\n";

	print "Posting to "; # [journal as] user on server {{{4
	if(length($post->{'journal'}) > 0) {
		print "$post->{'journal'} as ";
	}
	print $post->{'acct'}->{'alias'};
	print " on $post->{'acct'}->{'serv'}->{'alias'}.\n";

	print "Subject: $post->{'subject'}\n"; # {{{4

	print "Mood: $post->{'moodtxt'}"; # {{{4
	if($post->{'moodid'}) { print " (with icon)"; }
	print "\n";

	print "Music: $post->{'music'}\n"; # {{{4
	
	print "Security: " . # {{{4
		Values__Security($post->{'security'}, $post->{'acct'}->{'frgrps'},
			$post->{'allowmask'}) .
		"\n";

	print "Formatting style: "; # {{{4
	if($post->{'format'} eq 'p') {
		print "Paragraph mode (blank lines to <P> tags)";
	} elsif($post->{'format'} eq 's') {
		print "Standard auto-formatting (newlines to <BR>)";
	} elsif($post->{'format'} eq 't' && $SCLJ::has_Textile) {
		print "Using Textile to format as HTML";
	}	else {
		print "None (HTML formatting only)";
	}
	print "\n";

	print "Comments: "; # + emails + screening {{{4
	if($post->{'comments'} == 0) {
		print "Disabled";
	} else {
		print "Enabled";
		if($post->{'emails'} == 0) {
			print ", but without emails";
		} else {
			print ", with emails";
		}

		if($post->{'screen'} eq '') {
			print "; journal's screening setting";
		} elsif($post->{'screen'} eq 'n') {
			print "; no comments screened";
		} elsif($post->{'screen'} eq 'a') {
			print "; anonymous comments screened";
		} elsif($post->{'screen'} eq 'o') {
			print "; non-friends' comments screened";
		} elsif($post->{'screen'} eq 'e') {
			print "; all comments screened";
		} else {
			print "; <sclj is broken>";
		}
	}
	print "\n";

	if(defined $post->{'acct'}->{'pics'}) { # {{{4
		print "Picture: ",
			((length($post->{"picture"}) > 0) ? $post->{'picture'} : "Default"),
			"\n";
	}

	print "Backdated: ", # Date, and Time {{{4
		(($post->{'backdate'} == 1) ? "yes" : "no"),
		"\n";
	print "Date: ",
		(($#{$post->{'date'}} > -1) ? join('-', @{$post->{'date'}}) : "current"),
		"\n";
	print "Time: ",
		(($#{$post->{'time'}} > -1) ? join(':', @{$post->{'time'}}) : "current"),
		"\n";

	print "Password: ", # {{{4
		((exists($post->{'acct'}->{'pass'})) ? "set" : "not set"),
		"\n";

	print "Authentication mode: ", $authmode, "\n"; # {{{4

	if(defined($post->{'event'})) { # {{{4
		print "Event begins with:\n";
		for(0..2) { # Only print the first 3 lines of the event.
			print "$post->{'event'}->[$_]\n" if defined $post->{'event'}->[$_];
		}
	} else {
		print "Event not edited yet";
	}
	print "\n"; # }}}

	return { 'OK' => 1 };
}

# Show the version of sclj {{{3
sub Version {
	print "Sapphire Cat's LiveJournal client, version $SCLJ::VERSION\n";
}

## Variable setting functions {{{2
# Set a generic free text field {{{3
sub GenericText {
	my ($fieldref, $arg, $fieldname, $completions, $opts) = @_;
	my (%result, $tmp);

	$result{'OK'} = 1;
	if(!defined $arg) {
		$$fieldref = '';
	} elsif(defined $completions) {
		$tmp = Complete($arg, $completions, $opts);
		if(length($tmp) > 0) {
			$$fieldref = $tmp;
		} else {
			$result{'OK'} = -1;
		}
	} else {
		$$fieldref = $arg;
	}

	if(length($$fieldref) > 100) {
		$$fieldref = substr($$fieldref,0,100);
		$result{'OK'} = 0;
		$result{'errmsg'} = "Warning: $fieldname truncated:\n$$fieldref";
	}

	return \%result;
}

# Set the mood text and ID {{{3
sub Mood {
	my ($mtxtref, $midref, $mhashref, $arg) = @_;
	my (@mlist, $result);

	@mlist = keys %{$mhashref};
	$result = GenericText($mtxtref, $arg, "Mood", \@mlist, { 'noprefix' => 0 });

	# Set the mood ID from the mood text
	if(length($$mtxtref) && exists $mhashref->{"$$mtxtref"}) {
		$$midref = $mhashref->{"$$mtxtref"};
	} else {
		$$midref = 0;
	}

	return $result;
}

# Set music string {{{3
sub Music {
	my ($musicref, $arg) = @_;
	my ($result, $detect, $oldval);

	$oldval = $$musicref;
	$result = GenericText($musicref, $arg, "Music");
	if((!exists($result->{'errmsg'})) && length($arg) > 0) {
		# Let "mu de" detect music.
		$detect = Complete($$musicref, [ 'detect' ]);
		if($detect eq 'detect') {
			$result = __MusicAutoDetect($musicref);
		}
		if(exists($result->{'errmsg'})) {
			$$musicref = $oldval;
		}
	}

	return $result;
}

# Set subject {{{3
sub Subject {
	my (@args) = @_;

	push(@args, "Subject");
	return GenericText(@args);
}

# Set a generic boolean field {{{3
sub GenericBoolean {
	my ($fieldref, $arg, $default) = @_;

	if(!defined $arg) { $$fieldref = $default; }
	elsif($arg =~ /^y/i) { $$fieldref = 1; }
	elsif($arg =~ /^n/i) { $$fieldref = 0; }
	else { return { 'errmsg' => 'Option must begin with "y" or "n"' }; }

	return { 'OK' => 1 };
}

# Set the backdate flag {{{3
sub Backdate {
	my @args = @_;

	push(@args, 0);
	return GenericBoolean(@args);
}

# Set the no-comments flag {{{3
sub Comment {
	my @args = @_;

	push(@args, 1);
	return GenericBoolean(@args);
}

# Set the don't-email-comment-replies flag {{{3
sub Email {
	my @args = @_;

	push(@args, 1);
	return GenericBoolean(@args);
}

# Set a generic list ID {{{3
sub GenericList {
	my ($fieldref, $fieldarr, $arg) = @_;
	my ($name, $index, $bigerr);

	if(!defined $arg) {
		$$fieldref = '';
		return { 'OK' => 1 };
	} else {
		$arg = Complete($arg, $fieldarr);
		return { 'OK' => -1 } unless length($arg);
		for $name (@{$fieldarr}) {
			if($arg eq $name) {
				$$fieldref = $name;
				return { 'OK' => 1 };
			}
		}

		# Not there.
		$bigerr = "$arg couldn't be found in any of: ";
		$bigerr .= join(', ', @{$fieldarr});
		return { 'errmsg' => $bigerr };
	}
}

# Set journal {{{3
sub Journal {
	my (@args) = @_;

	if($#{$args[1]} == -1) {
		return {
			'errmsg' => "You do not have access to any shared (community) journals."
		};
	}

	return GenericList(@args);
}

# Set picture {{{3
sub Picture {
	my (@args) = @_;

	if($#{$args[1]} == -1) {
		return { 'errmsg' => "You have not uploaded any pictures." };
	}

	return GenericList(@args);
}

# Change the current account {{{3
sub Account {
	my ($acctref, $picref, $journalref, $maskref, $secref, $arg) = @_;
	my ($acctname, @accts, $newacct, $msg, $code, $fakepost);

	# opendir/readdir to get a list of accounts, then closedir
	@accts = SCLJ::IO::DirList(1, "accounts");

	# GenericList to select one of them
	$acctname = $$acctref->{'alias'};
	#GenericList($fieldref, $fieldarr, $arg, $desc, $defstr);
	$code = GenericList(\$acctname, \@accts, $arg);

	# steal the response to actually get+set the account and server info
	if(exists $code->{'OK'} && $code->{'OK'} == 1) {
		$fakepost = { () };
		($code, $msg) = SCLJ::Core::SetAccount($fakepost, $acctname);
		if($code == 0) {
			return { 'errmsg' => $msg };
		}

		$$picref = '';
		$$journalref = '';
		if($$secref eq 'custom') {
			$$maskref = 0;
			$$secref = 'private';
		}
		$$acctref = $fakepost->{'acct'};
		return { 'OK' => 1 };
	} else {
		return $code;
	}
}

# Set formatting {{{3
# the server can do \n -> <BR> reformatting, the client can do
# \n\n -> \n<P>\n reformatting, or neither can be done
sub Format {
	my ($fmtref, $arg) = @_;
	my (%result);

	$arg = '' unless defined $arg;

	if($arg =~ m/^([shpt])/i) {
		$$fmtref = lc $1;
		$result{'OK'} = 1;
	} else {
		$result{'errmsg'} = 'See "help format" for formatting options.';
	}

	return \%result;
}

# Set comment screening {{{3
sub Screen {
	my ($scrref, $arg) = @_;
	my (%result);

	$result{'OK'} = 1;

	if(!defined $arg) {
		$$scrref = '';
	} elsif($arg =~ m/^([naoe])/i) {
		$$scrref = lc $1;
	} else {
		$result{'OK'} = 0;
		$result{'errmsg'} = 'See "help screen" for comment screening options.';
	}

	return \%result;
}

# Set authentication mode {{{3
sub Auth {
	my ($authref, $arg) = @_;
	my (%modes);

	%modes = ( 'plain' => 1, 'challenge' => 1 );

	if(!defined $arg) {
		return { 'OK' => -1 };
	}

	$arg = Complete($arg, [ keys(%modes) ]);
	if(exists($modes{$arg})) {
		$$authref = $arg;
		return { 'OK' => 1 };
	} else {
		return { 'errmsg' => "Unknown mode ($arg)" };
	}
}

# Set password {{{3
sub Password {
	my ($user, $passref, $cryptref, $arg) = @_;
	my ($pass, $crypt);

	if(!defined $arg) {
		($pass, $crypt) = __ReadPass($user);
	} else { 
		# I quit making security decisions for everyone....
		($pass, $crypt) = SCLJ::Core::CryptPass($arg);
	}

	if(length($pass)) {
		$$passref = $pass;
		$$cryptref = $crypt;
		return { 'OK' => 1 };
	} else {
		return { 'OK' => -1 };
	}
}

# Edit the event {{{3
sub Event {
	my ($eventref, $editor, $dir, $arg) = @_;
	my ($success, $msg, $quoteparse, @pieces, @editorbits, $file, $unlink);

	$unlink = 1;
	if(!defined $arg) {
		$file = "$dir/sclj" . SCLJ::Core::RandomChars(8) . $SCLJ::EVENT_EXT;

		($success, $msg) = SCLJ::IO::ArraySave(0, $file, $$eventref);
		if($success != 1) {
			return { 'errmsg' => "Failed to create event ($file): $msg" };
		}

		$quoteparse = qr{(?:"((?:\\\\|\\"|[^\\"])*?)"|(\S+))};
		@pieces = ($editor =~ /$quoteparse/g);
		for my $piece (@pieces) {
			push(@editorbits, $piece) if defined $piece;
		}
		push(@editorbits, $file);

		$success = system(@editorbits);
		if($success != 0) {
			return { 'errmsg' => "\"$editor $file\" returned $success" };
		}
	} else {
		($success, $file) = DirComplete($arg, 1);
		return { } if $success == -1;
		return { 'errmsg' => $file } if $success == 0;
		$unlink = 0;
	}

	($success, $msg, $newevent) = SCLJ::IO::ArrayLoad(0, $file);
	if($success != 1) {
		return { 'errmsg' => "Failed to read edited event ($file): $msg" };
	} else {
		$$eventref = $newevent;
		unlink $file if $unlink == 1;
		return { 'OK' => 1 };
	}
}

# Set a generic string of numeric fields {{{3
sub GenericNumArray {
	my ($fieldref, $arg, $fieldname, $example, $nfields) = @_;
	my (%result, @fields);

	$arg = '' unless defined $arg;
	$result{'OK'} = 1;
	@fields = $arg =~ m/\d+/g;
	if($arg eq '') {
		$$fieldref = [ () ];
	} elsif($#fields == ($nfields - 1)) {
		$$fieldref = \@fields;
	} else {
		$result{'errmsg'} = "Too " . (($#fields >= $nfields) ? "many" : "few") .
			" fields given for the $fieldname. Something like $example was " .
			"expected.";
	}

	return \%result;
}

# Set the date of the post {{{3
sub Date {
	my ($dateref, $arg) = @_;

	return GenericNumArray($dateref, $arg, "date", "2003-01-30", 3);
}

# Set the time of the post {{{3
sub Time {
	my ($timeref, $arg) = @_;

	return GenericNumArray($timeref, $arg, "time", "14:08", 2);
}

# Set the security level of the post: public/friends/custom/private {{{3
sub Security {
	my ($secref, $maskref, $groupref, $arg) = @_;
	my ($newsec, $grouparg, %revgrp, @grpnames, @selnames, @badnames, %result);

	$arg = 'public' unless defined $arg;

	# "se cu min pe" should be able to set the "minions" and "peons" groups.
	($arg, $grouparg) = split(/\s+/, $arg, 2);
	$newsec = Complete($arg, [ 'public', 'friends', 'custom', 'private' ]);

	$result{'OK'} = 1;
	if($newsec eq 'public' || $newsec eq 'private') {
		$$secref = $newsec;
		$$maskref = 0;
	} elsif($newsec eq 'friends') {
		$$secref = $newsec;
		$$maskref = 1;
	} elsif($newsec eq 'custom') {
		@grpnames = keys %{$groupref};
		if($#grpnames == -1) {
			$result{'errmsg'} = 'You have no friend groups. Changing to private.';
			$$secref = 'private';
			return \%result;
		}

		%revgrp = reverse %{$groupref};
		if(!defined $grouparg) {
			return {
				'errmsg' => "No groups specified for custom security. Groups are: " .
					join(', ', keys %revgrp)
			};
		} else {
			@grpnames = keys %revgrp;
			for $groupname (split(/\s+/, $grouparg)) {
				(@groups) = Complete($groupname, \@grpnames, { 'multi' => 1 } );
				return { 'OK' => -1 } unless length $groups[0];
				push(@selnames, @groups);
			}
		}

		$$maskref = 0;
		for $groupname (@selnames) {
			$$maskref |= 1 << $revgrp{$groupname};
		}

		if($#badnames >= 0) {
			$result{'errmsg'} = "Couldn't find friend groups " .
				join(', ', @badnames) . "; groups are " . join(', ', keys %revgrp) .
				".";
			if($$maskref == 0) { # no valid groups
				$result{'errmsg'} .= " Making post private.";
				$$secref = 'private';
			}
		} else {
			$$secref = 'custom';
		}
	} else {
		$result{'errmsg'} =
			'Security must be public, friends, custom, or private.';
	}

	return \%result;
}

## Command functions {{{2
# Retrieve information from the server {{{3
sub Login {
	my ($acct, $ua, $authmode, $arg) = @_;
	my ($result, $i, $tmp, $saveres, $msg, %passinfo);

	$|++;
	print "Logging in...";

	$result = SCLJ::Web::Login($acct, $ua, $authmode);

	if($result->{'success'} ne 'OK') {
		print "failed!\n";
		$result->{'OK'} = 0;
	} else {
		print "OK.\n";
		delete $result->{'success'};

		if(defined $result->{'message'}) {
			print "MESSAGE FROM THE SERVER:\n";
			print Text::Wrap::wrap('  ', '', $result->{'message'}), "\n\n";
			delete $result->{'message'};
		}

		$tmp = '';
		for $i (keys %{$result}) {
			$tmp .= ', ' if length($tmp);
			$tmp .= "$result->{$i} $i";
		}
		print "Fetched $tmp.\n" if length($tmp);

		$result->{'OK'} = 1;
	}

	# Only save successful logins
	if($result->{'OK'} == 1 && Complete($arg, [ 'save' ]) eq 'save') { 
		$tmp = $acct->{'serv'};
		delete $acct->{'serv'};

		# Copy the password info and remove from the hash to save if we shouldn't
		# save it
		if($acct->{'paranoid'} == 1) {
			$passinfo{'pass'} = $acct->{'pass'};
			$passinfo{'crypt_pass'} = $acct->{'crypt_pass'};
			delete $acct->{'pass'};
			delete $acct->{'crypt_pass'};
		}

		# Save account info
		($saveres, $msg) = SCLJ::IO::HashSave(1, "accounts/$acct->{'alias'}",
			$acct);

		# Restore the password info, regardless of success
		if($acct->{'paranoid'} == 1) {
			$acct->{'pass'} = $passinfo{'pass'};
			$acct->{'crypt_pass'} = $passinfo{'crypt_pass'};
		}

		# Save server info
		if($saveres == 1) {
			($saveres, $msg) = SCLJ::IO::HashSave(1, "servers/$tmp->{'alias'}",
				$tmp);
		}

		# Check for error
		if($saveres != 1) {
			$result->{'OK'} = 0;
			$result->{'errmsg'} =
				"Login succeeded, but saving data said \"$msg\"";
		}
		$acct->{'serv'} = $tmp;
	}

	$|--;
	return $result;
}

# Send a post to the server {{{3
sub Post {
	my ($post, $ua, $authmode, $postquit, $trash) = @_;
	my (%result);

	$|++;
	print "Updating journal...";

	%result = SCLJ::Web::Post($post, $ua, $authmode);

	if($result{'success'} eq 'OK') {
		print "OK.\n";
		$result{'OK'} = 1;
	} else {
		print "failed!\n";
	}

	$|--;

	if(exists $result{'OK'} && $result{'OK'} == 1 &&
		defined $postquit && $postquit == 1)
	{
		exit 0;
	}

	return \%result;
}

# Reset a post to default values {{{3
sub Reset {
	my ($postr, $rc, $trash) = @_;
	my ($acctname, $newpost);

	# For no default account, leave the current account unharmed.
	if(!exists $rc->{'default_acct'}) {
		$acctname = ${$postr}->{'acct'}->{'alias'};
	} else {
		$acctname = $rc->{'default_acct'};
	}

	# NOTE: If LoadPostDefaults fails, $$postr is untouched.
	($success, $msg) = SCLJ::Core::LoadPostDefaults(\$newpost);
	if($success == 0) { return { 'errmsg' => $msg }; }

	if($acctname ne ${$postr}->{'acct'}->{'alias'}) {
		($success, $msg) = SCLJ::Core::SetAccount($newpost, $acctname);
		if($success == 0) { return { 'errmsg' => $msg }; }
	}

	$$postr = $newpost;
	return { 'OK' => 1 };
}

# Save a post to a file {{{3
sub Save {
	my ($post, $arg) = @_;
	my ($success, $msg);

	if(!defined $arg) {
		return { 'errmsg' => 'No file name given.' };
	}

	($success, $msg) = DirComplete($arg, 0);
	return { } if $success == -1;
	return { 'errmsg' => $msg } if $success == 0;
	$arg = $msg;

	if(-e $arg) {
		print "$arg already exists.";
		if(!SCLJ::IO::IsV2(0, $arg)) {
			print " It doesn't look like a saved post.";
		}
		print "\nLJ: Save: Erase it and save anyway (y/n)? ";
		my $answer = SCLJ::IO::ReadLine();
		return { } unless $answer =~ /^y/i;
	}

	($success, $msg) = SCLJ::File::Save($arg, $post);

	if($success == 0) {
		return { 'errmsg' => $msg };
	} else {
		return { 'OK' => 1 };
	}
}

# Load a post from a file {{{3
sub Open {
	my ($postr, $arg) = @_;
	my ($success, $msg, $post);

	if(!defined $arg) {
		return { 'errmsg' => 'No file name given.' };
	}

	($success, $msg) = DirComplete($arg, 1);
	return { } if $success == -1;
	return { 'errmsg' => $msg } if $success == 0;
	$arg = $msg;

	if(!-e $arg) {
		return { 'errmsg' => "$arg doesn't exist." };
	}

	($success, $msg, $post) = SCLJ::File::Load($arg);
	if($success == 1) {
		$$postr = $post;
		return { 'OK' => 1 };
	} else {
		return { 'errmsg' => $msg };
	}
}

# Quit sclj {{{3
sub Quit {
	exit 0;
}

## Private functions {{{2
# Read password {{{3
sub __ReadPass {
	my ($user, $pass)=@_;

	if(!defined $pass) {
		# Print prompt
		print "LJ: Password";
		print " for $user" if defined $user;
		print ": ";

		# Read passwd appropriately
		if($SCLJ::has_T_RK) {
			Term::ReadKey::ReadMode('noecho');
			$pass = Term::ReadKey::ReadLine();
			Term::ReadKey::ReadMode('normal');
			chomp $pass;
		} else {
			if(system($SCLJ::ECHO_OFF) > 0)
			{	print STDERR "Can't stop echoing to read password\n"; exit 4; }
			$pass = SCLJ::IO::ReadLine();
			system($SCLJ::ECHO_ON); # if the first one succeeds, this should
		}
		print "\n";
	}

	# Crypt if available
	return SCLJ::Core::CryptPass($pass);
}

# Complete a word [XXX: not private anymore] {{{3
sub Complete {
	my ($prefix, $completions, $opts) = @_;
	my ($i, @candidates, $multi_ok, $no_prefix);

	$multi_ok = 0;
	$no_prefix = 1;
	if(defined $opts) {
		$multi_ok = $opts->{'multi'} if exists $opts->{'multi'};
		$no_prefix = $opts->{'noprefix'} if exists $opts->{'noprefix'};
	}

	for $i (@{$completions}) {
		push(@candidates, $i) if $i =~ /^\Q$prefix\E/i;
	}

	if($#candidates == -1) { # No completions
		return $prefix;
	} elsif($#candidates == 0) { # One completion
		return $candidates[0];
	} else { # Multiple completions
		my $tmp = ' one';
		$tmp = ' any number of these, separated by spaces' if $multi_ok == 1;
		print Text::Wrap::wrap('', '',
			"$prefix is ambiguous. Please select${tmp}:\n");
		@candidates = sort(@candidates);
		unshift(@candidates, $prefix) unless $no_prefix;
		return __SubComplete(\@candidates, $multi_ok);
	}
}

sub __SubComplete { # {{{4
	my ($completions, $multi_ok) = @_;
	my ($i, $completed, $index, @ret);

	print "0: None of these";
	$index = 1;
	for $completed (@{$completions}) {
		print "\n$index: $completions->[$index - 1]";
		$index++;
	}
	print "\nLJ: complete: ";
	if(length($arg = SCLJ::IO::ReadLine()) && $arg !~ /[^\d\s]/) {
		if($multi_ok) {
			my @items = split(/\s+/, $arg);
			my $bail = 0;
			for my $item (@items) {
				do { $bail = 1; last } if $item == 0;
				push(@ret, $completions->[$item - 1]);
			}

			@ret = ('') if $bail;
		} else {
			$arg -= 1;
			if($arg < 0 || $arg > $#{$completions}) { # "None", or out of range
				@ret = ('');
			} else {
				@ret = ($completions->[$arg]);
			}
		}
	} else { # Invalid format or no answer
		@ret = ('');
	}

	return ($multi_ok ? @ret : $ret[0]);
}

# Complete all directories and files along a path [XXX: Belongs in IO] {{{3
sub DirComplete {
	my ($incomplete, $last_exists) = @_;
	my (@pieces, @dirlist, $last, $completed, $tmp);

	if($incomplete =~ s#^~/##) { # Home directory?
		$completed = "$ENV{'HOME'}/";
	} elsif($incomplete =~ s#^/##) { # Root directory?
		$completed = '/';
	} else { # Default: current directory
		$completed = './';
	}

	@pieces = split(m#(/+)#, $incomplete);

	# Don't try to complete the last element if it need not exist yet
	if($last_exists == 0) {
		$last = pop(@pieces);
	} else {
		$last = '';
	}

	for my $piece (@pieces) {
		if($piece =~ m#^/#) {
			$completed .= '/';
		} else {
			if(!opendir(DIR, $completed)) {
				return (0, "$completed: $!");
			}
			@dirlist = grep { !m/^\./ } readdir DIR;
			closedir DIR;
			$tmp = Complete($piece, \@dirlist);
			return (-1, undef) unless length $tmp;
			if(!-e "${completed}${tmp}") {
				$completed =~ s#/$##;
				return (0, "Couldn't find $piece in $completed");
			} else {
				$completed .= $tmp;
			}
		} # if piece contains /
	} # for @pieces

	$completed .= $last;
	return (1, $completed);
}

# Show who may view this post {{{3
sub Values__Security {
	my ($security, $groups, $mask) = @_;
	my ($tmp, $i);

	if(length($security) == 0 || $security eq 'public') {
		return 'Public';
	} elsif($security eq 'friends') {
		return 'Friends only (all friends)';
	} elsif($security eq 'custom' && defined $groups && $mask > 1) {
		$tmp = '';
		for $i (keys %{$groups}) {
			# Check defined groups, not all bits.
			if((1 << $i) & $mask) {
				$tmp .= ', ' if length($tmp);
				$tmp .= $groups->{$i};
			}
		}
		if(length($tmp)) {
			return "Custom (groups: $tmp)";
		} else {
			return "Custom, but no groups? I'm confused.";
		}
	} elsif($security eq 'private') {
		return 'Private';
	} else {
		return 'Something impossible';
	}
}

# Get current music from XMMS {{{3
sub __MusicAutoDetect {
	{
		my ($musicref) = @_;
		my ($remote, $title);

		if(!$SCLJ::has_XMMS) {
			return { 'errmsg' => "Perl-Xmms is required for \"music detect\"" };
		}

		$remote = Xmms::Remote->new;
		if(!$remote->is_running) {
			return { 'errmsg' => "XMMS is not running" };
		}

		if($remote->get_playlist_length == 0) {
			return { 'errmsg' => "XMMS playlist is empty" };
		}

		$title = $remote->get_playlist_title($remote->get_playlist_pos);
		$title =~ s/\.[^.]{3}$//; # Strip extension if it's there

		$$musicref = $title;
		return { 'OK' => 1 };
	};
}

### I/O handling {{{1
package SCLJ::IO;
# Check to see if a file looks like a v2 data file {{{2
sub IsV2 {
	my ($in_dotdir, $name) = @_;
	my ($data, $ret, $head_comment, $root_hash);

	$name = __NameTranslate($in_dotdir, $name);

	# We can't do a -B because it might have a large Russian event in it.
	if(!open(FILE, '<'.$name)) {
		return 0;
	}

	$head_comment = qr/sclj data file v2/;
	$root_hash    = qr/HASH\s+\"root\"/;

	$ret = 0;
	$data = <FILE>;
	if($data =~ $head_comment || $data =~ $root_hash) {
		$ret = 1;
	} else {
		for $data (<FILE>) {
			if($data =~ $root_hash) {
				$ret = 1;
				last;
			}
		} # for
	}

	close FILE;
	return $ret;
}

# Read a file into an array by lines {{{2
sub ArrayLoad {
	my ($in_dotdir, $name) = @_;
	my ($msg, $array);

	$name = __NameTranslate($in_dotdir, $name);

	if(!-e $name) {
		return (-1, "$name not found", undef); # Success, message, array
	} elsif(!open(FILE, "<$name")) {
		return (0, "$name: $!", undef);
	}

	$array = [ () ];
	@{$array} = <FILE>;
	chomp @{$array};

	close FILE;

	return (1, undef, $array);
}

# Write out an array to lines of a file {{{2
sub ArraySave {
	my ($in_dotdir, $name, $array) = @_;
	my ($msg, $line);

	$name = __NameTranslate($in_dotdir, $name);

	if(!open(FILE, ">$name")) {
		return (0, "$name: $!");
	}

	local $\ = $/; # Add newlines to print statements in this function only
	for $line (@{$array}) {
		print FILE $line;
	}

	close FILE;

	return (1, undef);
}

# Read and chomp a line from standard input, and protect against EOF. {{{2
sub ReadLine {
	my $line;
	if($SCLJ::has_T_RK) {
		chomp ($line = SCLJ::ReadLine());
	} else {
		chomp ($line = <STDIN>);
	}
	$line='' unless defined $line;
	return $line;
}

# Load a hash with values from a file. {{{2
sub HashLoad {
	my ($in_dotdir, $name) = @_;
	my ($quoteparse, $structname, $struct, $nextloc, %structs, %waiters,
		$in, $which);

	$success = 1;
	$name = __NameTranslate($in_dotdir, $name);

	if(!-e $name) {
		return (-1, "$name not found", undef); # Success, message, hash
	} elsif(!IsV2(0, $name)) { # Already translated isn't in dotdir
		return (0, "$name doesn't look like a sclj3 data file");
	} elsif(!open(FILE, "<$name")) {
		return (0, "$name: $!", undef);
	}

	# TMTOWTDI, I'm sure.
	# Match any number of: pairs of backslashes, backslash-quote pairs, and any
	# character that has nothing to do with backslashes or quotes.
	$quoteparse = qr{"((?:\\\\|\\"|[^\\"])*?)"\s*};

	# Handle forwards and backwards references, with separate namespaces for
	# hashes and lists.
	$structs{'LIST'} = { };
	$structs{'HASH'} = { };
	$waiters{'LIST'} = { };
	$waiters{'HASH'} = { };

	$structname = '';

LINE:
	for (<FILE>) {
		chomp;
		next LINE if /^\s*(#.*)?$/gc; # Blank or comment
		/^\s*/gc; # Skip leading whitespace

		if(!defined $struct) {
			# We're at the top level, looking for the next structure

			if(/\G(HASH|LIST)\s+$quoteparse/gc) {
				$structname = __UnEscape($2);

				$in = $1;
				if($in eq 'HASH') {
					$struct = { };
				} else { # $which eq 'LIST' because of the pattern match
					$struct = [ ];
				}
			} else {
				print STDERR "Ignoring line at the top level of the file:\n$_\n";
			}
		} else {
			# We're inside something right now

			if(/\GEND\s+$quoteparse/gc) {
				# We have to leave it now
				my $ending = __UnEscape($1);

				$which = $in;

				if($ending ne $structname) {
					print STDERR "Saw END \"$ending\" inside $in \"$structname\";\n" .
						"Assuming the END should end \"$structname\"\n";
				}

				if(exists $waiters{$which}->{$structname}) {
					# Something was waiting for this struct: fill those locations
					for my $locref (@{$waiters{$which}->{$structname}}) {
						$$locref = $struct;
					}

					delete $waiters{$which}->{$structname};
				}

				# Now store the struct for future references
				$structs{$which}->{$structname} = $struct;

				$struct = undef;
				next LINE;
			} # END keyword

			if($in eq 'HASH') { # Hash key
				if(/\GKEY\s+$quoteparse/gc) {
					my $key = __UnEscape($1);
					$struct->{$key} = undef;
					$nextloc = \$struct->{$key};
				} else {
					if(/\G(?=KEY\s)/) {
						print STDERR "Ignoring bad quoting of key in $in $structname:\n" .
							"$_\n";
					} else {
						print STDERR "Item lacks key in $in $structname:\n$_\n";
					}
					next LINE;
				}
			} elsif($in eq 'LIST') { # List item
				my $index = $#{$struct};
				$struct->[$index+1] = undef;
				$nextloc = \$struct->[$index+1];
			} else {
				print STDERR "Invalid parser state detected at line:\n$_\n";
				# We have no idea what this could possibly be, so escape all control
				# and meta characters, and crop to a couple lines of trash.
				$in =~ s/([\000-\037\200-\377])/'\x'.sprintf("%02x", hex(ord($1)))/ge;
				$in = substr($in, 0, $Text::Wrap::columns * 2 - 1);
				print STDERR "Parser state is:\n$in\n";
				return (0, "Impossible state", undef);
			}

			# Figure out what the item is
			if(/\GUNDEFINED/gc) {
				# Undefined. We can always store it now.
				$$nextloc = undef;
			} elsif(/\GSCALAR\s+$quoteparse/gc) {
				# Only a scalar. We can always store it now.
				my $val = __UnEscape($1);
				$$nextloc = $val;
			} elsif(/\G(LIST|HASH)REF\s+$quoteparse/gc) {
				# Some sort of structure...
				my $name = __UnEscape($2);

				$which = $1;
				if(exists $structs{$which}->{$name}) {
					# We already have the structure; store a reference to it now.
					$$nextloc = $structs{$which}->{$name};
				} elsif(exists $waiters{$which}->{$name}) {
					# Add to the existing list of locations.
					push(@{$waiters{$which}->{$name}}, $nextloc);
				} else { # We are the first waiter
					# Create a new key to store locations where the structure will
					# go once its END keyword is read from the file.
					$waiters{$which}->{$name} = [ $nextloc ];
				}
			} else {
				print STDERR "Ignoring bad " .
					(/\G(?=SCALAR|LISTREF|HASHREF\s)/ ? "quoting" : "keyword") .
					" found in $in $structname:\n$_\n";
			}
		}
	} # LINE

	close FILE;

	for $which (keys %waiters) {
		for my $what (keys(%{$waiters{$which}})) {
			print STDERR "$which \"$what\" referenced but not defined.\n";
		}
	}

	return ($success, undef, $structs{'HASH'}->{'root'});
}

# Save values from a hash to a file (unsorted.) {{{2
sub HashSave {
	my ($in_dotdir, $name, $hash) = @_;
	my ($oldchan, $success, $msg, $key, $val);

	$success = 1;
	$name = __NameTranslate($in_dotdir, $name);

	if(!open(FILE, ">$name")) {
		return (0, "$name: $!");
	}
	$oldchan = select FILE;

	print "# sclj data file v2\n# quotes required; \\\\ and \\\" recognized.\n\n";
	($success, $msg) = __SaveHash(__Escape("root"), $hash, { });

	select $oldchan;
	close FILE;

	return ($success, $msg);
}

# Save a single hash to a file (which must be select()'ed) {{{2
sub __SaveHash {
	my ($name, $hash, $saved) = @_;
	my (@keys, %refs, $success, $msg, $subsuccess, $submsg);

	@keys = keys %{$hash};
	%refs = ();
	$success = 1;

	print "HASH \"$name\"\n";

	for my $key (@keys) {
		my $val = $hash->{$key};

		my $ekey = __Escape($key);
		print "\tKEY \"$ekey\" ";

		if(!defined $val) {
			print "UNDEFINED\n";
		} elsif(!ref $val) {
			# Scalars can be saved directly
			print "SCALAR \"" . __Escape($val) . "\"\n";
		} elsif(ref $val eq 'HASH') {
			if(exists $saved->{$val}) {
				# It's already saved; make the reference point to that
				print "HASHREF \"$saved->{$val}\"\n";
			} else {
				# It's not saved; name it and make note that it needs to be
				print "HASHREF \"${name}_${ekey}\"\n";
				$refs{$val} = [$val, "${name}_${ekey}"];
			}
		} elsif(ref $val eq 'ARRAY') {
			if(exists $saved->{$val}) {
				print "LISTREF \"$saved->{$val}\"\n";
			} else {
				print "LISTREF \"${name}_${ekey}\"\n";
				$refs{$val} = [$val, "${name}_${ekey}"];
			}
		} else {
			print STDERR "Ignoring $key in $name hash with type " . ref($val) .
				"\n";
			print "\n";
			$success = 0;
			$msg = "Some items ignored.";
		}
	}

	# Complete writing this hash before attempting to save any more
	print "END \"$name\"\n\n";
	$saved->{$hash} = $name;

	# Check for new references that appeared in this hash
	for my $key (keys %refs) {
		my $obj = $refs{$key}->[0];
		my $objname = $refs{$key}->[1];

		# We already know $saved->{$obj} does not exist, because things only
		# appear in %refs if that is the case.
		if(ref $obj eq 'HASH') {
			($subsuccess, $submsg) = __SaveHash($objname, $obj, $saved);
		} elsif(ref $obj eq 'ARRAY') {
			($subsuccess, $submsg) = __SaveList($objname, $obj, $saved);
		}
		# else: nothing can get here, because $obj is only in %refs if its type
		# was valid above.

		if($subsuccess == 0 && !defined($msg)) { # I don't like this at all.
			($success, $msg) = ($subsuccess, $submsg);
		}
	}

	return ($success, $msg);
}

# Save a single list to a file (which must be select()'ed) {{{2
sub __SaveList {
	my ($name, $list, $saved) = @_;
	my ($eid, %refs, $success, $msg, $subsuccess, $submsg);

	%refs = ();
	$success = 1;

	print "LIST \"$name\"\n";

	$eid = 0;
	for my $elt (@{$list}) {
		print "\t";
		if(!defined $elt) {
			print "UNDEFINED\n";
		} elsif(!ref $elt) {
			# Scalars can be saved directly
			print "SCALAR \"" . __Escape($elt) . "\"\n";
		} elsif(ref $elt eq 'HASH') {
			if(exists $saved->{$elt}) {
				# It's already saved; make the reference point to that
				print "HASHREF \"$saved->{$elt}\"\n";
			} else {
				# It's not saved; name it and make note that it needs to be
				print "HASHREF \"${name}_${eid}\"\n";
				$refs{$elt} = [$elt, "${name}_${eid}"];
			}
		} elsif(ref $elt eq 'ARRAY') {
			if(exists $saved->{$elt}) {
				print "LISTREF \"$saved->{$elt}\"\n";
			} else {
				print "LISTREF \"${name}_${eid}\"\n";
				$refs{$elt} = [$elt, "${name}_${eid}"];
			}
		} else {
			print STDERR "Ignoring " . $eid + 1 .
				"th element in $name list with type " .  ref($elt) . "\n";
			print "\n";
			$success = 0;
			$msg = "Some items ignored.";
		}

		$eid++;
	}

	# Complete writing this hash before attempting to save any more
	print "END \"$name\"\n\n";
	$saved->{$list} = $name;

	# Check for new references that appeared in this hash
	for my $key (keys %refs) {
		my $obj = $refs{$key}->[0];
		my $objname = $refs{$key}->[1];

		# We already know $saved->{$obj} does not exist, because things only
		# appear in %refs if that is the case.
		if(ref $obj eq 'HASH') {
			($subsuccess, $submsg) = __SaveHash($objname, $obj, $saved);
		} elsif(ref $obj eq 'ARRAY') {
			($subsuccess, $submsg) = __SaveList($objname, $obj, $saved);
		}
		# else: nothing can get here, because $obj is only in %refs if its type
		# was valid above.

		if($subsuccess == 0 && !defined($msg)) {
			($success, $msg) = ($subsuccess, $submsg);
		}
	}

	return $success;
}

# Get a listing of directory entries {{{2
sub DirList {
	my ($in_dotdir, $name) = @_;
	$name = __NameTranslate($in_dotdir, $name);

	my (@list);

	opendir(ACCTDIR, $name);
	@list = grep { !m/^\./ } readdir ACCTDIR;
	closedir ACCTDIR;

	return @list;
}

# Find a temporary directory {{{2
sub FindTempDir {
	my (@tmpdirs) = ($SCLJ::DOTDIR, @ENV{qw(TMPDIR TEMPDIR TEMP)},
		qw(/tmp /var/tmp /usr/tmp .)); # '.' ensures we always get something
	for my $dir (@tmpdirs) {
		return $dir if defined $dir && length($dir) && -e $dir;
	}
}

# Translate the dotdir flag and filename combo {{{2
sub __NameTranslate {
	my ($in_dotdir, $name) = @_;

	return (($in_dotdir == 1) ? "$SCLJ::DOTDIR/$name" : $name);
}

# Un-backslash-escape a string read from a file. {{{2
sub __UnEscape {
	my ($str) = @_;
	$str =~ s/\\(.)/$1/g;
	return $str;
}

# Backslash-escape a string to be written to a file. {{{2
sub __Escape {
	my ($str) = @_;
	$str =~ s/([\\"])/\\$1/g;
	return $str;
}

### Core functions, not part of any specific subsystem {{{1
package SCLJ::Core;
# Print usage message. {{{2
sub PrintUsage {
	# my () = @_;
	my ($base, $defcols, $dir, $editor);
	$defcols = $SCLJ::Defaults{'columns'};
	$dir = $SCLJ::Defaults{'dir'};
	$editor = $SCLJ::Defaults{'editor'};

	$base = $0;
	$base =~ s#^.+/##;

	print <<EOF;
Sapphire Cat's LiveJournal.com Update Client, version $SCLJ::VERSION
Usage:
  $base [+/-q] [-d <dir>] [-t <tmpdir>] [-e <editor>] [-w <columns>]
      [-p <proxy>:<port>]
Supported options:
  -q  quit after posting instead of returning to the main menu.
  -d  get data from <dir> instead of $dir
  -t  place temporary event file in <tmpdir> instead of $dir
  -e  use <editor> for editing event instead of $editor
  -w  assume screen is <columns> columns wide instead of $defcols
  -p  use <proxy> and <port> for the proxy
The sense of a +/- option may be changed by replacing - with +; e.g. +q will
prevent quitting after posting.
EOF
	exit 3; # help given
}

# Encrypt a password, if MD5 is available {{{2
sub CryptPass {
	my ($pass) = @_;

	if($SCLJ::has_D_MD5) {
		$pass = SCLJ::md5_hex($pass);
	}

	return ($pass, $SCLJ::has_D_MD5);
}

# Create a new post, reflecting the user's default settings {{{2
sub LoadPostDefaults {
	my ($postr) = @_;
	my ($success, $msg, $userdef, %post, $i, $event);

	($success, $msg, $userdef) = SCLJ::IO::HashLoad(1, "post_defaults");
	# If the file doesn't exist, HashLoad returns -1, just for this.
	if($success == 0) {
		return (0, $msg);
	}

	# Fill the post with sclj's defaults
	$post{'format'} = 'p';
	$post{'comments'} = $post{'emails'} = 1;
	$post{'backdate'} = $post{'moodid'} = $post{'allowmask'} = 0;
	$post{'journal'} = $post{'picture'} = $post{'subject'} = $post{'music'} =
		$post{'moodtxt'} = $post{'screen'} = '';
	$post{'date'} = [ () ];
	$post{'time'} = [ () ];
	$post{'event'} = [ () ];
	$post{'security'} = 'public';

	for $i (keys %{$userdef}) {
		$post{$i} = $userdef->{$i}; # Copy the user's defaults over sclj's
	}

	$$postr = \%post;
	return (1, undef);
}

# Handle loading in the account's user and server information {{{2
sub SetAccount {
	my ($post, $acctname) = @_;
	my ($success, $msg, $acct, $serv);

	($success, $msg, $acct) = SCLJ::IO::HashLoad(1, "accounts/$acctname");
	if($success != 1) { return (0, $msg); }

	($success, $msg, $serv) = SCLJ::IO::HashLoad(1, "servers/$acct->{'serva'}");
	if($success != 1) { return (0, $msg); }

	$acct->{'serv'} = $serv;
	$post->{'acct'} = $acct;
	return (1, undef);
}

# Merge multiple hashes together, without overwriting keys {{{2
sub HashMerge {
	my (%result);
	for my $hash (@_) {
		for my $key (keys %$hash) {
			$result{$key} = $hash->{$key} unless exists $result{$key};
		}
	}
	return \%result;
}

# Generate a string of random characters {{{2
sub RandomChars {
	my ($num) = @_;
	my ($source, $dest);

	$source =
		'0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-_';
	$dest = '';

	while($num > 0) {
		$dest .= substr($source, int(rand(length($source))), 1);
	} continue {
		$num--;
	}

	return $dest;
}

### File backend {{{1
package SCLJ::File;
# Read a file and build a post from it {{{2
sub Load {
	my ($filename) = @_;
	
	return SCLJ::IO::HashLoad(0, $filename);
}

# Write a post out to a file {{{2
sub Save {
	my ($filename, $post) = @_;
	my (%fhash, $key);

	%fhash = %{$post};

	# Caches -- must be refilled by logging in to change associated values
	#delete $fhash{'acct'}->{'serv'}->{'moods'}; # This one's big
	#$fhash{'acct'}->{'serv'}->{'maxmood'} = 0; # Mark cache empty
	# I'll leave frgrps, journals, and userpics in unless someone complains.

	# Honor paranoia
	if($fhash{'acct'}->{'paranoid'} == 1) {
		delete $fhash{'acct'}->{'pass'};
		delete $fhash{'acct'}->{'crypt_pass'};
	}

	return SCLJ::IO::HashSave(0, $filename, \%fhash);
}

### Web backend {{{1
package SCLJ::Web;
# Get login information from the server {{{2
sub Login {
	my ($acct, $ua, $authmode) = @_;
	my (%webvars, %response, %result, $i, $grpnum, $serv, $ok, $msg);

	$serv = $acct->{'serv'};

	# Build the request {{{3
	$webvars{'mode'} = 'login';
	($ok, $msg) = __SetAuthentication($acct, \%webvars, $ua, $authmode);
	if($ok != 1) {
		return { 'success' => 'FAIL', 'errmsg' => $msg };
	}
	$webvars{'clientversion'} = "Perl-SC/$SCLJ::VERSION";
	$webvars{'getmoods'} = $serv->{'maxmood'}; # Request mood IDs
	$webvars{'getpickws'} = 1; # Request picture keywords
	#$webvars{'ver'} = 1; # UTF-8 text coding, not supported by sclj

	# Make the request (and handle failure) {{{3
	%response = SCLJ::Net::Post($ua, $acct->{'fast'}, $serv, \%webvars);
	if($response{'success'} ne "OK") {
		return {
			'success' => 'FAIL',
			'errmsg' => $response{'errmsg'}
		};
	}

	# Parsing: moods {{{3
	if(defined($response{'mood_count'})) {
		$result{'moods'} = $response{'mood_count'};
		for $i (1..$response{'mood_count'}) {
			# Store each mood and ID; looking up the name later will give us ID
			$serv->{'moods'}->{$response{"mood_${i}_name"}} =
				$response{"mood_${i}_id"};
			# Update our max mood number if necessary
			if($serv->{'maxmood'} < $response{"mood_${i}_id"}) {
				$serv->{'maxmood'} = $response{"mood_${i}_id"};
			}
		}
	}

	# Parsing: shared journals {{{3
	if(defined($response{'access_count'})) {
		$result{'journals'} = $response{'access_count'};
		@{$acct->{'journals'}} = ();
		for $i (1..$response{'access_count'}) {
			push(@{$acct->{'journals'}}, $response{"access_${i}"});
		}
	}

	# Parsing: picture keywords {{{3
	if(defined($response{'pickw_count'})) {
		$result{'picture keywords'} = $response{'pickw_count'};
		@{$acct->{'pics'}} = ();
		for $i (1..$response{'pickw_count'}) {
			push(@{$acct->{'pics'}}, $response{"pickw_${i}"});
		}
	}

	# Parsing: friend groups {{{3
	if(defined($response{'frgrp_maxnum'})) {
		$grpnum = 0;
		%{$acct->{'frgrps'}} = ();
		for $i (1..$response{'frgrp_maxnum'}) {
			if(defined($response{"frgrp_${i}_name"})) {
				$acct->{'frgrps'}->{"$i"} = $response{"frgrp_${i}_name"};
				$grpnum++;
			}
		}
		$result{'friend groups'} = $grpnum;
	}

	# Parsing: fast server cookie {{{3
	if(defined($response{'fastserver'}) && $response{'fastserver'} == 1) {
		$result{'server access'} = 'fast'; # Ugly hack for the UI.
		$acct->{'fast'} = 1;
	} else {
		$acct->{'fast'} = 0;
	}

	# Parsing: server message {{{3
	if(defined($response{'message'})) {
		$result{'message'} = $response{'message'};
	}

	# Return the results {{{3
	$result{'success'} = $response{'success'};
	return \%result;
}

# Send a post to the server {{{2
# This function knows the LJ postevent protocol.
sub Post {
	my ($post, $ua, $authmode) = @_;
	my (%webvars, $acct, $serv, $min, $hour, $mday, $mon, $year, $ok, $msg);

	$acct = $post->{'acct'};
	$serv = $acct->{'serv'};

	if($#{$post->{'event'}} == -1) {
		return (
			"success" => "FAIL",
			"errmsg" => "No event data."
		);
	}

	$webvars{"mode"} = "postevent";
	($ok, $msg) = __SetAuthentication($acct, \%webvars, $ua, $authmode);
	if($ok != 1) {
		return ( 'success' => 'FAIL', 'errmsg' => $msg );
	}

	# Date it now, then adjust it if there's a date/time in the post. {{{3
	(undef, $min, $hour, $mday, $mon, $year) = localtime(time);
	$year += 1900;
	$mon  += 1; # LJ protocol adjustment
	# Use the post's date/time if it has one.
	if($#{$post->{"date"}} >= 2) {
		$year = $post->{"date"}->[0];
		$mon  = $post->{"date"}->[1];
		$mday = $post->{"date"}->[2];
	}
	if($#{$post->{"time"}} >= 1) {
		$hour = $post->{"time"}->[0];
		$min  = $post->{"time"}->[1];
	}
	# Format time fields and put them in the corresponding webvars
	$webvars{"year"} = $year;
	$webvars{"mon"} = sprintf("%02d", $mon);
	$webvars{"day"} = sprintf("%02d", $mday);
	$webvars{"hour"} = sprintf("%02d", $hour);
	$webvars{"min"} = sprintf("%02d", $min);

	# Set prop_opt_* flags {{{3
	if($post->{"backdate"} == 1) {
		$webvars{"prop_opt_backdated"} = 1;
	}
	if($post->{"emails"} == 0) {
		$webvars{"prop_opt_noemail"} = 1;
	}
	if($post->{"comments"} == 0) {
		$webvars{"prop_opt_nocomments"} = 1;
	}
	if($post->{"format"} ne 's') { # To the server, p-formatting is unformatted
		$webvars{"prop_opt_preformatted"} = 1;
	}
	if($post->{"screen"} ne '') {
		$webvars{"prop_opt_screening"} = $post->{"screen"};
		$webvars{"prop_opt_screening"} =~ tr/naoe/NRFA/;
	}

	# Set prop_current_* fields {{{3
	if($post->{"moodid"} > 0) {
		$webvars{"prop_current_moodid"} = $post->{"moodid"};
	} elsif(length($post->{"moodtxt"}) > 0) {
		$webvars{"prop_current_mood"} = $post->{"moodtxt"};
	}

	if(length($post->{"music"}) > 0) {
		$webvars{"prop_current_music"} = $post->{"music"};
	}

	# Set the subject {{{3
	if(length($post->{"subject"}) > 0) {
		$webvars{"subject"} = $post->{"subject"};
	}

	# Set the security level {{{3
	if(length($post->{"security"}) == 0 || $post->{"security"} eq 'public') {
		$webvars{"security"} = 'public';
	} elsif($post->{"security"} eq 'private') {
		$webvars{"security"} = 'private';
	} else { # friends || custom
		$webvars{"security"} = 'usemask';
		$webvars{"allowmask"} = $post->{"allowmask"};
	}

	# Set journal and userpic {{{3
	if(length($post->{"journal"}) > 0) {
		if(exists $webvars{'prop_opt_backdated'}) {
			# Backdated posts to communities will fail, so we silently unbackdate
			# them here.
			delete $webvars{'prop_opt_backdated'};
		}
		$webvars{"usejournal"} = $post->{"journal"};
	}
	if(length($post->{"picture"}) > 0) {
		$webvars{"prop_picture_keyword"} = $post->{"picture"};
	}

	# Format the event and put it in the webvars {{{3
	if($post->{"format"} eq 'p') { # Blank lines to paragraphs
		$webvars{"event"} = __ParagraphFormat($post->{"event"});
	} elsif($post->{"format"} eq 't') { # Textile formatting
		if(!$SCLJ::has_Textile) {
			# Oh no! Textile isn't available on this setup...
			return ( 'success' => 'FAIL', 'errmsg' =>
					"Couldn't perform Textile formatting; the module wasn't found." );
		} else {
			my $txtl = new Text::Textile;
			$txtl->{line_open} = '';
			$txtl->{line_close} = '';
			$webvars{"event"} = $txtl->process(join("\n", @{$post->{"event"}}));
		}
	} else { # Not formatted by us
		$webvars{"event"} = join("\n", @{$post->{"event"}});
	}

	# Send it off {{{3
	return (SCLJ::Net::Post($ua, $acct->{'fast'}, $serv, \%webvars));
}

# Retrieve an entry and build a post from it RFE:EDITEVENT {{{2
sub GetPost {
	# Once the event is selected, this grabs the whole thing
}

# Retrieve a set of entries into an array RFE:EDITEVENT {{{2
sub GetEntryList {
	# This part is the backend for selecting which post to edit
}

# Fill in fields for authentication {{{2
sub __SetAuthentication {
	my ($acct, $wvars, $ua, $authmode) = @_;

	if(!exists $acct->{"pass"}) {
		return (0, "Password hasn't been entered yet.");
	}

	$authmode = lc $authmode;
	if($authmode eq 'plain') {
		return __SetAuthPlain($acct, $wvars);
	} elsif($authmode eq 'challenge') {
		if($SCLJ::has_D_MD5) {
			return __SetAuthChallenge($acct, $wvars, $ua);
		} else {
			return (0, "Challenge/response authentication needs Digest::MD5");
		}
	} else {
		return (0, "Unknown authmode ($authmode)");
	}

}

# Fill authentication fields for plain login {{{2
sub __SetAuthPlain {
	my ($acct, $wvars) = @_;

	$wvars->{"user"} = $acct->{"user"};
	if($acct->{"crypt_pass"} == 1) {
		$wvars->{"hpassword"} = $acct->{"pass"};
	} else {
		$wvars->{"password"} = $acct->{"pass"};
	}

	return (1, undef);
}

# Fill authentication fields for challenge/response {{{2
sub __SetAuthChallenge {
	my ($acct, $wvars, $ua) = @_;
	my (%challreq, $serv, %response, $challresp, $md5pass);

	$serv = $acct->{'serv'};
	$challreq{'mode'} = 'getchallenge';

	%response = SCLJ::Net::Post($ua, $acct->{'fast'}, $serv, \%challreq);
	if($response{'success'} ne "OK") {
		return (0, "Can't get challenge: " . $response{'errmsg'});
	}

	$md5pass = $acct->{'pass'};
	if($acct->{'crypt_pass'} == 0) {
		$md5pass = SCLJ::md5_hex($md5pass);
	}

	$challresp = SCLJ::md5_hex($response{'challenge'} . $md5pass);

	$wvars->{'user'} = $acct->{'user'};
	$wvars->{'auth_method'} = 'challenge';
	$wvars->{'auth_challenge'} = $response{'challenge'};
	$wvars->{'auth_response'} = $challresp;

	return (1, undef);
}

# Do paragraph formatting of the event {{{2
# XHTML 1.0 compliant, and doesn't mess with things inside <pre> tags.
sub __ParagraphFormat {
	my ($linearr) = @_;
	my ($line, $outside_pre, @matches, $result);

	$outside_pre = 1;
	$result = '<p>';
	for $line (@{$linearr}) {
		# If there are any <pre> or </pre> tags on this line
		if(@matches = ($line =~ m#</?pre[\s>]#ig)) {
			# Examine the last one to figure out whether we're in or out of them
			if($matches[$#matches] =~ m#</pre[\s>]#i) {
				$outside_pre = 1;
			} else {
				$outside_pre = 0;
			}
		}
		if($outside_pre) {
			$result .= (($line =~ /^$/) ? "</p><p>" : $line);
		} else {
			$result .= $line;
		}
		$result .= "\n"; # Restore trailing newlines
	}
	$result .= "</p>\n";

	return ($result);
}

### Networking {{{1
package SCLJ::Net;
# Initialize an HTTP user agent {{{2
sub MakeAgent {
		my ($timeout) = @_;
    my $ua = new LWP::UserAgent;
    $ua->agent("PerlSCLiveJournalClient/$SCLJ::VERSION");
    $ua->timeout($timeout);
    return $ua;
}

# Make a request of the server {{{2
sub Post {
	my ($ua, $usefast, $serv, $vars) = @_;
	my %ljres = ();

	# Create a request
	my $req = new HTTP::Request
		POST => "http://$serv->{'host'}:$serv->{'port'}$serv->{'path'}";
	$req->content_type('application/x-www-form-urlencoded');
	if($usefast) { $req->push_header('Cookie' => 'ljfastserver=1'); }
	$req->content(__Escape($vars));

	# Pass request to the user agent and get a response back
	my $res = $ua->request($req);

	# Check the outcome of the response
	if ($res->is_success) {
		%ljres = split(/\n/, $res->content);
		if(0) {
			print STDERR "LJ answered:\n";
			for (keys %ljres) {
				print STDERR "$_ => $ljres{$_}\n";
			}
			print STDERR "End reply.\n";
		}
	} else {
		$ljres{'success'} = "FAIL";
		$ljres{'errmsg'} = "Server is not responding. Try again later.";
	}
	return %ljres;
}

# Escape the POST data {{{2
sub __Escape {
	my ($vars) = shift;
	my $req = "";
	foreach (sort keys %{$vars}) {
		my $val = URI::Escape::uri_escape($vars->{$_},"\+\=\&");
		$val =~ s/ /+/g;
		$req .= "&" if $req;
		$req .= "$_=$val";
	}
	return $req;
}

# Vim editor settings {{{1
# vim:ts=2:sw=2:tw=78:ai:si:sm:nocin:noet
# vim600:fdm=marker
