package PerlMonksFacts;

=pod

=head1 NAME

PerlMonksFacts - codified knowledge about the automation interfaces of PerlMonks.org

=head1 SYNOPSIS

 use PerlMonksFacts;
 use URI;

 my $uri = URI->new(pm_url);
 $uri->query_form(pm_ticker xp => 'Aristotle');
 print $uri->as_string, "\n";

=head1 DESCRIPTION

This module abstracts working with the PerlMonks.org automation interfaces.
The main purpose is to put PerlMonks.org ticker URL generation in a blackbox.
As such, the main point of the module is the C<pm_ticker> function.

Since this module is intended to be as abstract as possible, the C<pm_ticker>
and C<pm_url> functions return raw key/value pairs. Their actual use is up to
you; see the L</"SYNOPSIS"> for an example of building a URI suitable for use
in a HTTP C<GET> request from them.

=head1 INTERFACE

=head2 %pm_nodetype

This hash contains a mapping of PerlMonks.org-internal node type names to human
readable versions. It is mostly cribbed from the code of the live Super Search
page of PerlMonks.org.

=head2 &pm_url

This is simply a constant function that returns "http://www.perlmonks.org".

=head2 &pm_ticker

This function takes the name of a ticker and possibly parameters for it and
returns a list of key/value pairs for URL construction. The following ticker
names are recognized:

=over 4

=item C<nn>, newest nodes xml generator

Takes one parameter - a L<perlfunc/time> style timestamp.

=item C<xp>, XP xml ticker

Optionally takes one parameter - a user name or user homenode ID for whose XP
should be tracked.

=item C<cb>, chatterbox xml ticker

No parameters.

=item C<msg>, private message xml ticker

No parameters.

=item C<users>, other users xml ticker

No parameters.

=item C<query>, node query xml generator

Takes any number of parameters, which should be node IDs for the nodes to query.

=item C<usernodes>, user nodes info xml generator

Takes one parameter: the user whose nodes are to be returned.

=item C<thread>, xml node thread

No parameters.

=back

=head2 &pm_login

This function takes a username and password as parameters and returns a list of
key/value pairs for URL construction.

=head2 &pm_time2unix

This function takes a timestamp in the format used in PerlMonks-generated XML
and returns a L<perlfunc/time> style timestamp.

=head1 BUGS

C<&pm_ticker> does not yet implement the C<types> parameter nor the C<days>
parameter to the newest nodes ticker.

=head1 AUTHOR

Aristotle Pagaltzis L<mailto:pagaltzis@gmx.de>

=head1 LICENSE

This software is in the public domain. It is distributed in the hope that it
will be useful, but B<without any warranty>; without even the implied warranty
of B<merchantability or fitness for a particular purpose>.

=cut

use strict;
use warnings;
no warnings 'once';

use Exporter::Lite;

our @EXPORT = qw(
	%pm_nodetype
	pm_url
	pm_ticker
	pm_login
	pm_time2unix
);

our %pm_nodetype = (
	bookreview             => 'Book Review',
	bug                    => '',
	categorized_answer     => 'Categorized Answer',
	categorized_question   => 'Categorized Question',
	container              => '',
	CUFP                   => 'Cool Uses For Perl',
	data                   => '',
	dbtable                => '',
	devtask                => '',
	document               => '',
	fullpage               => '',
	hint                   => '',
	htmlcode               => '',
	htmlpage               => '',
	image                  => '',
	linktype               => '',
	mail                   => '',
	maintenance            => '',
	modulereview           => 'Module Review',
	monkdiscuss            => 'Perl Monks Discussion',
	nodeball               => '',
	nodegroup              => '',
	nodeletgroup           => '',
	nodelet                => 'Nodelet',
	nodetype               => '',
	note                   => 'Note',
	obfuscated             => 'Obfuscation',
	opcode                 => '',
	patch                  => '',
	perlcraft              => 'Craft',
	perlexercise           => '',
	perlfunc               => 'Perl Function',
	perlman                => 'Perl Manpage',
	perlmeditation         => 'Meditations',
	perlnews               => 'News',
	perlquestion           => 'Seekers of Perl Wisdom',
	perlsolution           => '',
	perltutorial           => 'Tutorial',
	pmdevsuperdoc          => '',
	pmmodule               => '',
	poem                   => 'Poem',
	poll                   => 'Poll',
	quest                  => 'Quest',
	rawdata                => '',
	rawpage                => '',
	request                => '',
	restricted_superdoc    => '',
	review                 => '',
	scratchpad             => 'Scratch Pad',
	script                 => '',
	setting                => '',
	sitedoc                => '',
	sitefaqlet             => 'Monk Help',
	snippet                => 'Snippet',
	sourcecode             => 'Code',
	sourcecodesection      => '',
	strangedoc             => '',
	strangenode            => '',
	string                 => '',
	superdoc               => '',
	superquestionarea      => '',
	survey                 => '',
	testquestion           => '',
	testtype               => '',
	theme                  => '',
	themesetting           => '',
	usergroup              => '',
	user                   => 'User',
	wiki                   => 'Wiki',
	xmlpage                => '',
);

{
	while(my ($k, $v) = each %pm_nodetype) {
		$v ||= "\u\L$k";
		$v =~ s/(html|xml)/\u$1/i;
	}
}

sub pm_url () { "http://www.perlmonks.org/index.pl" }

{
	my %ticker_node = (
		nn        =>  30175 || "newest nodes xml generator",
		xp        =>  16046 || "XP xml ticker",
		cb        =>  15834 || "chatterbox xml ticker",
		msg       =>  15848 || "private message xml ticker",
		users     =>  15851 || "other users xml ticker",
		query     =>  37150 || "node query xml generator",
		usernodes =>  32704 || "user nodes info xml generator",
		thread    => 180684 || "xml node thread",
	);

	my %ticker_param = (
		xp        => sub { @_ ? ( ($_[0] =~ /\D/ ? 'for_user' : 'for_id') => $_[0] ) : () },
		nn        => sub { @_ ? ( sinceunixtime => $_[0] ) : () },
		query     => sub { nodes => join(',', @_ ? @_ : '') },
		usernodes => sub { foruser => $_[0] },
	);

	sub pm_ticker {
		my $ticker_name = shift;
		my $node = $ticker_node{$ticker_name}
			|| do { require Carp; Carp::croak("Unknown ticker name: $ticker_name") };
		my @param = do {
			$ticker_param{$ticker_name}->(@_)
				if @_ && exists $ticker_param{$ticker_name}
		};
		return (node => $node, @param);
	}
}

sub pm_login {
	my ($user, $pass) = @_;
	return (
		op      => "login",
		user    => $user,
		passwd  => $pass,
		ticker  => "yes",
	);
}

sub pm_time2unix {
	my ($Y, $M, $D, $h, $m, $s) = unpack "A4 A2 A2 A2 A2 A2", shift;
	$M--;
	require Time::Local;
	Time::Local::timegm($s, $m, $h, $D, $M, $Y);
}