File Coverage

blib/lib/E2/Writeup.pm

Criterion	Covered	Total	%
statement	18	161	11.1
branch	0	104	0.0
condition	0	14	0.0
subroutine	6	28	21.4
pod	14	17	82.3
total	38	324	11.7

# E2::Writeup
# Jose M. Weeks
# 23 June 2003
#
# See bottom for pod documentation.

package E2::Writeup;

use 5.006;
use strict;
use warnings;
use Carp;
use HTML::Entities;

use E2::Node;

our @ISA = "E2::Node";
our $VERSION = "0.33";
our $DEBUG; *DEBUG = *E2::Interface::DEBUG;

# Prototypes

sub new;

sub clear;

sub wrtype;
sub parent;
sub parent_id;
sub marked;
sub rep;
sub text;
sub cools;
sub cool_count;

sub cool;

sub update;

# Private

sub type_as_string;
sub twig_handlers;
sub parse;

# Object Methods

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

	# See clear for the other members of $self

	$self->clear;
	return $self;
}

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

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

	$self->{author} 	= undef;
	$self->{author_id}	= undef;
	$self->{wrtype}		= undef;
	$self->{parent}		= undef;
	$self->{parent_id}	= undef;
	$self->{marked}		= undef; # Marked for destruction
	$self->{text}		= undef;
	$self->{cool_count}	= 0;

	$self->{rep}		= {};	# Hash with the following keys:
					#	o up
					#	o down
					#	o total
					#	o cast

	@{$self->{cools} }	= ();	# List of cools, each a hashref
					# with the following keys:
					#	o name # username of C!er
					#	o id   # user_id of C!er

	# Now clear parent

	return $self->SUPER::clear;
}

sub type_as_string {
	return 'writeup';
}

sub parse {
	my $self = shift	or croak "Usage: parse E2WRITEUP, TWIG";
	my $b = shift		or croak "Usage: parse E2WRITEUP, TWIG";

	warn "E2::Writeup::parse\n"	if $DEBUG > 1;

	# $b is an XML::Twig

	$self->{node_id}	= $b->{att}->{node_id};
	$self->{createtime}	= $self->decode_xml( $b->{att}->{createtime} );
	$self->{marked}		= $b->{att}->{marked};
	$self->{wrtype}		= $b->first_child('writeuptype')->text;

	my $c			= $b->first_child('parent')->
					first_child('e2link');

	$self->{parent}		= $self->decode_xml( $c->text );
	$self->{parent_id}	= $c->{att}->{node_id};

	$self->{title}   	= $self->decode_xml(
					$b->first_child('title')->text
				  );

	$c 			= $b->first_child('author');
	$self->{author}		= $self->decode_xml( $c->text );
	$self->{author_id}	= $c->{att}->{user_id};

	$c			= $b->first_child('doctext');
	if( $c ) {
		$self->{text} = $self->decode_xml($c->text);
	}

	$c			= $b->first_child('reputation');
	if( $c ) {
		$self->{rep}->{up}	= $c->{att}->{up};
		$self->{rep}->{down}	= $c->{att}->{down};
		$self->{rep}->{cast}	= $c->{att}->{cast};
		$self->{rep}->{total}	= $c->text;
	}

	@{ $self->{cools} }   = ();
	$self->{cool_count} = 0;

	if( my $cools = $b->first_child('cools') ) {
		foreach my $d ( $cools->children('e2link') ) {
			push @{ $self->{cools} }, {
				name => $self->decode_xml( $d->text ),
				id   => $d->{att}->{node_id}
			};
			$self->{cool_count}++;
		}
	}

	return 1;
}

sub twig_handlers {
	my $self = shift or croak "Usage: twig_handlers E2WRITEUP";

	return (
		'writeup' => sub {
			(my $a, my $b) = @_;
			$self->parse( $b );
		}
	);
}

sub cool {
	my $self = shift	or croak "Usage: cool E2WRITEUP [, NODE_ID ]";
	my $node_id = shift || $self->node_id;

	warn "E2::Writeup::cool\n"	if $DEBUG > 1;

	if( !$self->logged_in ) {
		warn "Unable to cool: not logged in"		if $DEBUG;
		return undef;
	}
	if( !$node_id ) {
		warn "Unable to cool: no node specified"	if $DEBUG;
		return undef;
	}

	return $self->thread_then(
		[
			\&E2::Interface::process_request,
			$self,
			node_id => $node_id,
			op	=> "cool",
			displaytype => "xmltrue"
		],
	sub {
		# FIXME: add check
		return 1;
	});
}

sub vote {
	my ($self, $vote) = @_;

	if( $vote != -1 && $vote != 1 ) {
		croak "Usage: vote E2WRITEUP, -1 | 1";
	}

	warn "E2::Writeup::vote\n"	if $DEBUG > 1;

	if( !$self->logged_in ) {
		warn "Unable to vote: not logged in"		if $DEBUG;
		return undef;
	}

	if( $self->this_user_id == $self->author_id ) {
		warn "Unable to vote on your own writeup"	if $DEBUG;
		return undef;
	}

	if( $self->rep->{cast} ) {
		warn "Unable to vote on a writeup more than once" if $DEBUG;
		return undef;
	}

	my %req = (
		node_id				=> $self->node_id,
		op				=> 'vote',
		displaytype			=> 'xmltrue',
		'vote__' . $self->node_id	=> $vote
	);

	return $self->thread_then(
		[
			\&E2::Interface::process_request,
			$self,
			%req
		],
	sub {
		my $r = shift;

#		if( !($r =~ /
#			return undef;
#		}

		# Parse, and if it parses, return rep->{cast}.

		return undef if ! $self->load_from_xml( $r );
		return $self->rep->{cast} || 0;
	});
}

sub reply {
	my $self = shift	or croak "Usage: reply E2WRITEUP, TEXT [, CC ]";
	my $text = shift	or croak "Usage: reply E2WRITEUP, TEXT [, CC ]";
	my $cc   = shift;

	warn "E2::Writeup::reply\n"	if $DEBUG > 1;

	if( !$self->logged_in ) {
		warn "Unable to reply: not logged in"		if $DEBUG;
		return undef;
	}

	if( !$self->exists ) {
		warn "Unable to reply: no writeup loaded"	if $DEBUG;
		return undef;
	}

	my $id = $self->node_id;
	my %req = (
		node_id		  => $id,
		op		  => 'vote',
		"msgwuauthor_$id" => $text
	);

	$req{"ccmsgwuauthor_$id"} = 1 if $cc;

	$self->thread_then(
		[
			\&E2::Interface::process_request,
			$self,
			%req
		],
	sub {
		my $r = shift;

		# Simple test. We can't send messages if we specify
		# displaytype=xmltrue, so we're stuck with the HTML
		# page. Hopefully any page formatting/theme issues
		# won't break this if we keep it small.

		if( ($r =~ /\(sent writeup message/s) &&
		    ($r =~ /you said "re/s) ) {
		    	return 1;
		}

		return 0;
	});
}

sub update {
	my $self = shift	or croak "Usage: update_writeup E2WRITEUP, TEXT [ , TYPE ]";
	my $text = shift	or croak "Usage: update_writeup E2WRITEUP, TEXT [ , TYPE ]";
	my $type_s = shift;
	my $type;

	warn "E2::Writeup::update\n"	if $DEBUG > 1;

	# Translate type to code

	my %h = (	person	=> 249,
			thing	=> 250,
			idea	=> 251,
			place	=> 252 );

	# Make sure we are logged-in and this is our writeup

	if( !$self->logged_in ) {
		warn "Unable to update: not logged in"		if $DEBUG;
		return undef;
	}

	if( lc($self->this_username) ne lc($self->author) )	{
		warn "Unable to update: not your writeup"	if $DEBUG;
		return undef;
	}

	if( !$type_s ) {
		$type_s = $self->wrtype;
	}

	$type = $h{ lc( $type_s ) };
	if( !$type ) {
		croak "Invalid type: $type_s";
	}

	# Request

	$self->thread_then(
		[
			\&E2::Interface::process_request,
			$self,
			node_id 	=> $self->node_id,
			writeup_wrtype_writeuptype => $type,
			displaytype	=> "xmltrue",
			sexisgood	=> "submit",
			writeup_doctext	=> $text
		],
	sub {
		my $r = shift;

		if( !($r =~ /
			return undef;
		}

		return $self->load_from_xml( $r );
	});
}

#---------------
# Access Methods
#---------------

sub wrtype {
	my $self = shift or croak "Usage: wrtype E2WRITEUP";
	return $self->{wrtype};
}

sub parent {
	my $self = shift or croak "Usage: parent E2WRITEUP";
	return $self->{parent};
}

sub parent_id {
	my $self = shift or croak "Usage: parent_id E2WRITEUP";
	return $self->{parent_id};
}

sub marked {
	my $self = shift or croak "Usage: marked E2WRITEUP";
	return $self->{marked};
}

sub rep {
	my $self = shift or croak "Usage: rep E2WRITEUP";

	return $self->{rep};
}

sub text {
	my $self = shift or croak "Usage: text E2WRITEUP";
	return $self->{text};
}

sub cool_count {
	my $self = shift or croak "Usage: cool_count E2WRITEUP";
	return $self->{cool_count};
}

sub cools {
	my $self = shift or croak "Usage: cools E2WRITEUP";
	return () if ! defined $self->{cools};

	return @{ $self->{cools} };
}

1;
__END__