File Coverage

blib/lib/E2/Node.pm

Criterion	Covered	Total	%
statement	46	132	34.8
branch	11	84	13.1
condition	1	16	6.2
subroutine	8	27	29.6
pod	12	15	80.0
total	78	274	28.4

# E2::Node
# Jose M. Weeks
# 11 July 2003
#
# See bottom for pod documentation.

package E2::Node;

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

use E2::Interface;

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

# Prototypes

sub new;

sub clear;

sub title;
sub node_id;
sub author;
sub author_id;
sub createtime;
sub type;

sub bookmark;

sub load;
sub load_by_id;
sub load_from_xml;

# Object Methods

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

	$self->clear;

	return $self;
}

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

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

	$self->{title}		= undef; # Title of the node
	$self->{node_id}	= undef; # node_id
	$self->{author}		= undef; # Author (node creator)
	$self->{author_id}	= undef; # user_id of author
	$self->{time}		= undef; # Creation time
	$self->{type}		= undef; # Writeup type

	return 1;
}

sub type_as_string {
	return undef;
}

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

	warn "E2::Node::autodetect\n"	if $DEBUG > 1;

	bless $self;
	return 1;
}

sub load {
	my $self  = shift or croak "Usage: load E2NODE, TITLE [, TYPE] [, SOFTLINK ]";
	my $title = shift or croak "Usage: load E2NODE, TITLE [, TYPE] [, SOFTLINK ]";
	my $type  = shift || $self->type_as_string;
	my $softlink = shift||0;

	warn "E2::Node::load\n"		if $DEBUG > 1;

	warn "Loading node $title"	if $DEBUG > 2;

	$softlink = $self->node_id	if $softlink == -1;

	warn "[softlinking $softlink]"	if $DEBUG > 2 && $softlink;

	my %opt;

	$opt{node}	  = $title;
	$opt{displaytype} = 'xmltrue';
	$opt{type}	  = $type	if $type;
	$opt{lastnode_id} = $softlink	if $softlink;

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

sub load_by_id {
	my $self = shift or croak "Usage: load_by_id E2NODE, NODE_ID [, SOFTLINK ]";
	my $id   = shift or croak "Usage: load_by_id E2NODE, NODE_ID [, SOFTLINK ]";
	my $softlink = shift||0;

	warn "E2::Node::load_by_id\n"	if $DEBUG > 1;

	warn "Loading node_id $id"	if $DEBUG > 2;

	$softlink = $self->node_id	if $softlink == -1;

	my %opt;

	$opt{node_id}	  = $id;
	$opt{displaytype} = 'xmltrue';
	$opt{lastnode_id} = $softlink	if $softlink;

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


sub load_from_xml {
	my $self = shift or croak "Usage: load_from_xml E2NODE, XML_STRING";
	my $xml	 = shift or croak "Usage: load_from_xml E2NODE, XML_STRING";

	warn "E2::Node::load_from_xml\n"	if $DEBUG > 1;

	my %type_to_class = (
		e2node		=> 'E2::E2Node',
		writeup 	=> 'E2::E2Node',
		user		=> 'E2::User',
		usergroup	=> 'E2::Usergroup',
		room		=> 'E2::Room',
		superdoc	=> 'E2::Superdoc',
		superdocnolinks	=> 'E2::Superdoc'
	);

	# Determine what type the XML says it is.

	$xml =~ /(.*?)<\/type>/s;
	my $verified_type = $1;

	if( !$verified_type ) {
		croak "Invalid document";
	}

	# If we hit a search page then the node doesn't exist
	# FIXME: search page

	if( ! ($xml =~ /]*node_id="(.*?)"/s) ) {
		croak "Invalid document";
	}

	if( $1 == 1140332 ) {
	#&& 				# Search node_id
	#    (!$type || lc($type) ne 'superdoc') ) {
	    	warn "Hit search superdoc"	if $DEBUG;
		$self->clear;
		return undef;
	}

	#if( $type && lc($type) ne lc($verified_type) ) {
	#	return undef;
	#}

	# Now, if we are an E2::Node, figure out what type of node
	# the XML is describing and bless $self into that class.

	if( ref($self) eq "E2::Node" ) {

		$self->clear;

		my $class = $type_to_class{$verified_type};
		if( !$class ) {
			croak "Invalid document";
		}

		# Convert class name to module name and
		# re-bless $self to that class.

		my $c = $class;
		$c =~ s/::/\//g;
		$c .= ".pm";

		require $c;
		bless $self, $class;

		warn "Autodetected type $class"		if $DEBUG > 2;

	# Otherwise, make sure the node is of the type
	# we expect.

	} else {
		if( lc($self->type_as_string) ne lc($verified_type) ) {
			croak "Wrong node type";
		}
	}

	# These are the default handlers. Descendants can add handlers by
	# returning a hash (of 'tag' => sub { ... } pairs) in the method
	# twig_handlers

	my %handlers = (
		'node' => sub {
			(my $a, my $b) = @_;
			$self->{node_id} = $b->{att}->{node_id};
			$self->{createtime} = $b->{att}->{createtime};
		},
		'node/type' => sub {
			(my $a, my $b) = @_;
			$self->{type} = $b->text;
		},
		'node/title' => sub {
			(my $a, my $b) = @_;
			$self->{title} = $b->text;
		},
		'node/author' => sub {
			(my $a, my $b) = @_;
			$self->{author} = $b->text;
			$self->{author_id} = $b->{att}->{user_id};
		}
	);

	my %h2 = $self->twig_handlers;

	if( %h2 ) {
		%handlers = ( %handlers, %h2 );  # Append twig_handlers
	}

	$self->clear;

	$self->parse_twig( $xml, \%handlers );

	return 1;
}

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

	warn "E2::Node::bookmark\n"	if $DEBUG > 1;

	if( !$self->logged_in ) {
		croak "Not logged in";
	}

	if( !$node_id ) {
		croak "No node specified";
	}

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

#---------------
# Access methods
#---------------

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

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

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

	return $self->{author};
}

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

	return $self->{author_id};
}

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

	return $self->{node_id};
}

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

	return $self->{title}
}

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

	return $self->{createtime};
}

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

	return $self->{type};
}

1;
__END__