anidb.pl

use Irssi;
use HTML::Scrape ();
use anidb::scrape ();
use URI::Escape ();
use Storable ();
use LWP::UserAgent ();
use Encode ();
use utf8;
use HTML::Entities ();
use Compress::Zlib ();
use MIME::Base64 ();
use subs qw(debug);

our ($VERSION, %IRSSI, %SCRAPE);

BEGIN {
	$VERSION = 0; # >_>

	%IRSSI = (
		authors	=> 'Justin Lee, Tristan Willy',
		description	=> 'Scrape info from AniDB.net!',
		url	=> 'http://pikabot.googlecode.com/',
		contact	=> 'kool.name/tristan.willy at gmail.com',
		name	=> 'anidb'
	);

	%SCRAPE = ();
}

sub debug(@) {
	Irssi::settings_get_bool("$IRSSI{name}_debug") or do {
		return ();
	};

	print(
		join(': ', [caller(1)]->[3], @_)
	);
}

sub message($$$$;$) {
	my ($server, $message, $nick, $address, $target) = @_;

	$message =~ /^\s*!anidb\s+(.*)/i or do {
		return ();
	};
	length(my $query = $1) or do {
		return ();
	};

	my %info;

	if ($query =~ /^\s*a?(?:id:?)?(\d+)\s*$/i) {
		%info = fetch($1) or do {
			$server->send_message(
				(defined($target) ? $target : $nick),
				"Sorry, $nick, I was unable to fetch <a$1>.",
				not defined($target)
			);

			return ();
		};
	} else {
		%info = search($query) or do {
			$server->send_message(
				(defined($target) ? $target : $nick),
				"Sorry, $nick, I was unable to search for <$query>.",
				not defined($target)
			);

			return ();
		};
	}

	exists($info{SEARCH}) and do {
		@{$info{SEARCH}} > 1 and do {
			my $message = '{Results}';

			foreach my $t (@{$info{SEARCH}}[0..4]) {
				my ($aid, $title) = each(%{$t});

				$message .= " $aid:[ $title ]";
			}

			$server->send_message(
				(defined($target) ? $target : $nick),
				$message,
				not defined($target)
			);
		};

		my ($aid) = keys(%{$info{SEARCH}->[0]});

		%info = fetch($aid) or do {
			$server->send_message(
				(defined($target) ? $target : $nick),
				"Sorry, $nick, I was unable to fetch <a$aid>.",
				not defined($target)
			);

			return ();
		};
	};

	exists($info{FAILURE}) and do {
		$server->send_message(
			(defined($target) ? $target : $nick),
			"Sorry, $nick, $info{FAILURE}.",
			not defined($target)
		);

		return ();
	};

	my $message = "{$info{AID}} <$info{TITLE}>";

	exists($info{TITLES}) and do {
		foreach my $t qw(japanese english french) { #XXX this should be some config option
			exists($info{TITLES}->{$t}) and do {
				$message .= ' <'. $info{TITLES}->{$t} .'>';
			};
		}
	};

	my @fetch = grep {
		!/^(?:TITLES?|AID)$/
	} map {
		uc
	} split(
		/\s*,\s*/,
		Irssi::settings_get_str("$IRSSI{name}_fetch")
	);

	foreach my $k (@fetch) {
		exists($info{$k}) or do {
			next;
		};

		foreach my $j (sort keys(%{$info{$k}})) {
			$message .= " \L\u$j\E:[ ";

			if (ref($info{$k}->{$j}) eq 'ARRAY') {
				$message .= join(', ', @{$info{$k}->{$j}});
			} else {
				$message .= $info{$k}->{$j};
			}

			$message .= ' ]';
		}
	}

	$message .= ' Link:[ '. aid_to_url($info{AID}) .' ]';

	$server->send_message(
		(defined($target) ? $target : $nick),
		$message,
		not defined($target)
	);
}

sub searchify($) {
	(defined($_[0]) and
		length($_[0])) or do {

		debug(
			'Invalid input',
			(defined($_[0]) ? 'Zero-length value' : 'Undefined value')
		);

		return (undef);
	};

	# clean up white space
	chomp($_[0]);
	$_[0] =~ s/^\s+//;
	$_[0] =~ s/\s+$//;
	$_[0] =~ s/\s+/ /g;

	# escape the values
	$_[0] = URI::Escape::uri_escape($_[0]);

	# AniDB hack
	$_[0] =~ s/\%20/+/g;

	return ($_[0]);
}

sub aid_to_url($) {
	$_[0] =~ /^\s*(\d+)\s*$/ or do {
		debug(
			'Invalid input',
			(defined($_[0]) ? $_[0] : 'Undefined value')
		);

		return (undef);
	};

	return ("http://anidb.net/a$1");
}

sub url_type($) {
	$_[0] =~ /anidb\.(?:net|info).*\ba(?:id=)?\d+/i
}

sub url_to_aid($) {
	$_[0] =~ /anidb\.(?:net|info).*\ba(?:id=)?(\d+)/i or do {
		debug(
			'Invalid input',
			(defined($_[0]) ? $_[0] : 'Undefined value')
		);

		return (undef);
	};

	return ($1);
}

sub aid_to_local($) {
	$_[0] =~ s/^\s*(\d+)\s*$/$1/ or do {
		debug(
			'Invalid input',
			(defined($_[0]) ? $_[0] : 'Undefined value')
		);

		return (undef);
	};
	-d (my $dir = Irssi::settings_get_str("$IRSSI{name}_aid_dir")) or do {
		debug(
			'Required setting not configured correctly',
			"$IRSSI{name}_aid_dir"
		);

		return (undef);
	};

	return (
		join(
			'/',
			$dir,
			$_[0]
		)
	);
}

sub search_to_url($) {
	(defined($_[0]) and
		length($_[0])) or do {

		debug(
			'Invalid input',
			(defined($_[0]) ? 'Zero-length value' : 'Undefined value')
		);

		return (undef);
	};

	return (
		'http://anidb.net/perl-bin/animedb.pl?show=animelist&adb.search='.
		$_[0].
		'&do.search=search'
	);
}

sub search_to_local($) {
	(defined($_[0]) and
		length($_[0])) or do {

		debug(
			'Invalid input',
			(defined($_[0]) ? 'Zero-length value' : 'Undefined value')
		);

		return (undef);
	};
	-d (my $dir = Irssi::settings_get_str("$IRSSI{name}_query_dir")) or do {
		debug(
			'Required setting not configured correctly',
			"$IRSSI{name}_query_dir"
		);

		return (undef);
	};

	#XXX: This is weird. :/
	chomp(my $file = join('/', $dir, MIME::Base64::encode_base64($_[0])));
	$file =~ s/\s*$//;

	return ($file);
}

sub purge($) { #XXX
	return (1); #XXX
} # XXX XXX

sub download($) {
	(defined($_[0]) and
		length($_[0])) or do {

		debug(
			'Invalid input',
			(defined($_[0]) ? 'Zero-length value' : 'Undefined value')
		);

		return (undef);
	};
	ref(my $ua = LWP::UserAgent->new) or do {
		debug(
			'Unable to build LWP::UserAgent object'
		);

		return (undef);
	};
	ref(my $rq = HTTP::Request->new(GET => $_[0])) or do {
		debug(
			'Unable to build HTTP::Request object'
		);

		return (undef);
	};
	length(my $ref = Irssi::settings_get_str("$IRSSI{name}_lwp_refer")) or do {
		debug(
			'Required setting not configured correctly',
			"$IRSSI{name}_lwp_refer"
		);

		return (undef);
	};

	$rq->header(Referer => $ref);
	$ua->timeout(Irssi::settings_get_int("$IRSSI{name}_lwp_timeout"));
	$ua->agent(Irssi::settings_get_str("$IRSSI{name}_lwp_agent"));

	defined(my $page = $ua->request($rq)) or do {
		debug(
			'Request failed',
			$_[0]
		);

		return (undef);
	};
	$page->is_success or do {
		debug(
			'Request was not successful',
			$page->code
		);

		return (undef);
	};

	return (
		#XXX: Decoding the whole page is... well... a lot.
		# This should probably be moved to parse(), maybe
		# decode all the entities as they are stored in
		# the %info hash, or something.
		HTML::Entities::decode_entities(
			Encode::decode(
				'utf8',
				(($page->content_encoding and
					$page->content_encoding eq 'gzip')

					? Compress::Zlib::memGunzip($page->content)
					: $page->content)
			)
		),
		url_type($page->base)
	);
}

sub parse_fetch($) {
	(defined($_[0]) and
		length($_[0])) or do {

		debug(
			'Invalid input',
			(defined($_[0]) ? 'Zero-length value' : 'Undefined value')
		);

		return ();
	};

	my %info = (FETCHED => time);

	ref(
		my $scraper = HTML::Scrape->new(
			Machine => anidb::scrape->TITLE
		)
	) or do {
		debug(
			'Unable to build scraper'
		);

		return ();
	};

	my @data = $scraper->scrape($_[0]) or do {
		return ();
	};

	$info{AID} = each(%{$data[0]});
	$info{TITLE} = $data[0]->{$info{AID}};

	my @fetch = grep {
		eval('my $s = anidb::scrape->$_;') #XXX filter out bad names
	} map {
		uc # just because
	} split(
		/\s*,\s*/,
		Irssi::settings_get_str("$IRSSI{name}_fetch")
	);

	foreach my $f (@fetch) {
		exists($info{$f}) and do {
			next;
		};

		ref(
			$scraper = HTML::Scrape->new(
				Machine => anidb::scrape->$f
			)
		) or do {
			debug(
				'Unable to construct machine',
				$f
			);
		};

		@data = $scraper->scrape($_[0]) or do {
			next;
		};

		exists($SCRAPE{$f}) and do {
			@data = ($SCRAPE{$f}->(@data));
		};

		$info{$f} = (
			@data > 1
				? ({ map { each(%{$_}) } @data })
				: $data[0]
		);
	}

	return (%info);
}

sub parse_search($) {
	(defined($_[0]) and
		length($_[0])) or do {

		debug(
			'Invalid input',
			(defined($_[0]) ? 'Zero-length value' : 'Undefined value')
		);

		return ();
	};

	ref(
		my $scraper = HTML::Scrape->new(
			Machine => anidb::scrape->SEARCH
		)
	) or do {
		debug(
			'Unable to build scraper'
		);

		return ();
	};

	my @data = $scraper->scrape($_[0]) or do {
		return ();
	};

	return (
		SEARCH => \@data,
		FETCHED => time
	);
}

sub parse($$) {
	(defined($_[0]) and
		length($_[0])) or do {

		debug(
			'Invalid input',
			(defined($_[0]) ? 'Zero-length value' : 'Undefined value')
		);

		return ();
	};

	my %info = (
		$_[1]
			? parse_fetch($_[0])
			: parse_search($_[0])
	) or do {
		$scraper = HTML::Scrape->new(
			Machine => anidb::scrape->FAILURE
		);

		my @fail = $scraper->scrape($_[0]) or do {
			debug(
				'Unknown scrape failure, aborting'
			);

			return ();
		};

		return (each(%{$fail[0]}));
	};

	return (%info);
}

sub fetch_remote($) {
	defined(my $url = aid_to_url($_[0])) or do {
		debug(
			'Unable to generate URL'
		);

		return ();
	};
	my ($page, $type) = download($url) or do {
		debug(
			'Unable to download URL',
			$url
		);

		return ();
	};

	return (parse($page, $type));
}

sub fetch_local($) {
	defined(my $stored = aid_to_local($_[0])) or do {
		debug(
			'Unable to generate file name'
		);

		return ();
	};
	-f $stored or do {
		return ();
	};
	my $timeout = Irssi::settings_get_int(
		"$IRSSI{name}_file_timeout"
	);

	my $info; #sigh...

	eval {
		$info = Storable::lock_retrieve($stored);
	};
	$@ and do {
		debug(
			'Unable to retrieve file',
			$stored
		);

		return ();
	};

	(time - $info->{FETCHED}) > $timeout and do {
		purge($stored) or do {
			debug(
				'Unable to purge old file',
				$stored
			);
		};

		return ();
	};

	return (%{$info});
}

sub store_fetch($\%) {
	defined(my $store = aid_to_local($_[0])) or do {
		debug(
			'Unable to generate file name'
		);

		return (undef);
	};
	eval {
		Storable::lock_store($_[1], $store);
	};
	$@ and do {
		debug(
			'Unable to store AID',
			$store
		);

		return (undef);
	};

	return (1);
}

sub fetch($) {
	(defined($_[0]) and
		$_[0] =~ /^\s*(\d+)\s*$/) or do {

		debug(
			'Invalid input',
			(defined($_[0]) ? $_[0] : 'Undefined value')
		);

		return ();
	};

	my ($aid, %info) = ($1, $_[1]);

	%info = fetch_local($aid) or do {
		%info = fetch_remote($aid) or do {
			debug(
				'Unable to fetch aid',
				$aid
			);

			return ();
		};

		store_fetch($aid, %info) or do {
			debug(
				'Unable to store aid',
				$aid
			);
		};
	};

	return (%info);
}

sub search_remote($) {
	defined(my $url = search_to_url($_[0])) or do {
		debug(
			'Unable to generate URL'
		);

		return ();
	};
	my ($page, $type) = download($url) or do {
		debug(
			'Unable to download URL',
			$url
		);

		return ();
	};

	return (parse($page, $type));
}


sub search_local($) {
	defined(my $stored = search_to_local($_[0])) or do {
		debug(
			'Unable generate file name'
		);

		return ();
	};
	-f $stored or do {
		return ();
	};
	my $timeout = Irssi::settings_get_int(
		"$IRSSI{name}_file_timeout"
	);

	my $search; #sigh...

	eval {
		$search = Storable::lock_retrieve($stored);
	};
	$@ and do {
		debug(
			'Unable to retrieve file',
			$stored
		);

		return ();
	};

	(time - $search->{FETCHED}) > $timeout and do {
		purge($stored) or do {
			debug(
				'Unable to purge old file',
				$stored
			);
		};

		return ();
	};

	return (%{$search});
}

sub store_search($\%) {
	defined(my $store = search_to_local($_[0])) or do {
		debug(
			'Unable to generate file name'
		);

		return (undef);
	};
	eval {
		Storable::lock_store($_[1], $store);
	};
	$@ and do {
		debug(
			'Unable to store search',
			$store
		);

		return (undef);
	};

	return (1);
}

sub search($) {
	defined(my $search = searchify($_[0])) or do {
		debug(
			'Unable to generate search string'
		);

		return ();
	};

	my %info;

	%info = search_local($search) or do {
		%info = search_remote($search) or do {
			debug(
				'Unable to search string',
				$search
			);

			return ();
		};

		if (exists($info{SEARCH})) {
			store_search($search, %info) or do {
				debug(
					'Unable to store search',
					$search
				);
			};
		} elsif(exists($info{FAILURE})) {
			return (%info);
		} else {
			store_search(
				$search,
				%{
					{
						SEARCH => [ { $info{AID} => $info{TITLE} } ],
						FETCHED => $info{FETCHED},
					}
				}
			) or do {
				debug(
					'Unable to store search',
					$search
				);
			};

			store_fetch($info{AID}, %info) or do {
				debug(
					'Unable to store AID',
					$info{AID}
				);
			};
		}
	};

	if (exists($info{SEARCH})) {
		return (%info);
	} else {
		return (
			%{
				{
					SEARCH => [ { $info{AID} => $info{TITLE} } ],
					FETCHED => $info{FETCHED},
				}
			}
		);
	}
}


Irssi::settings_add_bool(
	$IRSSI{name},
	"$IRSSI{name}_debug",
	1
);

Irssi::settings_add_bool(
	$IRSSI{name},
	"$IRSSI{name}_verbose",
	0
);

Irssi::settings_add_str(
	$IRSSI{name},
	"$IRSSI{name}_fetch",
	''
);

Irssi::settings_add_str(
	$IRSSI{name},
	"$IRSSI{name}_lwp_agent",
	'Mozilla/5.0 (X11; U; Linux; i686; en-US; '.
	'rv:1.9.0.13; fixing your api would make life easier) '.
	'Gecko/2009073022 Firefox/3.0.13'
);

Irssi::settings_add_str(
	$IRSSI{name},
	"$IRSSI{name}_aid_dir",
	'~/.irssi/anidb/aid'
);

Irssi::settings_add_str(
	$IRSSI{name},
	"$IRSSI{name}_query_dir",
	'~/.irssi/anidb/query'
);

Irssi::settings_add_str(
	$IRSSI{name},
	"$IRSSI{name}_lwp_refer",
	'http://www.anidb.net/perl-bin/animedb.pl'
);

Irssi::settings_add_int(
	$IRSSI{name},
	"$IRSSI{name}_lwp_timeout",
	30
);

Irssi::settings_add_int(
	$IRSSI{name},
	"$IRSSI{name}_file_timeout",
	864000 # 10 days, in seconds
);

Irssi::settings_add_bool(
	$IRSSI{name},
	"$IRSSI{name}_file_purge",
	1
);

Irssi::signal_add(
	'message public',
	'message'
);

Irssi::signal_add(
	'message private',
	'message'
);