src/ActiveDoc/SimpleXMLURLDoc.pm

#____________________________________________________________________ 
# File: ActiveDoc::SimpleXMLURLDoc.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2005-12-02 17:44:08+0100
# Revision: $Id: SimpleXMLURLDoc.pm,v 1.7.2.1 2007/01/24 13:24:17 sashby Exp $ 
#
# Copyright: 2005 (C) Shaun Ashby
#
#--------------------------------------------------------------------

=head1 NAME

ActiveDoc::SimpleXMLURLDoc - Base class for URL-based SCRAM documents.

=head1 SYNOPSIS

        my $obj = ActiveDoc::SimpleXMLURLDoc->new();

=head1 DESCRIPTION

Any document class inheriting from ActiveDoc::SimpleXMLURLDoc will have access to
URL handling.
   
=head1 METHODS

=over

=cut

package ActiveDoc::SimpleXMLURLDoc;

BEGIN
   {
   die "\n\n".__PACKAGE__.": this package can be dropped from releases.\n\n";
   }

use ActiveDoc::SimpleXMLDoc;
use URL::URLhandler;
require 5.004;
use Exporter;
use vars qw(@ISA);

@ISA=qw(Exporter ActiveDoc::SimpleXMLDoc);
@EXPORT_OK=qw( );

sub new()
   {
   ###############################################################
   # new                                                         #
   ###############################################################
   # modified : Fri Dec  2 17:44:11 2005 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   # function :                                                  #
   #          :                                                  #
   ###############################################################
   my $proto=shift;
   my $class=ref($proto) || $proto;
   my ($urlcache,$context,@defhandlers)=@_;
   my $self= bless($proto->SUPER::new($context,@defhandlers),$class);
   $self->{CONTEXT}=$context;
   # Register supported tags for this doc class, and specify which
   # attributes should be checked for:
   my $nested = 1;
   my $unnested = 0;
   my %recognised_tags = ('base' => [ { 'url' => 'REQUIRED' }, $nested ],
                          'download' => [ { 'url' => 'REQUIRED', 'name' => 'OPTION' }, $unnested ]);
   
   # Register these recognised tags to the base class (which registers them
   # to the container class):
   $self->register_handlers_(\%recognised_tags);

   # Set up a URL cache:
   $self->cache($urlcache);
   return $self;
   }

sub cache
   {
   my $self=shift;

   if ( @_ )
      {
      $self->{cache}=shift;
      $self->urlhandler_(URL::URLhandler->new($self->{cache}));
      }
   
   return $self->{cache};
   }

sub expandurl
   {
   my $self=shift;
   my $urlstring=shift;
   return $self->urlhandler_()->expandurl($urlstring);
   }

sub urldownload
   {
   my $self=shift;
   my $urlstring=shift;
   my ($fullurl,$filename)=$self->urlhandler_()->download($urlstring, @_);

   if ( ( ! defined $filename ) || ( $filename eq "" ) )
      {
      $self->parseerror("Failed to get $fullurl");
      }

   return ($fullurl,$filename);
   }

sub urlget
   {
   my $self=shift;
   my $urlstring=shift;
   my ($fullurl,$filename)=$self->urlhandler_()->get($urlstring, @_);
   
   if ( ( ! defined $filename ) || ( $filename eq "" ) )
      {
      $self->parseerror("Failed to get $fullurl");
      }

   return ($fullurl,$filename);
   }

sub setbaseurl()
   {
   my $self=shift;
   my ($partialurl)=@_;
   return $self->urlhandler_()->setbase($partialurl);
   }

sub unsetbaseurl()
   {
   my $self=shift;
   my ($type)=@_;
   $self->urlhandler_()->unsetbase($type);
   }

sub urlhandler_()
   {
   my $self=shift;
   @_ ? $self->{urlhandler} = shift
      : $self->{urlhandler};
   }

sub parseerror()
   {
   my $self=shift;
   my ($string)=@_;
   die "Error in download: ",$string,"\n";
   }

1;

=back

=head1 AUTHOR/MAINTAINER

Shaun ASHBY

=cut
Revision:	1.10
Committed:	Fri Dec 14 09:03:44 2007 UTC (17 years, 4 months ago) by muzaffar
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_1_7, V1_1_6, V1_1_5, V1_1_4, V1_1_3, V1_1_2, V1_1_0_reltag8, V1_1_0_reltag7, V1_1_0_reltag6, V1_1_1, V1_1_0_reltag5, V1_1_0_reltag4, V1_1_0_reltag3, V1_1_0_reltag2, V1_1_0_reltag1, V1_1_0_reltag, V1_1_0, V1_1_0_cand3, V1_1_0_cand2, V1_1_0_cand1
Branch point for:	forBinLess_SCRAM
Changes since 1.9:	+1 -1 lines
Log Message:	replace head with xml branch
#	User	Rev	Content
1	sashby	1.2	#____________________________________________________________________
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	muzaffar	1.10	# Revision: $Id: SimpleXMLURLDoc.pm,v 1.7.2.1 2007/01/24 13:24:17 sashby Exp $
8	sashby	1.1	#
9	sashby	1.2	# Copyright: 2005 (C) Shaun Ashby
10	sashby	1.1	#
11	sashby	1.2	#--------------------------------------------------------------------
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	sashby	1.1	package ActiveDoc::SimpleXMLURLDoc;
33	sashby	1.8
34			BEGIN
35			{
36			die "\n\n".__PACKAGE__.": this package can be dropped from releases.\n\n";
37			}
38
39	sashby	1.1	use ActiveDoc::SimpleXMLDoc;
40			use URL::URLhandler;
41	sashby	1.2	require 5.004;
42			use Exporter;
43			use vars qw(@ISA);
44	sashby	1.1
45	sashby	1.2	@ISA=qw(Exporter ActiveDoc::SimpleXMLDoc);
46			@EXPORT_OK=qw( );
47	sashby	1.1
48	sashby	1.2	sub new()
49	sashby	1.1	{
50	sashby	1.2	###############################################################
51			# new #
52			###############################################################
53			# modified : Fri Dec 2 17:44:11 2005 / SFA #
54			# params : #
55			# : #
56			# function : #
57			# : #
58			###############################################################
59			my $proto=shift;
60			my $class=ref($proto) \|\| $proto;
61			my ($urlcache,$context,@defhandlers)=@_;
62			my $self= bless($proto->SUPER::new($context,@defhandlers),$class);
63			$self->{CONTEXT}=$context;
64			# Register supported tags for this doc class, and specify which
65			# attributes should be checked for:
66			my $nested = 1;
67			my $unnested = 0;
68			my %recognised_tags = ('base' => [ { 'url' => 'REQUIRED' }, $nested ],
69			'download' => [ { 'url' => 'REQUIRED', 'name' => 'OPTION' }, $unnested ]);
70	sashby	1.1
71	sashby	1.2	# Register these recognised tags to the base class (which registers them
72			# to the container class):
73			$self->register_handlers_(\%recognised_tags);
74	sashby	1.1
75	sashby	1.2	# Set up a URL cache:
76			$self->cache($urlcache);
77			return $self;
78			}
79	sashby	1.1
80	sashby	1.2	sub cache
81	sashby	1.1	{
82	sashby	1.2	my $self=shift;
83	sashby	1.1
84	sashby	1.2	if ( @_ )
85	sashby	1.1	{
86	sashby	1.2	$self->{cache}=shift;
87	sashby	1.3	$self->urlhandler_(URL::URLhandler->new($self->{cache}));
88	sashby	1.1	}
89	sashby	1.5
90	sashby	1.2	return $self->{cache};
91	sashby	1.1	}
92	sashby	1.2
93	sashby	1.3	sub expandurl
94			{
95			my $self=shift;
96	sashby	1.5	my $urlstring=shift;
97	sashby	1.3	return $self->urlhandler_()->expandurl($urlstring);
98			}
99
100			sub urldownload
101			{
102			my $self=shift;
103			my $urlstring=shift;
104	sashby	1.4	my ($fullurl,$filename)=$self->urlhandler_()->download($urlstring, @_);
105	sashby	1.3
106			if ( ( ! defined $filename ) \|\| ( $filename eq "" ) )
107			{
108			$self->parseerror("Failed to get $fullurl");
109			}
110
111			return ($fullurl,$filename);
112			}
113	sashby	1.2
114	sashby	1.3	sub urlget
115			{
116			my $self=shift;
117			my $urlstring=shift;
118	sashby	1.4	my ($fullurl,$filename)=$self->urlhandler_()->get($urlstring, @_);
119	sashby	1.2
120	sashby	1.3	if ( ( ! defined $filename ) \|\| ( $filename eq "" ) )
121			{
122			$self->parseerror("Failed to get $fullurl");
123			}
124
125			return ($fullurl,$filename);
126			}
127
128	sashby	1.7	sub setbaseurl()
129			{
130			my $self=shift;
131			my ($partialurl)=@_;
132			return $self->urlhandler_()->setbase($partialurl);
133			}
134
135			sub unsetbaseurl()
136			{
137			my $self=shift;
138			my ($type)=@_;
139			$self->urlhandler_()->unsetbase($type);
140			}
141
142	sashby	1.3	sub urlhandler_()
143			{
144			my $self=shift;
145			@_ ? $self->{urlhandler} = shift
146			: $self->{urlhandler};
147			}
148	sashby	1.2
149	sashby	1.6	sub parseerror()
150			{
151			my $self=shift;
152			my ($string)=@_;
153			die "Error in download: ",$string,"\n";
154			}
155
156	sashby	1.2	1;
157
158			=back
159
160			=head1 AUTHOR/MAINTAINER
161
162			Shaun ASHBY
163
164			=cut