#!/usr/bin/env perl
# -*-perl-*-
# Header comments and licensing info {{{1
#
# LiveJournal Client Account and Options Management
# (see also "sclj" and "http://www.livejournal.com/")
#
# This version by:
# C. A. "Sapphire Cat" Daelhousen
# http://www.livejournal.com/community/sclj
# $Id: scljed,v 1.5 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
#

# Pragmas (pragmae?) {{{1
use 5.005; # As required by sclj (due to LWP)
#eval "use warnings" if($^V && $^V >= 5.006);
# XXX: Do we need anything else?

# Config, the global configuration singleton {{{1
package SCLJ::Config;
my %config = ( # Defaults {{{2
	'path' => "$ENV{'HOME'}/.sclj3",
	'host' => 'www.livejournal.com',
	'port' => '80',
	'uri'  => '/interface/flat'
);

sub val { # (var, [newval]) - get/set var; return old val on set {{{2
	my $ret = undef;

	if(defined $_[1]) {
		$ret = (exists $config{$_[1]} ? $config{$_[1]} : undef);
		if(defined $_[2]) {
			$config{$_[1]} = $_[2];
		}
	}

	return $ret;
}

sub path_prepend { # (file) - return "path/file" {{{2
	defined $_[1] && defined $config{'path'} ? "$config{'path'}/$_[1]" : undef;
}

sub parse_opts { # (options) - parse command-line options {{{2
	my ($class, $opts) = @_;
	my ($i, $opt, $letter, $optok, $what, @expected, @ignored);

	$optok = 1;
	@ignored = ();
	for $i (0..$#{$opts}) {
		$opt = $opts->[$i];

		if($optok && $opt =~ /^-.+/) {
			# We don't have anything that needs this yet.
			# do { $optok = 0; next } if $opt eq '--';
			$opt =~ s/^-//;
			for $letter (split(//, $opt)) {
				if($letter =~ /-/) { # Catch '--help' gracefully
					$class->usage("Long options aren't supported.");
				} elsif($letter =~ /d/) {
					push(@expected, 'path');
				} else {
					push(@ignored, "-$letter");
				}
			}
		} elsif($optok && $opt =~ /^\+.+/) {
			$opt =~ s/^\+//;
			for $letter (split(//, $opt)) {
				push(@ignored, "+$letter");
			}
		} elsif($optok && $#expected >= 0) {
			$what = shift(@expected);
			$class->val($what, $opt);
		# We don't support any non-options yet, so we don't need to care about
		# !$optok. So just ignore it for now.
		#} else {
			#$class->usage("Foo");
		}

		# Didn't find something expected. This is why we don't just do
		# for(@{$opts}).
		if($i == $#{$opts} && $#expected >= 0) {
			$class->usage("Not enough arguments found to go with the options.");
		}
	}

	if($#ignored >= 0) {
		print "Warning: unrecognized options ignored: " .
			join(' ', @ignored) . "\n";
	}
}

sub usage { # ([msg]) - print usage because of msg {{{2
	my ($class, $msg) = @_;
	my ($base);

	$base = $0;
	$base =~ s#^.*/##;
	
	if(defined $msg) {
		print "$msg\n\n";
	}

	print <<ENDUSAGE;
Usage: $base [-d <directory>]

Options:
  -d\tWork with <directory> instead of \$HOME/.sclj3

Note: "-dfoo" is equivalent to "-d -f -o -o", not "-d foo".
ENDUSAGE

	exit 1;
}

# File, and the data within it {{{1
package SCLJ::File;

sub new { # ([path], name) - Constructor {{{2
	my ($class, $path, $name) = @_;
	my $self = {};

	return undef if ref $class;

	# Argument munging
	return undef unless defined $path;
	do { $name = $path, $path = $class->default_path } unless defined $name;

	# There's nothing stopping $name from containing path components; $path is
	# just the path to the base dir, then things like accounts/foo can appear
	# beneath it.
	$self->{'path'} = $path;
	$self->{'name'} = $name;
	$self->{'err'} = undef;

	bless $self, $class;
}

# Accessors {{{2
sub default_path { SCLJ::Config->val('path') } # () {{{3

sub filename { # () {{{3
	return undef unless ref $_[0];
	"$_[0]->{'path'}/$_[0]->{'name'}";
}

sub get { # (value) {{{3
	return undef unless ref $_[0];
	(exists $_[0]->{'data'}->{$_[1]} ? $_[0]->{'data'}->{$_[1]} : undef);
}

sub error { # () - Return error message {{{3
	return unless ref $_[0];
	$_[0]->{'err'};
}

sub save { # () - Save values from a hash to a file (unsorted.) {{{3
	my ($class) = @_;

	return unless ref $class && !defined $class->error;

	if(!open(FILE, '>' . $class->filename)) {
		$class->{'err'} = $!;
		return undef;
	}

	print FILE "# sclj data file v2\n".
		"# quotes required; \\\\ and \\\" recognized.\n\n";
	$class = $class->__SaveHash($class->__Escape("root"), $class->{'data'}, { },
		\*FILE);

	close FILE;

	return $class;
}

# Save a single hash to a file {{{4
sub __SaveHash {
	my ($class, $name, $hash, $saved, $file) = @_;
	my (@keys, %refs);

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

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

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

		my $ekey = $class->__Escape($key);
		print $file "\tKEY \"$ekey\" ";

		if(!defined $val) {
			print $file "UNDEFINED\n";
		} elsif(!ref $val) {
			# Scalars can be saved directly
			print $file "SCALAR \"" . $class->__Escape($val) . "\"\n";
		} elsif(ref $val eq 'HASH') {
			if(exists $saved->{$val}) {
				# It's already saved; make the reference point to that
				print $file "HASHREF \"$saved->{$val}\"\n";
			} else {
				# It's not saved; name it and make note that it needs to be
				print $file "HASHREF \"${name}_${ekey}\"\n";
				$refs{$val} = [$val, "${name}_${ekey}"];
			}
		} elsif(ref $val eq 'ARRAY') {
			if(exists $saved->{$val}) {
				print $file "LISTREF \"$saved->{$val}\"\n";
			} else {
				print $file "LISTREF \"${name}_${ekey}\"\n";
				$refs{$val} = [$val, "${name}_${ekey}"];
			}
		}
	}

	# Complete writing this hash before attempting to save any more
	print $file "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') {
			$class->__SaveHash($objname, $obj, $saved, $file);
		} elsif(ref $obj eq 'ARRAY') {
			$class->__SaveList($objname, $obj, $saved, $file);
		}
		# else: nothing can get here, because $obj is only in %refs if its type
		# was valid above.
	}

	return $class;
}

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

	%refs = ();

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

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

		$eid++;
	}

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

	# Check for new references that appeared in this list
	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') {
			$class->__SaveHash($objname, $obj, $saved, $file);
		} elsif(ref $obj eq 'ARRAY') {
			$class->__SaveList($objname, $obj, $saved, $file);
		}
		# else: nothing can get here, because $obj is only in %refs if its type
		# was valid above.
	}

	return $class;
}

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

# Mutators {{{2
sub set { # (value, to) - Set value to to {{{3
	return unless ref $_[0] && defined $_[1] && !ref $_[1];
	$_[0]->{'data'}->{$_[1]} = $_[2];
	return $_[0];
}

sub unset { # (value) - Forget about value {{{3
	return undef unless ref $_[0] && exists $_[0]->{'data'}->{$_[1]};
	delete $_[0]->{'data'}->{$_[1]};
	return $_[0];
}

sub clearerr { # () - Remove error status {{{3
	return unless ref $_[0];
	$_[0]->{'err'} = undef;
	return $_[0];
}

sub rename { # (newname) - Change filename {{{3
	return unless ref $_[0];
	$_[0]->{'name'} = $_[1] if defined $_[1] && !ref $_[1];
	return $_[0];
}

sub load { # () - Load a hash with values from a file {{{3
	my ($class) = @_;
	my ($quoteparse, $structname, $struct, $nextloc, %structs, %waiters, $in,
		$which);

	return undef unless ref $class && !defined $class->error;

	if(!-e $class->filename) {
		if(!open(FILE, '>' . $class->filename)) {
			$class->{'err'} = $!;
			return undef;
		}
		close FILE;
		$class->{'data'} = {};
		return $class;
	} elsif(!open(FILE, '<' . $class->filename)) {
		$class->{'err'} = $!;
		$class->{'data'} = {};
		return 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*};

	$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) { # outside structure
			if(/\G(HASH|LIST)\s+$quoteparse/gc) {
				$structname = $class->__UnEscape($2);

				$in = $1;
				if($in eq 'HASH') {
					$struct = { };
				} else { # $which eq 'LIST' because of the pattern match
					$struct = [ ];
				}
			}
		} else { # inside structure
			if(/\GEND\s+$quoteparse/gc) { # Leaving structure
				#my $ending = $class->__UnEscape($1);
				# We assume END is always well-formed in here...

				$which = $in;

				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 = $class->__UnEscape($1);
					$struct->{$key} = undef;
					$nextloc = \$struct->{$key};
				} else {
					next LINE;
				}
			} elsif($in eq 'LIST') { # List item
				my $index = $#{$struct};
				$struct->[$index+1] = undef;
				$nextloc = \$struct->[$index+1];
			} else { # In neither hash nor list!
				die "Hash loading detected impossible state";
			}

			# 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 = $class->__UnEscape($1);
				$$nextloc = $val;
			} elsif(/\G(LIST|HASH)REF\s+$quoteparse/gc) {
				# Some sort of structure...
				my $name = $class->__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 ];
					$$nextloc = undef; # In case it's never defined
				}
			}
		} # if(outside structure)
	} # LINE

	close FILE;

	$class->{'data'} = $structs{'HASH'}->{'root'};
	return $class;
}

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

# Term, an object abstracting the terminal {{{1
package SCLJ::Term;
sub ReadLine { # () {{{2
	my $line = <STDIN>;
	$line = '' unless defined $line;
	chomp $line;
	return $line;
}

# Configurable, a standard way to set options {{{1
package SCLJ::Configurable;
# Constants {{{2
use constant BOOLEAN => 0;
use constant INTEGER => 1;
use constant STRING => 2;
use constant ARRAY => 3;
use constant COMPLIST => 4;
use constant BOOLEAN_REV => 5; # boolean reversed, so "yes" = 0

sub set { # {{{2
	return undef unless ref $_[1] eq 'ARRAY';
	my $arg = $_[1];
	my $optname = shift @{$arg};
	my $opttype = shift @{$arg};
	my $input;
	$input = $_[2] if defined $_[2];
	my @ret = ($optname);

	if($opttype == BOOLEAN || $opttype == BOOLEAN_REV) { # {{{3
		while((!defined $input) ||
			(length $input && $input !~ /^y/i && $input !~ /^n/i))
		{
			print "y/n? ";
			$input = SCLJ::Term->ReadLine();
		}
		if($input =~ /^y/i) {
			push @ret, ($opttype == BOOLEAN ? 1 : 0);
		} elsif($input =~ /^n/i) {
			push @ret, ($opttype == BOOLEAN ? 0 : 1);
		}
	} elsif($opttype == INTEGER) { # {{{3
		while((!defined $input) ||
			(length $input && ($input =~ /\D/ || $input < 1)))
		{
			print "number: ";
			$input = SCLJ::Term->ReadLine;
		}
		push @ret, $input;
	} elsif($opttype == STRING) { # {{{3
		if(!defined $input) {
			print "string: ";
			$input = SCLJ::Term->ReadLine;
		}
		push @ret, $input;
	} elsif($opttype == ARRAY) { # {{{3
		my $array = shift @{$arg};
		my $default = shift @{$arg};

		return undef unless ref $array eq 'ARRAY' && ($#{$array} % 2) == 1;
		if(defined $default) {
			# Bend over backwards to print the name of the default rather than its
			# value in the menu item.
			unshift (@{$array}, $default); # First goes the default
			# $index starts at 2 because we just unshift'ed into 0.
			for (my $index = 2; $index <= $#{$array}; $index += 2) {
				do { unshift (@{$array}, "Default ($array->[$index - 1])"), last } if
					$default eq $array->[$index]; # Then the name
			}
		}

		my $menu = SCLJ::Menu->new($array);
		return unless defined $menu;
		($input, undef) = $menu->choose($input);
		push(@ret, $input);
	} elsif($opttype == COMPLIST) { # {{{3
		my $prompt = shift @{$arg};
		my $choices = shift @{$arg};
		return unless ref $choices;

		if(defined $input) {
			($val, $status) = $choices->complete($input);
		}

		while(!defined $val && $status == 0) {
			print "$prompt: ";
			$input = SCLJ::Term->ReadLine;
			return unless length $input;
			($val, $status) = $choices->complete($input);
		}
		return unless defined $val;
		push @ret, $val;
	} else { # {{{3
		warn "$opttype not an option type (name $optname)";
		@ret = (undef, undef);
	}

	return undef unless defined $ret[1] &&
		(length $ret[1] || $opttype == STRING);
	return @ret;
}

# Completable, a list of completable things {{{1
package SCLJ::Completable;

sub new { # (listref) - Constructor; possible choices in listref {{{2
	my $class = shift;
	my $array = shift;
	my $self = {};

	return undef unless ref $array eq 'ARRAY' && !ref $class;
	$self->{'items'} = $array;
	bless $self, $class;
}

sub complete { # (prefix) - Complete the prefix {{{2
	my ($class, $prefix) = @_;
	my (@completed, @tok_in, @tok_item, $tok_match, $tail, $index);

	return undef unless ref $class && (!ref $prefix) && length $prefix;

	# New completion algorithm to support completion even with arguments.
	# This should successfully consider "green chicken" to be ambiguous when
	# both "green" and "green chicken" are items.

	# Tokenize the incoming data {{{3
	@tok_in = split(/\s+/, $prefix);
	# For each item in the list
	for my $item (@{$class->{'items'}}) {
		# Shortcut main body if it's obviously not going to match at all
		next unless $item =~ /^\Q$tok_in[0]/i;
		# Tokenize the item
		@tok_item = split(/\s+/, $item);
		# Complete as many tokens as possible
		# We checked $tok_in[0] against $item above; the split pattern /\s+/
		# ensures that no space is in $tok_in[0], so it was effectively compared
		# against $tok_item[0], which matched and let us in here. So start at
		# $tok_in[1] and $tok_item[1]. This also assures $i > 0 in the pattern
		# match below.
		my $i = 1;
		# Don't compare off the end of an array
		my $shortest = ($#tok_item < $#tok_in ? $#tok_item : $#tok_in);
		# Do the actual completion
		while($i <= $shortest && $tok_item[$i] =~ /^\Q$tok_in[$i]/i) {
			$i++;
		}
		$tok_match = $i;
		# Put (incoming data - completed tokens) in the tail; it may be undef
		$tail = undef; # Clear out old tail
		$tail = $1 if $prefix =~ /(?:\S+\s+){${tok_match}}(.*)/;
		# Store item, tail, completed tokens, total tokens in completion list
		push(@completed, [$item, $tail, $tok_match, $#tok_item + 1]);
	# End for
	}

	# If multiple completions {{{3
	if($#completed > 0) {
		# Order candidates by completed/total token ratio
		@completed = sort { ($a->[2]/$a->[3]) <=> ($b->[2]/$b->[3]) } @completed;
		# Create menu of "item, arg tail" => [item, tail]
		print "Multiple completions; please choose one:\n";
		my $menuopts = ["None of these", undef];
		$index = 0;
		for my $item (@completed) {
			my $sel = $item->[0];
			$sel .= (defined $item->[1] ? ", arg $item->[1]" : ", no argument");
			push(@{$menuopts}, $sel, $index++);
		}
		# return menu choice
		my $menu = SCLJ::Menu->new($menuopts);
		# If it was ambiguous before, it's still ambiguous, so don't allow that.
		$menu->completable(0);
		($index, undef) = $menu->choose;
		return (undef, 1) unless defined $index;
	} elsif($#completed == 0) { # One completion
		$index = 0;
	} else { # No completion
		return (undef, 0);
	}

	return ($completed[$index]->[0], $completed[$index]->[1]);
}

# DirList, a completable list of directory entries {{{1
package SCLJ::DirList;
@ISA = qw(SCLJ::Completable);

sub new { # (dirname) - Create a list for dirname {{{2
	my $class = shift;
	my $dir = shift;
	my $fulldir;
	my $self = {};

	return undef unless((!ref $class) && (!ref $dir));
	$self->{'items'} = [];
	# I'm tired. Rather than track down where this is called from, I'm just
	# going to make this aware of absolute vs. relative path.
	if($dir !~ /^\//) {
		$fulldir = SCLJ::Config->path_prepend($dir);
	} else {
		$fulldir = $dir;
	}

	if(!-e $fulldir && !mkdir($fulldir, 0777)) {
		print "Can't create $fulldir: $!\n";
		return undef;
	} elsif(!-d $fulldir) {
		print "Can't create $fulldir: File exists\n";
		return undef;
	}

	$self->{'dir'} = $fulldir;
	$self->{'items'} = $class->readentries($fulldir);

	bless($self, $class);
}

sub length { # () - Return number of entries in dirlist {{{2
	(ref $_[0] ? $#{$_[0]->{'items'}} + 1 : -1);
}

sub solename { # () - Caller's responsibility to check length first {{{2
	return unless ref $_[0];
	return $_[0]->{'items'}->[0];
}

sub readentries { # ([dir]) - (Re)read directory list {{{2
	my $class = shift;
	my $dir;
	my @entries;

	if(ref $class) {
		$dir = $class->{'dir'};
	} else {
		($dir = shift) or return undef;
	}

	opendir(DIR, $dir);
	@entries = grep { !m/^\./ } readdir DIR;
	closedir DIR;

	if(ref $class) {
		$class->{'items'} = \@entries;
		return $class;
	} else {
		return \@entries;
	}
}

sub complete { # (prefix) - Refresh our dirlist before completion {{{2
	my $class = shift;
	return unless $class->readentries;
	$class->SUPER::complete(@_);
}

# Menu, to store and present completable choices {{{1
package SCLJ::Menu;
@ISA = qw(SCLJ::Completable);

sub new { # {{{2
	my ($class, $menu) = @_;
	my $self = {};

	die "Can't new an instance" if ref $class;
	return undef if ref $menu ne 'ARRAY' || ($#{$menu} % 2) != 1;

	# Has to be items for SUPER::complete()
	$self->{'items'} = [];
	$self->{'vals'} = [];
	while($#{$menu} > 0) {
		push(@{$self->{'items'}}, shift @{$menu});
		push(@{$self->{'vals'}}, shift @{$menu});
	}

	$self->{'complete'} = 1; # Complete by default

	bless $self, $class;
}

sub print { # {{{2
	my $self = shift;

	my $index = 0;
	for my $item (@{$self->{'items'}}) {
		print (++$index, ": $item\n");
	}
}

sub choose { # {{{2
	my ($self, $in) = @_;
	my ($index, $choice, $arg, $printed);

	if(!defined $in) {
		$self->print;
		$printed = 1;
	} else {
		$printed = 0;
	}

	while(!defined $choice) {
		if(defined $in) {
			$choice = $in;
			$in = undef; # Only consider the input once.
		} else {
			if($printed == 0) {
				$self->print;
				$printed = 1;
			}
			print "--> ";
			$choice = SCLJ::Term->ReadLine;
		}
		if($choice =~ /^\d+(?:\s|$)/) { # Is it an option number?
			($choice, $arg) = split(/\s+/, $choice, 2);
			if($choice <= 0 || $choice > $#{$self->{'vals'}} + 1) {
				print "$choice is not a menu item.\n";
				$choice = undef;
			} else {
				$choice--; # Convert to array index
			}
		} elsif($self->{'complete'} != 0) { # Assume it's an item name.
			# Generate error in case it's needed before stomping $choice.
			my $msg = "No completions for \"$choice\".\n";
			($choice, $arg) = $self->complete($choice);
			if(defined $choice) {
				# Convert it back to an index into our array, to map into vals later
				FOR: for $index (0..$#{$self->{'items'}}) {
					if($self->{'items'}[$index] eq $choice) {
						$choice = $index;
						last FOR;
					}
				}
			} elsif($arg==0) { # No completion (!defined $choice && $arg==0)
				print $msg;
			} else { # aborted multiple completions (!defined $choice && $arg==1)
				$self->print;
			}
		} else { # Not allowed to complete a name
			print "Can't complete in this menu.\n";
			$choice = undef;
		}
	} # while(!defined $choice)

	return ($self->{'vals'}->[$choice], $arg);
}

sub completable { # {{{2
	my $ret;

	if(ref $_[0]) {
		$ret = $_[0]->{'complete'};
		if(defined $_[1]) {
			$_[0]->{'complete'} = $_[1];
		}
	}

	return $ret;
}

# Editor, for changing modes and setting options {{{1
package SCLJ::Editor;
# Constants {{{2
# menuing
use constant SUBFUNC => 0;
use constant CONFIG => 1;
use constant RETURN => 2;
# configuration
# XXX: Isn't there some way to import these from above? 'use
# SCLJ::Configurable qw(...)' searches @INC for SCLJ/Configurable.pm...
use constant STRING => SCLJ::Configurable::STRING;
use constant INTEGER => SCLJ::Configurable::INTEGER;
use constant BOOLEAN => SCLJ::Configurable::BOOLEAN;
use constant BOOLEAN_REV => SCLJ::Configurable::BOOLEAN_REV;
use constant ARRAY => SCLJ::Configurable::ARRAY;
use constant COMPLIST => SCLJ::Configurable::COMPLIST;
# mkdirs
use constant FILE => 0;
use constant DIR => 1;

sub new { # () - Constructor {{{2
	my $class = shift;
	return undef if ref $class;
	my $self = {};
	
	$self->{'_files'} = {};
	$self->{'_dirs'} = {};
	$self->{'_currfile'} = undef;

	bless $self, $class;
}

sub start { # ([menu]) - Menu choice parsing {{{2
	my $class = shift;
	return undef unless ref $class;
	my $menu = shift;
	$menu = $class->mainmenu unless defined $menu;
	while(1) {
		my ($item, $arg) = $menu->choose;
		my (@items, $type);

		# $menu->choose gave us its own internal reference to the array, but we
		# want to modify it, so we have to copy it. I need a better design.
		for my $bit (@{$item}) {
			push(@items, $bit);
		}

		$type = shift @items;

		last if $type == RETURN;

		if($type == SUBFUNC) {
			my $subfunc = shift @items;
			$class->$subfunc(@items, $arg);
		} elsif($type == CONFIG) {
			my @cfg = SCLJ::Configurable->set(\@items, $arg);
			$class->currfile->set(@cfg)->save if @cfg;
		}
	}
}


sub addfile { # (name) - Add a SCLJ::File to the cache unless it's there {{{2
	my $file;
	return unless ref $_[0] && defined $_[1] && !ref $_[1];
	return unless $_[0]->mkdirs($_[1], FILE);

	if(!exists $_[0]->{'_files'}->{$_[1]}) {
		$file = SCLJ::File->new($_[1]);
		if(!defined $file->load) {
			warn "Couldn't load $_[1]: " . ($file->error || "nobody knows why");
		}
		$_[0]->{'_files'}->{$_[1]} = $file;
	} # else file exists, just return it.
	return $_[0]->{'_files'}->{$_[1]};
}

sub currfile { # ([file]) - Get/set a current file to work with {{{2
	return undef unless ref $_[0];
	return $_[0]->{'_currfile'} unless defined $_[1];
	$_[0]->{'_currfile'} = $_[1];
}

sub delfile { # (name) - Remove name from the cache {{{2
	return unless ref $_[0] && (!ref $_[1]) &&
		exists $_[0]->{'_files'}->{$_[1]};
	delete $_[0]->{'_files'}->{$_[1]};
}

sub mkdirs { # (name) - make any parent directories in name {{{2
	my (@parents, $subdir, $dir);

	# Immediately succeed if no dirs needed
	return 1 unless $_[1] =~ m#/# || $_[2] == DIR;

	@parents = split(/\/+/, $_[1]);
	pop(@parents) if $_[2] == FILE; # Get rid of the filename for files
	$subdir = SCLJ::Config->val('path');
	for $dir (@parents) {
		$subdir .= "/$dir";
		if(!-e $subdir && !mkdir($subdir, 0777)) {
			print "Couldn't create $subdir: $!\n";
			return 0;
		}
	}

	return 1;
}

sub adddir { # (name) - Add a directory to the dircache {{{2
	my $dir;
	return unless ref $_[0] && defined $_[1] && !ref $_[1];
	return unless $_[0]->mkdirs($_[1], DIR);

	if(!exists $_[0]->{'_dirs'}->{$_[1]}) {
		$dir = SCLJ::DirList->new($_[1]);
		$_[0]->{'_dirs'}->{$_[1]} = $dir;
	}

	return $_[0]->{'_dirs'}->{$_[1]};
}

sub getname { # (prompt, [dirlist]) - Get input or filename {{{2
	print "$_[1]: ";
	my $name = SCLJ::Term->ReadLine;
	if(defined $_[2]) {
		($name, undef) = $_[2]->complete($name);
	}
	return (defined $name && length $name ? $name : undef);
}

# Menus! All menu structure contained within {{{2
sub mainmenu { # special: returns menu instead of starting it {{{3
	return undef unless ref $_[0];

	$_[0]->currfile(undef);

	SCLJ::Menu->new([
		"Accounts" => [SUBFUNC, "acctmenu"],
		"Servers" => [SUBFUNC, "servmenu"],
		"Global options (proxy, timeout, etc.)" => [SUBFUNC, "rcmenu"],
		"Default post values" => [SUBFUNC, "pdefmenu"],
		"Quit" => [RETURN]
	]);
}

sub rcmenu { # {{{3
	return undef unless ref $_[0];

	$_[0]->currfile($_[0]->addfile('rc'));

	$_[0]->start(SCLJ::Menu->new([
		"Default account name" => [SUBFUNC, 'defacctrc'], # Completable
		"Editor for event text" => [CONFIG, 'editor', STRING],
		"Terminal width (columns)" => [CONFIG, 'columns', INTEGER],
		"Quit after posting successfully" => [CONFIG, 'postquit', BOOLEAN],
		"Network timeout" => [CONFIG, 'timeout', INTEGER],
		"Proxy hostname" => [CONFIG, 'proxy_host', STRING],
		"Proxy port number" => [CONFIG, 'proxy_port', INTEGER],
		"Authentication method" => [CONFIG, 'auth_mode', ARRAY, [
			"Plain (cleartext/MD5)" => 'plain',
			"Challenge/response (more secure, but newer)" => 'challenge'
		], 'plain'],
		"Return to main menu" => [RETURN]
	]));
}

sub pdefmenu { # {{{3
	return undef unless ref $_[0];

	$_[0]->currfile($_[0]->addfile('post_defaults'));

	$_[0]->start(SCLJ::Menu->new([
		"Backdate" => [CONFIG, 'backdate', BOOLEAN],
		"Disable comments" => [CONFIG, 'comments', BOOLEAN_REV],
		"Disable comment emails" => [CONFIG, 'emails', BOOLEAN_REV],
		"Formatting style" => [CONFIG, 'format', ARRAY, [
			"Standard" => 's',
			"Paragraph" => 'p',
			"Textile" => 't',
			"HTML only" => 'h'
		], 'p'],
		"Security level" => [CONFIG, 'security', ARRAY, [
			"Public" => 'public',
			"Friends only" => 'friends',
			"Private" => 'private'
		], 'public'],
		"Return to main menu" => [RETURN]
	]));
}

sub acctmenu { # {{{3
	return undef unless ref $_[0];

	$_[0]->currfile(undef);

	$_[0]->start(SCLJ::Menu->new([
		"Create a new account" => [SUBFUNC, "newacct"],
		"Delete an account" => [SUBFUNC, "delacct"],
		"Rename an account" => [SUBFUNC, "renacct"],
		"Edit an account" => [SUBFUNC, "chgacctmenu"],
		"Return to main menu" => [RETURN]
	]));
}

sub servmenu { # {{{3
	return undef unless ref $_[0];

	$_[0]->currfile(undef);

	$_[0]->start(SCLJ::Menu->new([
		"Create a new server" => [SUBFUNC, "newserv"],
		"Delete a server" => [SUBFUNC, "delserv"],
		"Rename a server" => [SUBFUNC, "renserv"],
		"Edit a server" => [SUBFUNC, "chgservmenu"],
		"Return to main menu" => [RETURN]
	]));
}

sub chgacctmenu { # {{{3
	my ($acctdir, $servdir, $file, $name);
	return unless ref $_[0];

	$acctdir = $_[0]->adddir("accounts");
	return unless defined $acctdir;
	$servdir = $_[0]->adddir("servers");
	return unless defined $servdir;
	$name = $_[0]->getname("Account to edit", $acctdir);
	return unless defined $name;
	$file = $_[0]->currfile($_[0]->addfile("accounts/$name"));
	return unless defined $file;

	$_[0]->start(SCLJ::Menu->new([
		"Username" => [CONFIG, 'user', STRING],
		"Server" => [CONFIG, 'serva', COMPLIST, "Server name", $servdir],
		# Can't leave the password in there if they switch it to paranoid...
		"Save password" => [SUBFUNC, 'chgparanoid', ['paranoid', BOOLEAN]],
		"Return to account menu" => [RETURN]
	]));
}

sub chgservmenu { # {{{3
	my ($dir, $file, $name);
	return unless ref $_[0];

	$dir = $_[0]->adddir("servers");
	return unless defined $dir;
	$name = $_[0]->getname("Server to edit", $dir);
	return unless defined $name;
	$file = $_[0]->currfile($_[0]->addfile("servers/$name"));
	return unless defined $file;

	$_[0]->start(SCLJ::Menu->new([
		"Address" => [CONFIG, 'host', STRING],
		"Port" => [CONFIG, 'port', INTEGER],
		"Path" => [CONFIG, 'path', STRING],
		"Return to account menu" => [RETURN]
	]));
}

# RC management that didn't work well with Configurable  {{{2
sub defacctrc {
	my ($dir, $file, $name);

	return unless ref $_[0];
	$dir = $_[0]->adddir("accounts");
	$file = $_[0]->currfile;
	return unless defined $dir && defined $file;

	if($dir->length == 0) {
		print "Please create an account (which needs a server) first.\n";
		return;
	} elsif($dir->length == 1) {
		$name = $dir->solename;
		print "Using $name, since it's the only one.\n";
	} else {
		$name = $_[0]->getname("Default account", $dir);
		return unless defined $name;
	}

	if(!defined $file->set('default_acct', $name)->save) {
		print "Couldn't save rc: ".($file->error||"unknown reason")."\n";
	}
}

# Account management: newacct et. al. {{{2
sub newacct { # {{{3
	my ($name, $servdir, $file);
	return unless ref $_[0];
	$servdir = $_[0]->adddir("servers");
	return unless defined $servdir;
	if($servdir->length == 0) {
		print "You need a server to create an account.\n";
		print "Creating server now. (Hit Enter to return without creating ".
			"anything.)\n";
		return unless $_[0]->newserv;
	}

	$name = $_[0]->newacctserv("account", $_[1]);
	return unless defined $name;
	$file = $_[0]->addfile("accounts/$name");
	return unless defined $file;
	$file->set('alias', $name);
	$file->set('frgrps', {});
	$file->set('pics', []);
	$file->set('journals', []);
	$name = $_[0]->getname("Username");
	return unless defined $name;
	$file->set('user', $name);
	$servdir->readentries;
	if($servdir->length == 1) {
		$name = $servdir->solename;
		print "Using $name for the server, since it's the only one.\n";
	} else {
		$name = $_[0]->getname("Server (completes)", $servdir);
	}
	return unless defined $name;
	$file->set('serva', $name);
	$name = $_[0]->getname("Save password ([y]/n)");
	$file->set('paranoid', ((defined $name && $name !~ /^n/i) ? 0 : 1));
	if(!defined $file->save) {
		print "Couldn't save $name: ".($file->error || "nobody knows why")."\n";
	}
}

sub delacct { # {{{3
	my $class = shift;
	$class->delacctserv("account", @_);
}

sub renacct { # {{{3
	my $class = shift; # Get class out of @_
	$class->renacctserv("account", @_);
}

sub chgparanoid { # {{{3
	my ($file, @cfg);
	return unless ref $_[0];

	$file = $_[0]->currfile;
	@cfg = SCLJ::Configurable->set($_[1], $_[2]);
	return unless @cfg;
	$cfg[1] ^= 1; # Inverted option: "no, don't save" = "yes, set paranoid flag"
	$file->set(@cfg);
	if($file->get('paranoid') == 1) {
		# These will return undef if they're not set yet, but we don't care.
		$file->unset('pass');
		$file->unset('crypt_pass');
	}
	if(!defined $file->save) {
		print "Couldn't save: ".($file->error||"don't know why")."\n";
	}
}

# Server management: newserv et. al. {{{2
sub newserv { # {{{3
	my ($name, $host, $port, $uri, $file);
	for my $var ('host', 'port', 'uri') { # path used for file path in Config
		eval "\$$var = SCLJ::Config->val('$var');";
	}

	$name = $_[0]->newacctserv("server", $_[1]);
	return unless defined $name;
	$file = $_[0]->addfile("servers/$name");
	return unless defined $file;
	$file->set('alias', $name);
	$file->set('maxmood', 0);
	$file->set('moods', {});
	$name = $_[0]->getname("Server address [$host]");
	$file->set('host', (defined $name ? $name : $host));
	$name = $_[0]->getname("Server port [$port]");
	$file->set('port', (defined $name ? $name : $port));
	$name = $_[0]->getname("Server path [$uri]");
	$file->set('path', (defined $name ? $name : $uri));
	if(!defined $file->save) {
		print "Couldn't save $name: ".($file->error || "nobody knows why")."\n";
	}
	return 1; # Yay!
}

sub delserv { # {{{3
	my $class = shift;
	$class->delacctserv("server", @_);
}

sub renserv { # {{{3
	my $class = shift; # Get class out of @_
	$class->renacctserv("server", @_);
}

# Account/server combined management {{{2
sub newacctserv { # {{{3
	my($class, $type, $arg) = @_;
	return unless ref $class;
	my $name;

	$name = (defined $arg ? $arg : $class->getname("New ${type} name"));
	LOOP: while(1) { # Get an acceptable name
		return unless defined $name;
		if(-e SCLJ::Config->path_prepend("${type}s/$name")) {
			print "$name already exists. Please choose another.\n";
		} elsif($name =~ /^\./ || $name =~ /\//) {
			print "The name can't begin with a dot or contain a slash.\n";
		} else {
			last LOOP;
		}
		$name = $_[0]->getname("New ${type} name");
	}
	return $name;
}

sub delacctserv { # {{{3
	my ($class, $type, $arg) = @_;

	return unless ref $class;

	my $dir = $class->adddir("${type}s");
	return unless defined $dir;
	if($dir->length == 0) {
		print "There are no ${type}s to delete.\n";
		return;
	}

	my $name;
	if(defined $arg) {
		my $status;
		($name, $status) = $dir->complete($arg);
		return if defined $status && $status == 1; # Canceled ambiguous completion
		if(defined $name) { # Unambiguous completion--double-check intent
			return unless $class->getname("Really delete $name (y/[n])") =~ /^y/i;
		}
		# Let no completion ($name=undef, $status=0) fall through
	}
	if(!defined $name) {
		$name = $class->getname("Delete ${type} (Careful!)", $dir);
	}
	return unless defined $name;

	my $filename = "${type}s/$name";
	unlink SCLJ::Config->path_prepend($filename);
	$class->delfile($filename);
	$class->rendelfix($type, $name);
}

sub renacctserv { # {{{3
	my ($class, $type, $arg) = @_;
	return unless ref $class;
	my $dir = $class->adddir("${type}s");
	return unless defined $dir;
	if($dir->length == 0) {
		print "There are no ${type}s to rename.\n";
		return;
	}

	my ($oldname, $newname) = split(/\s+/, $arg);
	my $status;
	($oldname, $status) = $dir->complete($oldname) if defined $oldname;
	# Just return if they canceled an ambiguous completion ($status == 1)
	if((!defined $oldname) && ((!defined $status) || $status == 0)) {
		$oldname = $class->getname("Rename ${type}: current name", $dir);
	}
	return unless defined $oldname;

	if(!defined $newname) {
		$newname = $class->getname("Rename ${type}: new name");
	}
	while(-e SCLJ::Config->path_prepend("${type}s/$newname")) {
		print "$newname already exists. Enter another, or leave blank to ".
			"cancel.\n";
		$newname = $class->getname("Rename ${type}: new name");
		return unless defined $newname;
	}

	my $file = $class->addfile("${type}s/$oldname");
	$file->set('alias', $newname);

	if(!defined $file->rename("${type}s/$newname")->save) {
		print "Saving as $newname: ".($file->error||"unknown failure") . "\n";
		print "Old name $oldname unharmed.\n";
		$file->rename("${type}s/$oldname")->set('alias', $oldname);
		$file->clearerr;
		return;
	}

	$class->delfile("${type}s/$oldname");
	unlink SCLJ::Config->path_prepend("${type}s/$oldname"); 

	$class->rendelfix($type, $oldname);
}

sub rendelfix { # {{{3
	my ($class, $type, $name) = @_;

	if(${type} eq 'server') {
		print "Reminder: any accounts using this server need updated.\n";
	} else {
		my $file = $class->addfile('rc');
		if($file->get('default_acct') eq $name) {
			print "Reminder: you will need to update your default account.\n";
		}
	}
}

# Main program {{{1
package main;

SCLJ::Config->parse_opts(\@ARGV);
my $path = SCLJ::Config->val('path');

if((!-e $path) && (!mkdir($path, 0700))) {
	print "Can't create $path: $!\n";
	exit 1;
}

print "Please select by item number or the first few letters of the item.\n";
SCLJ::Editor->new->start; # OO makes programs simple!

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