The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# E2::UserSearch
# Jose M. Weeks <jose@joseweeks.com>
# 06 July 2003
#
# See bottom for pod documentation.

package E2::UserSearch;

use 5.006;
use strict;
use warnings;
use Carp;

use E2::Ticker;
use E2::Writeup;

our $VERSION = "0.33";
our @ISA = qw(E2::Ticker);
our $DEBUG; *DEBUG = *E2::Interface::DEBUG;

sub new;
sub clear;

sub writeups;
sub sort_results;

sub new {
	my $arg   = shift;
	my $class = ref( $arg ) || $arg;
	my $self  = $class->SUPER::new();

	bless ($self, $class);

	$self->clear;

	return $self;
}

sub clear {
	my $self = shift or croak "Usage: clear E2USERSEARCH";

	warn "E2::UserSearch::clear\n"	if $DEBUG > 1;

	$self->{lastuser} 	= undef;	# username of last user searched
	@{ $self->{writeups} } 	= ();		# list of E2::Writeup

	return 1;
}

sub writeups {
	my $self = shift or croak "Usage: writeups E2USERSEARCH [ USER ] [, SORT_BY ] [, COUNT ] [, STARTAT ]";
	my $user = shift || $self->this_username;
	my $sort_by = shift;
	my $count = shift;
	my $startat = shift;

	warn "E2::UserSearch::writeups\n"	if $DEBUG > 1;
	
	if( !$user ) { 
		warn "No user specified and not logged in" if $DEBUG;
		return undef;
	}

	my %opt;

	$opt{searchuser} = $user;
	$opt{startat} = $startat	if $startat;

	if( $sort_by ) {
		$sort_by = lc($sort_by);
		if( $sort_by ne 'rep' && $sort_by ne 'creation' &&
			$sort_by ne 'title' ) {
			croak "Invalid search option: $sort_by";
		}

		$opt{sort} = $sort_by;
	} else {
		$opt{nosort} = 1;
		$sort_by = "none";
	}

	if( $count && $count == -1 ) { # Get all
		$opt{nolimit} = 1;
	} elsif( $count ) {
		$opt{count} = $count;
	}

	$user = lc( $user );

	# We don't add this search to the last if this is a
	# search on a new user.

	if( $self->{lastuser} && $self->{lastuser} ne $user ) {
		$self->clear;
	}

	# Ugly stuff, but this keeps our place so we
	# can determine the rep-based order of
	# writeups across multiple search loads.

	$self->{rep_number} = 100000 - ($startat || 0);

	my $handlers = {
		'wu' => sub {
			(my $a, my $b) = @_;
			my $wu = new E2::Writeup;

			$wu->{type} = 'writeup';

			$wu->{createtime} = $b->{att}->{createtime};
			$wu->{marked}	= $b->{att}->{marked};
			$wu->{hidden}	= $b->{att}->{hidden};
			$wu->{wrtype}	= $b->{att}->{wrtype};

			$wu->{cool_count} = $b->{att}->{cools};

			if( my $rep = $b->first_child('rep') ) {
				$wu->{rep}->{up} = $rep->{att}->{up};
				$wu->{rep}->{down} = $rep->{att}->{down};
				$wu->{rep}->{total} = $rep->text;
			}
	
			if( my $lnk = $b->first_child( 'e2link' ) ) {
				$wu->{title} = $lnk->text;
				$wu->{node_id} = $lnk->{att}->{node_id};
			}

			if( my $parent = $b->first_child( 'parent' ) ) {
				my $l = $parent->first_child('e2link');
				$wu->{parent} = $l->text;
				$wu->{parent_id} = $l->{att}->{node_id};
			}

			# We're going to add a value to the E2::Writeup.
			# This is sort of a kludgy thing to do, but
			# the situation (having to infer reputation
			# based upon context) means we've got to store
			# it somewhere.

			if( $sort_by eq 'rep' ) {
				$wu->{_rep_position} = $self->{rep_number}--;
			} else {
				$wu->{_rep_position} = 0;
			}

			push @{ $self->{writeups} }, $wu;
		}
	};

	@{$self->{writeups}} = (); # clear

	return $self->parse(
		'usersearch',
		$handlers,
		$self->{writeups},
		%opt
	);
}

sub sort_results {
	my $self = shift or croak "Usage: sort_results E2USERSEARCH [, SORTBY [ , COUNT [ , STARTAT ] ] ]";
	my $sortby = shift;
	my $count = shift;
	my $startat = shift;

	my $sort;

	warn "E2::UserSearch::sort_results\n"	if $DEBUG > 1; 

	# Define a bunch of sort routines
	# (This whole thing is a mess..... ugly...... but it works)

	sub sort_by_creation {
		$b->{createtime} =~ /(....)-(..)-(..) (..):(..):(..)/;
		(my $year1, my $month1, my $day1, my $hour1, my $min1, my $sec1 )
			= ($1, $2, $3, $4, $5, $6);
		$a->{createtime} =~ /(....)-(..)-(..) (..):(..):(..)/;
		(my $year2, my $month2, my $day2, my $hour2, my $min2, my $sec2 )
			= ($1, $2, $3, $4, $5, $6);

		$year1 <=> $year2 || $month1 <=> $month2 || $day1 <=> $day2 ||
			$hour1 <=> $hour2 || $min1 <=> $min2 || $sec1 <=> $sec2;
	};		

	sub sort_by_creation_reverse {
		$a->{createtime} =~ /(....)-(..)-(..) (..):(..):(..)/;
		(my $year1, my $month1, my $day1, my $hour1, my $min1, my $sec1 )
			= ($1, $2, $3, $4, $5, $6);
		$b->{createtime} =~ /(....)-(..)-(..) (..):(..):(..)/;
		(my $year2, my $month2, my $day2, my $hour2, my $min2, my $sec2 )
			= ($1, $2, $3, $4, $5, $6);

		$year1 <=> $year2 || $month1 <=> $month2 || $day1 <=> $day2 ||
			$hour1 <=> $hour2 || $min1 <=> $min2 || $sec1 <=> $sec2;
	};		

	sub sort_by_title { $a->title cmp $b->title };

	sub sort_by_title_reverse { $b->title cmp $a->title };

	sub sort_by_rep { ($b->rep->{total} || 0) <=> ($a->rep->{total} || 0) };

	sub sort_by_rep_position { $b->{_rep_position} <=> $a->{_rep_position} };

	sub sort_by_rep_position_reverse { $a->{_rep_position} <=> $b->{_rep_position} };

	sub sort_by_rep_reverse { ($a->rep->{total} || 0) <=> ($b->rep->{total} || 0) };

	sub sort_by_cools { $b->cool_count <=> $a->cool_count };

	sub sort_by_cools_reverse { $a->cools <=> $a->cools };

	sub sort_by_random{ int(rand(3))-1 };
	
	if( !$count )   { $count = -1; }
	if( !$startat ) { $startat = 0; }

	# Determine which way we want to sort and stick the method
	# into the subroutine $sort.

	if( ! defined $sortby ) {
		$sort = sub { sort_by_creation; }
	} elsif( ref( $sortby ) eq 'CODE' ) {
		$sort = $sortby;
	} elsif( lc($sortby) eq "creation" ) {
		$sort = sub { sort_by_creation; }
	} elsif( lc($sortby) eq "title" ) {
		$sort = sub { sort_by_title; }
	} elsif( lc($sortby) eq "rep" ) {
		$sort = sub { sort_by_rep || sort_by_rep_position || sort_by_creation; }
	} elsif( lc($sortby) eq "cools" ) {
		$sort = sub { sort_by_cools || sort_by_rep || sort_by_rep_position; }
	} elsif( lc($sortby) eq "creation_reverse" ) {
		$sort = sub { sort_by_creation_reverse; }
	} elsif( lc($sortby) eq "title_reverse" ) {
		$sort = sub { sort_by_title_reverse; }
	} elsif( lc($sortby) eq "rep_reverse" ) {
		$sort = sub { sort_by_rep_reverse || sort_by_rep_position_reverse ||
			sort_by_creation_reverse; }
	} elsif( lc($sortby) eq "cools_reverse" ) {
		$sort = sub { sort_by_cools_reverse || sort_by_rep_reverse ||
			sort_by_rep_position_reverse; }
	} elsif( lc($sortby) eq "random" ) {
		$sort = sub { sort_by_random; }
	} else {
		croak "Invalid sort type: $sortby";
	}

	# Sort

	my @sorted = sort $sort @{ $self->{writeups} };

	if( $count == -1 ) { return @sorted; }

	return splice @sorted, $startat, $count;
}

sub compare {
	my $self  = shift or croak "Usage: compare E2USERSEARCH, OLDUSERSEARCH";
	my $old   = shift or croak "Usage: compare E2USERSEARCH, OLDUSERSEARCH";

	warn "E2::UserSearch::compare\n"	if $DEBUG > 1;

	if( ! $self->{writeups} || ! $old->{writeups} ) {
		warn"Usersearch not loaded"	if $DEBUG;
		return undef;
	}

	my $stats;
	my @changes;

	# Build a mapping of node_id to node for $old

	my %map;

	foreach( @{$old->{writeups}} ) {
		$map{$_->node_id} = $_;
	}

	foreach( $self->sort_results( 'rep' ) ) {

		my $writeup = {
			title	  => $_->title,
			node_id   => $_->node_id,
			parent    => $_->parent,
			parent_id => $_->parent_id,
			rep	  => $_->rep,
			cools	  => $_->cool_count
		};

		# Get stats

		my $r = $_->rep->{total};

		if( !defined $stats->{min_rep} || $r < $stats->{min_rep} ) {
			$stats->{min_rep} = $r;
		}

		if( !defined $stats->{max_rep} || $r > $stats->{max_rep} ) {
			$stats->{max_rep} = $r;
		}

		# Store statistics

		$stats->{total_rep} += $r;
		$stats->{total_cools} += $_->cool_count;
		$stats->{$_->wrtype} += 1;

		# Get changes

		my $id = $_->node_id;
		my $changed = undef;
	
		if( !$map{$id} ) { # New writeup (not yet stored)
			$writeup->{new} = 1;
			$writeup->{change_up}		= $_->rep->{up};
			$writeup->{change_down}		= $_->rep->{down};
			$writeup->{change_cools}	= $_->cool_count;

			$changed = 1;

		} else {
		
			sub wr_diff {
				my ($a, $b) = @_;
				return $a->rep->{up} != $b->rep->{up} ||
					$a->rep->{down} != $b->rep->{down} ||
					$a->cool_count != $b->cool_count;
			}

			if( wr_diff( $_, $map{$id} ) ) {
			
				$writeup->{change_up} = $_->rep->{up} -
					$map{$id}->rep->{up};
				$writeup->{change_down} = $_->rep->{down} -
					$map{$id}->rep->{down};
				$writeup->{change_cools} = $_->cool_count -
					$map{$id}->cool_count;

				$changed = 1;
			}

			if( $_->title ne $map{$id}->title ) {
				$writeup->{old_title} = $map{$id}->title;
			
				$changed = 1;
			}

			delete $map{$id};
		}
		
		push @changes, $writeup		if $changed;
	}

	# Now store removed writeups

	foreach( keys %map ) {
		push @changes, {
			title => $_->title,
			rep   => $_->rep,
			cools => $_->cools,
			removed => 1
		}
	}
		
	# Store

	$self->{stats} = $stats;

	return @changes;
}

sub stats {
	my $self = shift	or croak "Usage: stats E2USERSEARCH";

	return $self->{stats};
}

1;
__END__

=head1 NAME

E2::UserSearch - A module for listing and sorting a user's writeups

=head1 SYNOPSIS

	use E2::UserSearch;

	# Display homenode info

	my $user = new E2::UserSearch;

	$user->login( "Simpleton", "passwd" );	# Login so I can
						# load reps too

	# Load all writeups, unsorted.

	my @w = $user->writeups( "Simpleton", undef, -1 );

	# List the writeups

	print "All Simpleton's writeups:\n";
	print "-------------------------\n";
	foreach( @w ) {
		print $_->title . " : " . $_->rep->{total};
		print " : " . $_->cool_count . "C!" if $_->cool_count;
		print "\n";
	}

	# Now sort them by cools

	@w = $user->sort_results( 'cools' );

	# List the writeups

	print "\nAll Simpleton's writeups, sorted by cools:\n";
	print "------------------------------------------\n";
	foreach( @w ) {
		print $_->title . " : " . $_->rep->{total};
		print " : " . $_->cool_count . "C!"  if $_->cool_count;
		print "\n";
	}

=head1 DESCRIPTION

This module provides an interface to E2's user search (search for writeups by user). It inherits L<E2::Ticker|E2::Ticker>.

=head1 CONSTRUCTOR

=over

=item new

C<new> creates an C<E2::UserSearch> object.

=back

=head1 METHODS

=over

=item $user-E<gt>writeups [ USERNAME ] [, SORT_BY ] [, COUNT ] [, START_AT ]

C<writeups> does a "writeups by user" search on the user (USERNAME defaults the username of the currently-logged-in user; if no user is logged in, USERNAME must be specified or a "No username specified" error is thrown) for COUNT number of writeups (defualt is 50), starting at START_AT (which is an offset from the highest writeup as ranked by SORT_BY--more on that later), which defaults to 0. If -1 is passed as the COUNT, this method will fetch ALL writeups by the specified user. For many users, this would be a pretty big hit on the database. The suggested method is to space calls to C<writeups> over a period of time, perhaps only displaying a page at a time/etc. When you receive less writeups than you asked for, you'll have hit the final page of the writeups search.

SORT_BY can be any of 'rep', 'title', 'creation', or C<undef> (in which case, the writeups are not in any particular order). Now C<sort_results> will do client-side sorting, which at first glance would make SORT_BY = C<undef> seem the most consciencious choice (which I suppose it is), but client-side searching can not replicate all the functionality of server-side sorting for two reasons: 1) We can only sort what we have, so if we fetch the fifty most-recent writeups by a noder who's written 500, sorting them by title will yield, well, the fifty most-recent writeups by this user, sorted by title. This is quite different from what C<writeups( 'title', 50 )> would yield. And 2) most users can't sort by 'rep' client-side for any users other than themselves (they have no access to other users' reps without voting on all the writeups and then loading those writeups to fetch their rep).

C<writeups>, for all those searches called with SORT_BY = 'rep', will remember the reputation order of all writeups that it can, so if you wish to sort by 'rep' at all, I suggest you do all your searching ordered by 'rep'. I also suggest that SORT_BY = C<undef> will yield meaningless results on any client-side sorting unless a search of all the user's writeups has taken place (all at once, or over multiple calls).

C<writeups> returns a list of E2::Writeup. These do not contain doctext (C<$writeup-E<gt>text>), hold a value for C<$writeup-E<gt>cool_count> but not the (list) C<$writeup-E<gt>cools>, and may or may not have any C<$writeup-E<gt>rep> or C<$writeup-E<gt>marked> information.

Exceptions: 'Unable to process request', 'Parse error:'

=item $user-E<gt>sort_results [ SORT_BY ] [, COUNT ] [, START_AT ]

C<sort_results> sorts and returns a list of writeups (E2::Writeups) fetched from e2 by C<writeups>. COUNT is the maximum number of writeups to fetch (-1 for ALL, which is the default), START_AT is an offset from the highest ranked writeup (ranked by SORT_BY), which defaults to 0.

SORT_BY can be one of 'rep', 'title', 'creation', 'cools', or 'random', as well as 'rep_reverse', 'title_reverse', and 'creation_reverse'. It can also be a code reference which will be passed to perl's C<sort> function. A number of aliases are provided by C<sort_results>, to define particular sorting orders. For example, a 'cools' search is actually a call to C<( sort_by_cools || sort_by_rep || sort_by_rep_position )>. Each test is executed only if the test to its left returns an 'is equal' result (0).  The aliases that can be used are as follows:

	sort_by_creation;
	sort_by_creation_reverse; 
	sort_by_title;
	sort_by_title_reverse;	
	sort_by_rep;			# Sorts by known rep
	sort_by_rep_reverse;
	sort_by_rep_position;		# Sorts by implied rep (from 
	sort_by_rep_position_reverse;	# server-side 'rep' sort)
	sort_by_cools;
	sort_by_cools_reverse;
	sort_by_random;

	# Example: Sorts by cools, then title

	my @list = $user->sort_results( sub { sort_by_cools || sort_by_title } );

	# Or, sort by writeup type, then creation time.

	my @list = $user->sort_results( 
		sub { 
			$a->wrtype cmp $b->wrtype || sort_by_creation
		}
	);

C<sort_results> returns a list of E2::Writeup.  These do not contain doctext (C<$writeup-E<gt>text>), hold dummy values for C! (so C<$writeup-E<gt>cools> returns the correct value only in a scalar context), and may not have any C<$writeup-E<gt>rep> information.

Exceptions: 'Invalid sort type:'

=item $user-E<gt>compare OLD_USER_SEARCH

This method compares this E2::UserSearch with another, returning a list of hashrefs corresponding to each writeup that differs between the two. Each element of the list may have the following keys:

	title		# Title of the writeup
	node_id		# node_id of the writeup
	parent		# Title of the writeup's parent
	parent_id	# node_id of the writeup's parent

	rep		# Hashref with the keys: up, down, total, and cast
	cools		# C! count

	change_up	# Number of additional upvotes
	change_down	# Number of additional downvotes
	change_cools	# Number of additional C!s

	old_title	# Former title of the writeup (if title has changed)
	new		# Boolean: Is this writeup new?
	removed		# Boolean: Has this writeup been removed (nuked)?

C<compare> also has the side-effect of storing various statistical information about the usersearch, which is then available by calling C<stats>.

=item $user-E<gt>stats

This method returns statistical information about this usersearch. This is loaded by calling C<compare>. It returns a hashref with the folowing keys:

	max_rep		# The highest reputation of any of this user's writeups
	min_rep		# The lowest reputation of any of this user's writeups
	total_cools	# The accumulated number of C!s this user has received

	person		# The number of writeups this user has of type 'person'
	place		# ditto for 'place'
	thing		# and 'thing'
	idea		# and 'idea'

=back

=head1 SEE ALSO

L<E2::Interface>,
L<E2::Ticker>,
L<E2::User>,
L<E2::Writeup>,
L<http://everything2.com>,
L<http://everything2.com/?node=clientdev>

=head1 AUTHOR

Jose M. Weeks E<lt>I<jose@joseweeks.com>E<gt> (I<Simpleton> on E2)

=head1 COPYRIGHT

This software is public domain.

=cut