view release on metacpan or  search on metacpan

Writeup.pm  view on Meta::CPAN

# E2::Writeup
# Jose M. Weeks <jose@joseweeks.com>
# 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;

Writeup.pm  view on Meta::CPAN

#		if( !($r =~ /<node /s ) ) {
#			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 =~ /<node /s ) ) {
			return undef;
		}

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

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