ViewVC Help

View File | Revision Log | Show Annotations | Root Listing

root/cvsroot/COMP/SCRAM/src/ActiveDoc/SimpleXMLURLDoc.pm

Comparing COMP/SCRAM/src/ActiveDoc/SimpleXMLURLDoc.pm (file contents):
Revision 1.1 by sashby, Tue Jul 26 15:13:59 2005 UTC vs.
Revision 1.6 by sashby, Mon Feb 13 17:29:25 2006 UTC

#	Line 1 | Line 1
1	+	#____________________________________________________________________
2	+	# File: ActiveDoc::SimpleXMLURLDoc.pm
3	+	#____________________________________________________________________
4	+	#
5	+	# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6	+	# Update: 2005-12-02 17:44:08+0100
7	+	# Revision: $Id$
8		#
9	<	# Added XML support: SFA 26/07/05
9	>	# Copyright: 2005 (C) Shaun Ashby
10		#
11	<	# SimpleXMLURLDoc.pm. - Extends SimpleDoc with URL download functionality
12	<	#
13	<	# Originally Written by Christopher Williams
14	<	#
15	<	# Description
16	<	# -----------
17	<	#
18	<	# Interface
19	<	# ---------
20	<	# new(URLcache[,DocVersionTag]  : A new SimpleXMLURLDoc object. You can also
21	<	#                                 specify an alternative doc version tag
22	<	# addbasetags(parse)    : Add Base Tags to the given parse
23	<	# urlget(urlstring[,location]) : get the given url - using the cache.
24	<	#                                Returns (url, filename)
25	<	# urldownload(urlstring[,location]) : get the given url ignoring any cached
26	<	#                                       version. Returns (url, filename)
27	<	# expandurl(urlstring)  : return a URLclass object of the given url expanded
28	<	#                         according to the base settings
29	<	# cache([cache])        : get/set the current URL cache
30	<	# doctype()             : return the (type,version) of the document
31	<	#                         as specified by the DocVersionTag
11	>	#--------------------------------------------------------------------
12	>
13	>	=head1 NAME
14	>
15	>	ActiveDoc::SimpleXMLURLDoc - Base class for URL-based SCRAM documents.
16	>
17	>	=head1 SYNOPSIS
18	>
19	>	my $obj = ActiveDoc::SimpleXMLURLDoc->new();
20	>
21	>	=head1 DESCRIPTION
22	>
23	>	Any document class inheriting from ActiveDoc::SimpleXMLURLDoc will have access to
24	>	URL handling.
25	>
26	>	=head1 METHODS
27	>
28	>	=over
29	>
30	>	=cut
31	>
32		package ActiveDoc::SimpleXMLURLDoc;
33		use ActiveDoc::SimpleXMLDoc;
34		use URL::URLhandler;
35	<	require 5.001;
36	<	@ISA=qw(ActiveDoc::SimpleXMLDoc);
35	>	require 5.004;
36	>	use Exporter;
37	>	use vars qw(@ISA);
38	>
39	>	@ISA=qw(Exporter ActiveDoc::SimpleXMLDoc);
40	>	@EXPORT_OK=qw( );
41
42	<	sub new {
43	<	my $class=shift;
44	<	my $self={};
45	<	bless $self, $class;
46	<	$self->cache(shift);
47	<	$self->_initdoc("doc",@_);
48	<	return $self;
49	<	}
42	>	sub new()
43	>	{
44	>	###############################################################
45	>	# new                                                         #
46	>	###############################################################
47	>	# modified : Fri Dec  2 17:44:11 2005 / SFA                   #
48	>	# params   :                                                  #
49	>	#          :                                                  #
50	>	# function :                                                  #
51	>	#          :                                                  #
52	>	###############################################################
53	>	my $proto=shift;
54	>	my $class=ref($proto) || $proto;
55	>	my ($urlcache,$context,@defhandlers)=@_;
56	>	my $self= bless($proto->SUPER::new($context,@defhandlers),$class);
57	>	$self->{CONTEXT}=$context;
58	>	# Register supported tags for this doc class, and specify which
59	>	# attributes should be checked for:
60	>	my $nested = 1;
61	>	my $unnested = 0;
62	>	my %recognised_tags = ('base' => [ { 'url' => 'REQUIRED' }, $nested ],
63	>	'download' => [ { 'url' => 'REQUIRED', 'name' => 'OPTION' }, $unnested ]);
64	>
65	>	# Register these recognised tags to the base class (which registers them
66	>	# to the container class):
67	>	$self->register_handlers_(\%recognised_tags);
68	>
69	>	# Set up a URL cache:
70	>	$self->cache($urlcache);
71	>	return $self;
72	>	}
73
74	<	sub addbasetags
74	>	sub cache
75		{
76		my $self=shift;
77	<	my $parse=shift;
77	>
78	>	if ( @_ )
79	>	{
80	>	$self->{cache}=shift;
81	>	$self->urlhandler_(URL::URLhandler->new($self->{cache}));
82	>	}
83
84	<	$self->registerTag($parse, "base",
85	<	\&basetaghandler,
86	<	[ "url" ],
87	<	1);
88	<	}
89	<
90	<	sub cache {
91	<	my $self=shift;
92	<	if ( @_ ) {
93	<	$self->{cache}=shift;
94	<	$self->{urlhandler}=URL::URLhandler->new($self->{cache});
95	<	}
96	<	return $self->{cache};
97	<	}
98	<
60	<	sub expandurl {
61	<	my $self=shift;
62	<	my $urlstring=shift;
63	<
64	<	return $self->{urlhandler}->expandurl($urlstring);
65	<	}
66	<
67	<	sub urldownload {
68	<	my $self=shift;
69	<	my $urlstring=shift;
70	<
71	<	($fullurl,$filename)=$self->{urlhandler}->download($urlstring, @_);
72	<	if ( ( ! defined $filename ) || ( $filename eq "" ) ) {
73	<	$self->parseerror("Failed to get $fullurl");
74	<	}
75	<	return ($fullurl,$filename);
76	<	}
77	<
78	<	sub urlget {
79	<	my $self=shift;
80	<	my $urlstring=shift;
81	<
82	<	($fullurl,$filename)=$self->{urlhandler}->get($urlstring, @_);
83	<
84	<	if ( ( ! defined $filename ) || ( $filename eq "" ) ) {
85	<	$self->parseerror("Failed to get $fullurl");
86	<	}
87	<	return ($fullurl,$filename);
88	<	}
89	<
90	<	# ------------------------ Support Routines ---------------------------
91	<
92	<	# ------------------------ Tag Routines -------------------------------
93	<	sub basetaghandler()
94	<	{
95	<	my ($name, $hashref, $nesting)=@_;
96	<	# No action for Char handler:
97	<	return if ($nesting == 2);
84	>	return $self->{cache};
85	>	}
86	>
87	>	sub expandurl
88	>	{
89	>	my $self=shift;
90	>	my $urlstring=shift;
91	>	return $self->urlhandler_()->expandurl($urlstring);
92	>	}
93	>
94	>	sub urldownload
95	>	{
96	>	my $self=shift;
97	>	my $urlstring=shift;
98	>	my ($fullurl,$filename)=$self->urlhandler_()->download($urlstring, @_);
99
100	<	# Closing tag:
100	<	if ($nesting == 1)
100	>	if ( ( ! defined $filename ) || ( $filename eq "" ) )
101		{
102	<	# Probably not needed as error handling (tags not closed etc.) is
103	<	# handled by the XML parser anyway:
104	<	if ( $#{$self->{basestack}} >= 0 )
105	<	{
106	<	my $type=pop @{$self->{basestack}};
107	<	$self->{urlhandler}->unsetbase($type);
108	<	}
102	>	$self->parseerror("Failed to get $fullurl");
103		}
104	<	else
104	>
105	>	return ($fullurl,$filename);
106	>	}
107	>
108	>	sub urlget
109	>	{
110	>	my $self=shift;
111	>	my $urlstring=shift;
112	>	my ($fullurl,$filename)=$self->urlhandler_()->get($urlstring, @_);
113	>
114	>	if ( ( ! defined $filename ) || ( $filename eq "" ) )
115		{
116	<	my $url=$self->{urlhandler}->setbase($$hashref{'url'});
113	<	# Add store for url of the file currently being parsed. This info can
114	<	# then be extracted in Requirements objects
115	<	$self->{configurl}=$url;
116	<	push @{$self->{basestack}}, $url->type();
116	>	$self->parseerror("Failed to get $fullurl");
117		}
118	+
119	+	return ($fullurl,$filename);
120	+	}
121	+
122	+	sub urlhandler_()
123	+	{
124	+	my $self=shift;
125	+	@_ ? $self->{urlhandler} = shift
126	+	: $self->{urlhandler};
127	+	}
128	+
129	+	sub parseerror()
130	+	{
131	+	my $self=shift;
132	+	my ($string)=@_;
133	+	die "Error in download: ",$string,"\n";
134		}
135	+
136	+	1;
137	+
138	+	=back
139	+
140	+	=head1 AUTHOR/MAINTAINER
141	+
142	+	Shaun ASHBY
143	+
144	+	=cut

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines