#!/usr/bin/env perl
# vim:foldmethod=marker
# Manage a collection of RDF files describing books.
# Adam Sampson <ats@offog.org>

use strict;
use Net::Amazon;
use ZOOM;
use Term::ReadLine;
use MARC::Record;
use POSIX;
use Encode;
use XML::Twig;
use XML::Writer;
use IO::File;

#{{{ configuration
my $db_dir = "/home/azz/Work/library";
my $items_uri = "http://offog.org/library/items/";
# There are also assumptions later in the code that you're in the UK for
# Amazon's purposes.
#}}}

#{{{ RDF namespaces
my %ns = (
	"dc" => "http://purl.org/dc/elements/1.1/",
	"alms" => "http://offog.org/xmlns/alms/",
	);
#}}}

#{{{ globals
my $term = new Term::ReadLine("ALMS");

my $id = undef;
my @item_elements = ();

my @sticky = ();
#}}}

#{{{ helper functions
sub db_fn ($) {
	my ($id) = @_;
	return "$db_dir/$id";
}
#}}}

#{{{ fields and their mapping to XML
# FIXME should have a defined display order for these
my %fields = (
	"title" => ["title", "dc:title"],
	"series" => ["series", "alms:series"],
	"author" => ["author", "dc:creator"],
	"code" => ["ISBN/UPC code", "dc:identifier"],
	"publisher" => ["publisher", "dc:publisher"],
	"published" => ["date published", "alms:datePublished"],
	"medium" => ["medium", "dc:format"],
	"listprice" => ["list price", "alms:listPrice"],
	"pricepaid" => ["price paid", "alms:pricePaid"],
	"notes" => ["notes", "alms:notes"],
	"classmark" => ["LoC classmark", "alms:classmark"],
	"source" => ["source", "dc:source"],
	"condition" => ["condition", "alms:condition"],
	"catalogued" => ["date catalogued", "alms:dateCatalogued"],
	"location" => ["location", "alms:location"],
);
my $id_element = "alms:itemNumber";
my $read_element = "alms:read";
# ... and these are all contained in alms:item, which can itself be contained
# in alms:items.
#}}}

#{{{ status display
sub start_status ($) {
	my ($msg) = @_;

	$| = 1;
	print "[$msg]";
}

sub end_status () {
	# FIXME this ought to use Term::Cap
	print "\r\033[0K";
	$| = 0;
}
#}}}

#{{{ searching for items
#{{{ Amazon
my $amazon = undef;
sub search_amazon (%) {
	unless (defined $amazon) {
		my $fn = "$ENV{HOME}/.amazon_token";
		open F, "<", $fn or die "Cannot open $fn\n";
		$_ = <F>;
		/^(\S+)\s+(\S+)\s+(\S+)/ or die "Cannot parse $fn\n";
		my ($token, $secret_key, $associate_tag) = ($1, $2, $3);
		close F;

		$amazon = Net::Amazon->new(token => $token, secret_key => $secret_key, associate_tag => $associate_tag, max_pages => 1, locale => "uk");
	}

	start_status("Doing Amazon search...");
	my $resp = $amazon->search(@_);
	end_status();

	unless ($resp->is_success()) {
		print "Error from Amazon: " . $resp->message() . "\n";
		return ();
	}

	my @results = ();
	for my $prop ($resp->properties) {
		my %item = ();

		my $type = $prop->Catalog();
		if ($type eq 'Book' or $type eq 'eBooks') {
			$item{"title"} = $prop->title();
			$item{"author"} = join(", ", $prop->authors());
			$item{"publisher"} = $prop->publisher();
			$item{"code"} = $prop->isbn() ? "ISBN " . $prop->isbn() : "";
		} elsif ($type eq 'Music' or $type eq 'Classical') {
			$item{"title"} = $prop->album();
			$item{"author"} = join(", ", $prop->artists());
			$item{"publisher"} = $prop->label();
			$item{"code"} = $prop->upc() ? "UPC " . $prop->upc() : "";
		} else {
			print "Ignoring Amazon result " . $prop->ProductName() . " because catalog $type is unknown.\n";
			next;
		}

		if ($item{"title"} =~ /^(.*)\s+\((.+)\)$/) {
			$item{"title"} = $1;
			$item{"series"} = $2;
		}

		$item{"published"} = $prop->year();
		$item{"medium"} = $prop->Media();
		$item{"listprice"} = $prop->ListPrice();

		push @results, \%item;
	}
	return @results;
}
#}}}

#{{{ Z39.50
my $z3950 = undef;
sub search_loc ($) {
	my ($cql) = @_;

	unless (defined $z3950) {
		start_status("Connecting to LoC...");
		$z3950 = new ZOOM::Connection("z3950.loc.gov:7090/voyager");
		$z3950->option(preferredRecordSyntax => "usmarc");
		end_status();
	}

	my $set;
	eval {
		$set = $z3950->search(new ZOOM::Query::PQF($cql));
	};
	if ($@) {
		print "LoC Z39.50 error: code " . $@->code() . ": " . $@->message() . "\n";
		return ();
	}

	my @results = ();
	foreach my $i (0..($set->size() - 1)) {
		my %item = ();
		my $record = $set->record($i);
		print "MARC: " . $record->render() . "\n";
		my $marc = MARC::Record->new_from_usmarc($record->raw);

		my @titles = ();
		foreach my $title ($marc->subfield("245", "a"),
		                   $marc->subfield("245", "b")) {
			$title =~ s/ [\/:]$//;
			push @titles, $title;
		}
		$item{"title"} = join(": ", @titles);

		my @authors = ();
		foreach my $author ($marc->subfield("100", "a"),
		                    $marc->subfield("700", "a")) {
			$author =~ s/([^,]*), (.*)/$2 $1/;
			push @authors, $author;
		}
		$item{"author"} = join(", ", @authors);

		$item{"published"} = $marc->publication_date();

		$item{"publisher"} = $marc->subfield("260", "b") || "";
		$item{"publisher"} =~ s/\s*,$//;

		my $rawcode = $marc->subfield("020", "a");
		$item{"code"} = $rawcode ? "ISBN $rawcode" : "";
		$item{"listprice"} = $marc->subfield("350", "a") || "" ;
		$item{"classmark"} = $marc->subfield("050", "a") || "";

		push @results, \%item;
	}
	return @results;
}
#}}}

sub find_from_isbn ($) {
	my ($isbn) = @_;
	my @results;

	for my $locale ("uk", "us", "de") {
		# The default locale set in the Net::Amazon constructor also
		# makes a difference to these searches. If you leave it set to
		# the default, you won't get ISBN-13 results, even if you ask
		# for the uk locale here...

		@results = search_amazon(isbn => $isbn, locale => $locale);
		return @results if scalar(@results) != 0;
	}

	@results = search_loc("\@attr 1=7 $isbn");
	return @results if scalar(@results) != 0;

	return ();
}

sub find_from_upc ($) {
	my ($upc) = @_;
	my @results;

	@results = search_amazon(upc => $upc, mode => "music", locale => "uk");
	return @results if scalar(@results) != 0;

	@results = search_amazon(upc => $upc, mode => "music");
	return @results if scalar(@results) != 0;

	return ();
}
#}}}

#{{{ displaying items
sub show_item ($) {
	my ($item) = @_;

	foreach my $field (sort keys %$item) {
		printf "\%-20s: \%s\n", $fields{$field}->[0], $item->{$field};
	}
}

sub show_current () {
	return unless defined $id;

	print "\n";
	my @read = ();
	my %item = ();
	foreach my $pair (@item_elements) {
		my ($element, $value) = @$pair;
		my $found = 0;
		foreach my $field (keys %fields) {
			if ($fields{$field}->[1] eq $element) {
				$item{$field} = $value;
				$found = 1;
				last;
			}
		}
		if ($element eq $id_element) {
			if (int($value) != $id) {
				print "Warning: item number $value does not match expected $id.\n";
			}
			$found = 1;
		}
		if ($element eq $read_element) {
			push @read, $value;
			$found = 1;
		}
		unless ($found) {
			print "(Unknown element $element in XML not shown.)\n";
		}
	}
	show_item(\%item);

	if (@read > 0) {
		print "\nreading log:\n";
		foreach my $read (@read) {
			print "    $read\n";
		}
	}
}
#}}}

#{{{ Item model operations
sub clear_current () {
	@item_elements = ();
}

sub new_item () {
	unless (defined $id) {
		$id = 1;
	}
	while (-e db_fn($id)) {
		$id++;
	}
	clear_current();
	add_element($id_element, "$id");
	print "Created new item $id.\n";
}

sub parse_item ($$) {
	my ($id, $elements) = @_;

	my $twig = XML::Twig->new();
	$twig->parsefile(db_fn($id));

	foreach my $element_xml ($twig->root->children) {
		push @$elements, [$element_xml->gi, $element_xml->text];
	}
}

sub load_item ($) {
	my ($new_id) = @_;
	unless (-e db_fn($new_id)) {
		print "Item $new_id does not exist.\n";
		return;
	}
	$id = $new_id;
	clear_current();
	parse_item($id, \@item_elements);
}

sub save_item () {
	my $fn = db_fn($id);

	my $output = new IO::File(">$fn.new");
	my $xml = new XML::Writer(OUTPUT => $output, ENCODING => "utf-8", DATA_MODE => 1, DATA_INDENT => 2);
	$xml->xmlDecl();
	my @ns_decls = ();
	foreach my $n (keys %ns) {
		push @ns_decls, "xmlns:$n" => $ns{$n};
	}
	$xml->startTag("alms:item", @ns_decls);

	foreach my $pair (@item_elements) {
		my ($element, $value) = @$pair;
		$xml->dataElement($element, $value);
	}

	$xml->endTag("alms:item");
	$xml->end();
	$output->close();

	rename("$fn.new", "$fn");
}
#}}}

#{{{ element operations
sub add_element ($$) {
	my ($element, $value) = @_;
	if ($value) {
		push @item_elements, [$element, $value];
	}
}

sub remove_elements ($$) {
	my ($element, $value) = @_;
	my @clean = ();
	foreach my $pair (@item_elements) {
		if ($pair->[0] eq $element && ((!defined($value)) || $pair->[1] eq $value)) {
			next;
		}
		push @clean, $pair;
	}
	@item_elements = @clean;
}
#}}}

#{{{ Searching the whole database
sub get_all_items () {
	my $items = {};

	opendir DIR, $db_dir || die "cannot list database directory";
	foreach my $fn (readdir DIR) {
		next unless $fn =~ /^\d+$/;

		my $item_id = int($fn);
		$items->{$item_id} = [];
		parse_item($item_id, $items->{$item_id});
	}
	closedir DIR;

	return $items;
}

sub search_all_items ($$) {
	my ($field, $find) = @_;
	my $find_element = $fields{$field}->[1];
	my $title_element = $fields{"title"}->[1];

	my $all_items = get_all_items();
	my @list = ();
	foreach my $item_id (keys %$all_items) {
		my $found_value = undef;
		my $title = "";
		foreach my $pair (@{$all_items->{$item_id}}) {
			my ($element, $value) = @$pair;
			if ($find_element eq $element && $value =~ /$find/i) {
				$found_value = $value;
			}
			if ($element eq $title_element) {
				$title = $value;
			}
		}
		if (defined $found_value) {
			push @list, [$item_id, $title, $found_value];
		}
	}

	$id = undef;

	print "\nFound " . scalar @list . " results.\n";
	foreach my $item (sort { $a->[0] <=> $b->[0] } @list) {
		my ($item_id, $title, $value) = @$item;

		print "\n";
		if (scalar @list == 1) {
			load_item($item_id);
			last;
		}

		printf "\%5d  title: \%s\n", $item_id, $title;
		if ($field ne 'title') {
			print "       $field: $value\n";
		}
	}
}
#}}}

#{{{ XML output
sub normalise_authors ($) {
	my ($in) = @_;

	my @names = ();
	foreach my $name (split(/,\s+/, $in)) {
		$name = lc $name;
		$name =~ s/\./ /g;
		$name =~ s/\s+/ /g;
		$name =~ s/^(sir|lord|the \S+) //;
		$name =~ s/ *$//;
		if ($name =~ /^(.*) (\S+)$/) {
			my ($fore, $sur) = ($1, $2);
			$fore =~ s/\b(\S)\S+/$1/g;
			$name = "$sur $fore";
		}
		$name =~ s/\b(.)/uc $1/eg;
		push @names, $name;
	}

	return join("; ", @names);
}

sub save_items_xml ($$) {
	my ($items, $fn) = @_;

	my $output = new IO::File(">$fn");
	my $xml = new XML::Writer(OUTPUT => $output, ENCODING => "utf-8", DATA_MODE => 1, DATA_INDENT => 2);
	$xml->xmlDecl();
	my @ns_decls = ();
	foreach my $n (keys %ns) {
		push @ns_decls, "xmlns:$n" => $ns{$n};
	}
	$xml->startTag("alms:items", @ns_decls);

	foreach my $item_id (keys %$items) {
		$xml->startTag("alms:item", "alms:itemNumber" => $item_id);

		foreach my $pair (@{$items->{$item_id}}) {
			my ($element, $value) = @$pair;
			$xml->dataElement($element, $value);
			if ($element eq 'dc:creator') {
				$xml->dataElement("alms:normalisedCreator", normalise_authors($value));
			}
		}
		$xml->endTag("alms:item");
	}

	$xml->endTag("alms:items");
	$xml->end();
	$output->close();
}
#}}}

#{{{ add
sub add (@) {
	my $use;
	my $n = scalar(@_);

	foreach my $item (@_) {
		foreach my $key (keys %$item) {
			delete $item->{$key} unless $item->{$key};
		}
	}

	if ($n == 0) {
		print "No matches found.\n";
		return;
	} elsif ($n == 1) {
		$use = $_[0];
	} else {
		print "Multiple matches found.\n";
		my $i = 0;
		foreach my $item (@_) {
			print "\nChoice $i:\n";
			show_item($item);
		}
		do {
			my $line = $term->readline("Which one (or \"none\")? ");
			if ($line eq 'none') {
				print "\nNo matches found.\n";
				return;
			}
			$i = int($line);
		} while ($i >= 0 && $i < $n);
		$use = $_[$i];
	}

	$use->{"catalogued"} = strftime('%Y-%m-%dT%H:%MZ', gmtime());

	new_item();
	foreach my $key (keys %$use) {
		add_element($fields{$key}->[1], $use->{$key});
	}
	save_item();

	foreach my $line (@sticky) {
		command($line);
	}
}
#}}}

#{{{ command parser
sub command ($);
sub command ($) {
	my ($line) = @_;

	if ($line =~ /^([0-9X]{10}|[0-9X]{13})$/) {
		add(find_from_isbn($line));
	} elsif ($line =~ /^[0-9]{12}$/) {
		add(find_from_upc($line));
	} elsif ($line =~ /^=(.*)$/) {
		my @results = ({ "title" => $1 });
		add(@results);
	} elsif ($line =~ /^\+(.*)$/) {
		push @sticky, $1;
	} elsif ($line =~ /^-(.*)$/) {
		@sticky = grep { $_ !~ /^$1/ } @sticky;
	} elsif ($line =~ /^\/(\S+)\s+(\S.*)$/) {
		my ($field, $find) = ($1, $2);

		if (exists $fields{$field}) {
			search_all_items($field, $find);
		} else {
			print "Unknown field $field.\n";
		}
	} elsif ($line =~ /^(\S+)(?:\s+(.*))?$/) {
		my ($command, $arg) = ($1, $2);

		if (exists $fields{$command} and defined $id) {
			my $element = $fields{$command}->[1];
			remove_elements($element, undef);
			add_element($element, $arg);
			save_item();
		} elsif ($command eq "read") {
			$arg = "unknown" unless defined $arg;
			add_element($read_element, $arg);
			save_item();
		} elsif ($command eq "unread") {
			remove_elements($read_element, $arg);
			save_item();
		} elsif ($command eq "quit") {
			last;
		} elsif ($command eq "select") {
			load_item(int($arg));
		} elsif ($command eq "delete" and defined $id) {
			unlink(db_fn($id));
			print "Deleted item $id.\n";
			$id = undef;
		} elsif ($command eq "dumpxml" and defined $arg) {
			save_items_xml(get_all_items(), $arg);
		} elsif ($command eq "foreach" and (defined $arg) and $arg =~ /^(\d+)-(\d+)\s+(.*)$/) {
			my ($from, $to, $cmd) = ($1, $2, $3);
			foreach my $i (int($from)..int($to)) {
				command("select $i");
				command($cmd);
			}
		} else {
			print <<EOS;

Unknown command -- things you can enter:

10-digit ISBN        Add a new item and select it
or 13-digit ISBN
or 12-digit UPC
or =title

quit                 Quit
select ID            Select an existing item by ID
delete               Delete selected item

FIELD VALUE          Set the value of a field
/FIELD REGEX         Search the database for items with FIELD matching REGEX

FIELD may be any of:
EOS
			foreach my $field (sort keys %fields) {
				printf "  \%-18s \%s\n", $field, $fields{$field}->[0];
			}
			print <<EOS;

read [DATE]          Add entry to reading log for selected item
unread [DATE]        Remove entry (or *all* entries) from reading log

+COMMAND             Add COMMAND to sticky commands, which are run
                     automatically after adding a new item
-PREFIX              Remove sticky commands starting with PREFIX

foreach FROM-TO CMD  For each ID in the range FROM-TO inclusive,
                     select that ID, then execute CMD

dumpxml FILENAME     Write the entire database as XML to FILENAME
EOS
		}
	}
}
#}}}

#{{{ main loop
sub main () {
	if (@ARGV > 0) {
		command(join(" ", @ARGV));
		return;
	}

	while (1) {
		show_current();
		print "\n";
		if (@sticky > 0) {
			print "Sticky: " . join("; ", @sticky) . "\n";
		}
		my $line = $term->readline("ALMS" . (defined $id ? " $id" : "") . "> ");
		return unless defined($line) and $line ne "quit";

		command($line);
	}
}
main();
#}}}