File Coverage

blib/lib/E2/E2Node.pm

Criterion	Covered	Total	%
statement	40	159	25.1
branch	3	102	2.9
condition	1	9	11.1
subroutine	10	32	31.2
pod	16	18	88.8
total	70	320	21.8

# E2::E2Node
# Jose M. Weeks
# 03 July 2003
#
# See bottom for pod documentation.

package E2::E2Node;

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

use E2::Node;
use E2::Writeup;

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

# Prototypes

sub new;
sub clear;

sub has_mine;
sub is_locked;

sub list_writeups;
sub list_softlinks;
sub list_firmlinks;
sub list_sametitles;

sub get_writeup;
sub get_writeup_by_author;
sub get_my_writeup;
sub get_writeup_number;
sub get_writeup_count;

sub vote;

sub add_writeup;
sub create;

# Private

sub type_as_string;
sub twig_handlers;

# 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 E2E2NODE";

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

	@{ $self->{writeups} } = ();	 # Array to hold writeups in currently
					 # loaded node. See E2::Writeup.

	$self->{locked}		= undef; # soft locked

	$self->{next}		= 0;	 # Next writeup to return
	$self->{mine}		= undef; # My writeup in this node.

	@{ $self->{firmlinks} }	= ();	 # List of firmlinks
	@{ $self->{softlinks} }	= ();	 # List of softlinks
	@{ $self->{sametitles}}	= ();	 # List of sametitles
					 # The preceding three return hashrefs
					 # with the following keys:
					 # 	o title
					 # 	o id
					 # sametitles has this as well:
					 # 	o type

	# Now clear parent

	return $self->SUPER::clear;
}

sub has_mine {
	my $self = shift	or croak "Usage: has_mine E2E2NODE";

	if(!$self->node_id)	{ return undef; }	# No node loaded

	if( defined( $self->{mine} ) ) {
		return 1;
	}

	return 0;
}

sub is_locked {
	my $self = shift	or croak "Usage: is_locked E2E2NODE";

	if( !$self->node_id )	{ return undef; }

	if( $self->{locked} )	{ return 1; }
	else			{ return 0; }
}

sub list_softlinks {
	my $self = shift	or croak "Usage: list_softlinks E2NODE";

	return undef if !$self->node_id;

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

sub list_firmlinks {
	my $self = shift	or croak "Usage: list_firmlinks E2NODE";

	return undef if !$self->node_id;

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

sub list_sametitles {
	my $self = shift	or croak "Usage: list_sametitles E2NODE";

	return undef if !$self->node_id;

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

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

	return (

		'node/nodelock' => sub {
			(my $a, my $b) = @_;
			$self->{locked} = $b->text;
			if( $self->{locked} eq "" ) {
				$self->{locked} = undef;
			}
		},
		'node/writeup' => sub {
			(my $a, my $b) = @_;

			my $wu = new E2::Writeup;
			$wu->clone( $self );
			$wu->parse( $b );

			my $name = $self->this_username;
			my $uid = $self->this_user_id;

			if( $self->logged_in &&
				($uid ?	$uid == $wu->author_id :
					lc($name) eq lc($wu->author)) ) {
				$self->{mine} = @{ $self->{writeups} };
			}

			push @{ $self->{writeups} }, $wu;
		},
		'node/softlinks/e2link' => sub {
			(my $a, my $b) = @_;
			push @{ $self->{softlinks} }, {
				title => $b->text,
				id    => $b->{att}->{node_id}
			};
		},
		'node/firmlinks/e2link' => sub {
			(my $a, my $b) = @_;
			push @{ $self->{firmlinks} }, {
				title => $b->text,
				id    => $b->{att}->{node_id}
			};
		},
		'node/sametitles/nodesuggest' => sub {
			(my $a, my $b) = @_;
			my $c = $b->first_child( 'e2link' );
			push @{ $self->{sametitles} }, {
				title => $c->text,
				type  => $b->{att}->{type},
				id    => $c->{att}->{node_id}
			};
		}
	);
}

sub type_as_string {
	return 'e2node';
}

sub list_writeups {
	my $self = shift	or croak "Usage: list_writeups E2E2NODE";

	return undef if !$self->exists;
	return @{ $self->{writeups} };
}

sub get_writeup {
	my $self = shift	or croak "Usage: get_writeup E2E2NODE [ , NUM ]";
	my $num  = shift;

	if( $num ) {
		$self->{next} = $num;
	}

	return $self->{writeups}[ $self->{next}++ ];
}

sub get_writeup_by_author {
	my $self   = shift
		or croak "Usage: get_writeup_by_author E2E2NODE, AUTHOR";
	my $author = shift
		or croak "Usage: get_writeup_by_author E2E2NODE, AUTHOR";

	if( !$self->node_id ) { return undef; }

	for( my $i = 0; $i < @{ $self->{writeups} }; $i++ ) {
		if( lc($author) eq
		    lc($self->{writeups}[$i]->author) ) {
			return $self->{writeups}[$i];
		}
	}

	return 0;
}

sub get_my_writeup {
	my $self = shift	or croak "Usage: get_my_writeup E2E2NODE";
	my $i = $self->{mine};

	if( ! defined $i ) { return undef; }

	return $self->{writeups}[$i];
}

sub get_writeup_number {
	my $self = shift	or croak "Usage: get_writeup_number E2E2NODE";

	if( !$self->node_id ) { return undef; }
	return $self->{next};
}

sub get_writeup_count {
	my $self = shift	or croak "Usage: get_writeup_count E2E2NODE";

	if( !$self->node_id ) { return undef; }

	return $$self->{writeups};
}

sub create {
	my $self  = shift	or croak "Usage: create E2E2NODE, TITLE";
	my $title = shift	or croak "Usage: create E2E2NODE, TITLE";

	warn "E2::E2Node::create\n"	if $DEBUG > 1;

	# Make sure we have username & user_id

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

	return $self->thread_then(
		[
			\&E2::Interface::process_request,
			$self,
			node 	=> $title,
		  	op	=> "new",
		  	type	=> "e2node",
		  	displaytype => "xmltrue",
		  	e2node_createdby_user => $self->{user_id}
		],
	sub {

		my $r = shift;
		if( !$r =~ /
			croak "Invalid document";
		}

		$self->load_from_xml( $r );

		return $self->exists;
	});
}

# FIXME: Allow multiple votes/replies/etc. in one request.

sub vote {
	my $self = shift or croak "Usage: vote E2E2NODE, NODE_ID => VOTE [ , NODE_ID2 = VOTE2 [ , ... ] ]";
	my %list = @_    or croak "Usage: vote E2E2NODE, NODE_ID => VOTE [ , NODE_ID2 = VOTE2 [ , ... ] ]";

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

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

	my %params = (	node_id		=> $self->{node_id},
			op		=> "vote",
			displaytype	=> "xmltrue");

	foreach( keys %list ) {
		my $v = $list{$_};

		if( $v != 1 && $v != -1 ) { next; }

		$params{ "vote__$_" } = $v;
	}

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

		if( !($r =~ /
			croak 'Invalid document';
		}

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

sub add_writeup {
	my $self = shift
	  or croak "Usage: add_writeup E2E2NODE, TEXT, TYPE [ , NODISPLAY ]";
	my $text = shift
	  or croak "Usage: add_writeup E2E2NODE, TEXT, TYPE [ , NODISPLAY ]";
	my $type = shift
	  or croak "Usage: add_writeup E2E2NODE, TEXT, TYPE [ , NODISPLAY ]";
	my $nodisplay = shift;

	warn "E2::E2Node::add_writeup\n"	if $DEBUG > 1;

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

	return $self->thread_then(
		[
			\&E2::Interface::process_request,
			$self,
			node	=> "new writeup",
			op	=> "new",
			type	=> "writeup",
			node	=> $self->{node_id},	# Why two "node" params?
			writeup_notnew	=> $nodisplay,  # dunno....
			writeup_doctext	=> $text,
			writeup_parent_e2node	=> $self->{node_id},
			writeuptype	=> $type
		],
	sub {

		# FIXME - Add code to test for success.

		return 1;
	});
}

1;
__END__