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.6 2006/02/13 17:29:25 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;
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.7
Committed:	Wed Feb 15 17:14:17 2006 UTC (19 years, 2 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_0_3-p4, V1_0_3-p3, V1_0_3-p2, before110xmlBRmerge, V1_0_3-p1, V1_0_3
Branch point for:	v103_with_xml
Changes since 1.6:	+15 -1 lines
Log Message:	Download works properly again...
#	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	sashby	1.7	# Revision: $Id: SimpleXMLURLDoc.pm,v 1.6 2006/02/13 17:29:25 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			use ActiveDoc::SimpleXMLDoc;
34			use URL::URLhandler;
35	sashby	1.2	require 5.004;
36			use Exporter;
37			use vars qw(@ISA);
38	sashby	1.1
39	sashby	1.2	@ISA=qw(Exporter ActiveDoc::SimpleXMLDoc);
40			@EXPORT_OK=qw( );
41	sashby	1.1
42	sashby	1.2	sub new()
43	sashby	1.1	{
44	sashby	1.2	###############################################################
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	sashby	1.1
65	sashby	1.2	# Register these recognised tags to the base class (which registers them
66			# to the container class):
67			$self->register_handlers_(\%recognised_tags);
68	sashby	1.1
69	sashby	1.2	# Set up a URL cache:
70			$self->cache($urlcache);
71			return $self;
72			}
73	sashby	1.1
74	sashby	1.2	sub cache
75	sashby	1.1	{
76	sashby	1.2	my $self=shift;
77	sashby	1.1
78	sashby	1.2	if ( @_ )
79	sashby	1.1	{
80	sashby	1.2	$self->{cache}=shift;
81	sashby	1.3	$self->urlhandler_(URL::URLhandler->new($self->{cache}));
82	sashby	1.1	}
83	sashby	1.5
84	sashby	1.2	return $self->{cache};
85	sashby	1.1	}
86	sashby	1.2
87	sashby	1.3	sub expandurl
88			{
89			my $self=shift;
90	sashby	1.5	my $urlstring=shift;
91	sashby	1.3	return $self->urlhandler_()->expandurl($urlstring);
92			}
93
94			sub urldownload
95			{
96			my $self=shift;
97			my $urlstring=shift;
98	sashby	1.4	my ($fullurl,$filename)=$self->urlhandler_()->download($urlstring, @_);
99	sashby	1.3
100			if ( ( ! defined $filename ) \|\| ( $filename eq "" ) )
101			{
102			$self->parseerror("Failed to get $fullurl");
103			}
104
105			return ($fullurl,$filename);
106			}
107	sashby	1.2
108	sashby	1.3	sub urlget
109			{
110			my $self=shift;
111			my $urlstring=shift;
112	sashby	1.4	my ($fullurl,$filename)=$self->urlhandler_()->get($urlstring, @_);
113	sashby	1.2
114	sashby	1.3	if ( ( ! defined $filename ) \|\| ( $filename eq "" ) )
115			{
116			$self->parseerror("Failed to get $fullurl");
117			}
118
119			return ($fullurl,$filename);
120			}
121
122	sashby	1.7	sub setbaseurl()
123			{
124			my $self=shift;
125			my ($partialurl)=@_;
126			return $self->urlhandler_()->setbase($partialurl);
127			}
128
129			sub unsetbaseurl()
130			{
131			my $self=shift;
132			my ($type)=@_;
133			$self->urlhandler_()->unsetbase($type);
134			}
135
136	sashby	1.3	sub urlhandler_()
137			{
138			my $self=shift;
139			@_ ? $self->{urlhandler} = shift
140			: $self->{urlhandler};
141			}
142	sashby	1.2
143	sashby	1.6	sub parseerror()
144			{
145			my $self=shift;
146			my ($string)=@_;
147			die "Error in download: ",$string,"\n";
148			}
149
150	sashby	1.2	1;
151
152			=back
153
154			=head1 AUTHOR/MAINTAINER
155
156			Shaun ASHBY
157
158			=cut