src/URL/URLhandler.pm

# url handler -> returns the location of the file
#
# Interface
# ---------
# new() :
# new(cachedir)       : A new urlhandler with a defined default cahce directory
# get(url)            : download from the specified url to the default cache
# get(url,dirlocation)   : download to the specified directory
# setbase(type,@args) : set the url defaults for a specific url type
#                       arguments are dependent on type
#                       http:
#                       file:
#                       cvs: servername,servertype [ ,user,passkey ]
#                       label:
# unsetbase(type)  : deactivate a previously set base
#
# ----------------------------------------------------------------------
# returns file location - or crashes out
# can pass a file name for the item to be stored as 
# if not then stores in a default cache.

package URLhandler;
require 5.004;
use Utilities::AddDir;
use URL::URL_base;
use Carp;

sub new {
        my $class=shift;
        my $cache=shift;
        $self={};
        bless $self, $class;
        $self->init($cache);
        return $self;
}

sub init {
        use Utilities::AddDir;
        my $self=shift;
        my $cache=shift;
        if (! defined $cache  ) { $cache="/tmp/SCRAMcache" }; # default cache
        AddDir::adddir($cache);
        $self->{cache}=$cache;
        use URL::URL_cvs;
        use URL::URL_file;
        $self->{urlmodules}={
                        'cvs' => 'URL_cvs',
                        'file' => 'URL_file'
                };
        $self->{filebase}="";
        $self->setbase("file", {}); # Base file as default
}

sub get ($@) {
        my $self=shift;
        my $origurl=shift;
        my $dirname=shift;
        my $rest;
        my $type;
        my $url;
        my $version;

        if ( ! defined $dirname ) {
          $dirname=$self->{cache};
        }
        chdir $dirname or carp "Unable to Enter Directory $dirname $!\n";
        chomp $origurl;
        # get our version info from the url (after last ??)
        ( $url, $version) = split /\?\?/, $origurl;
        if ( $url=~/:/ ) {
          ($type,$rest) = split /:/, $url;
        }
        else {
           $type='label';
           $rest=$url.":".$version;
        }
        if ( ! ( exists $self->{'urlmodules'}{$type}) ) {
           print "URLhandler: Unsupported type $type\n";
           carp;
        }
        else {
           print "Debug : type=$type , number of elements=".$#{$self->{urlostack}{$type}}." ".${$self->{urlostack}{$type}}[$#{$self->{urlostack}{$type}}]."\n";
           if ( $#{$self->{urlostack}{$type}} < 0 ) {
                print "URLhandler : base not set for type $type \n";
           }
           else {
             eval{${$self->{urlostack}{$type}}[$#{$self->{urlostack}{$type}}]}->
                                get($rest);
           }
        }
}

sub setbase {
        my $self=shift;
        my $type=shift;
        my @args=@_;
        my $oref;

        # Check type is supported
        if ( ! exists $self->{urlmodules}{$type} ) {
          print "URLhandler error: Unsupported type $type\n";
          return 1;
        }
        else {
          # A new URL object - pushed onto the stack
          $oref=eval{$self->{urlmodules}{$type}}->new();
          push @{$self->{urlostack}{$type}}, $oref;
        print "Debug : Setting type=$type to $oref $#{$self->{urlostack}{$type}}\n";
          $oref->setbase(@args);
        }
}

sub unsetbase {
        my $self=shift;
        my $type=shift;
        my $oref;

        print " Debug : Unsetting base type $type\n";
        # Check type is supported
        if ( ! exists $self->{urlmodules}{$type} ) {
          print "URLhandler error: Unsupported type $type\n";
          return 1;
        }
        else {
          # pop off the stack and call the unset base method
          if ( $#{$self->{urlostack}{$type}} >=0 ) {
            $oref=pop @{$self->{urlostack}{$type}};
            $oref->unsetbase();
            undef $oref;
          }
          else {
           print "URLhandler error: Unable to unset type $type\n";
           return 1;
          }
        }
}

# ------------------------ General Support Routines ----------------------------

sub cachefilename {
         my $self=shift;
             use File::Basename;
             use Utilities::AddDir;
             my $filebase=dirname($rest);
             $cache="/tmp/williamc/urlhandler$$";
             adddir($cache);
             $filename=$cache."/".$filebase;
}

Revision:	1.3
Committed:	Wed Aug 25 08:41:40 1999 UTC (25 years, 8 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.2:	+16 -6 lines
Log Message:	Update all for get interface
#	User	Rev	Content
1	williamc	1.1	# url handler -> returns the location of the file
2			#
3			# Interface
4			# ---------
5			# new() :
6			# new(cachedir) : A new urlhandler with a defined default cahce directory
7			# get(url) : download from the specified url to the default cache
8	williamc	1.3	# get(url,dirlocation) : download to the specified directory
9	williamc	1.1	# setbase(type,@args) : set the url defaults for a specific url type
10			# arguments are dependent on type
11			# http:
12			# file:
13			# cvs: servername,servertype [ ,user,passkey ]
14			# label:
15			# unsetbase(type) : deactivate a previously set base
16			#
17			# ----------------------------------------------------------------------
18			# returns file location - or crashes out
19			# can pass a file name for the item to be stored as
20			# if not then stores in a default cache.
21
22			package URLhandler;
23			require 5.004;
24			use Utilities::AddDir;
25	williamc	1.3	use URL::URL_base;
26	williamc	1.1	use Carp;
27
28			sub new {
29			my $class=shift;
30			my $cache=shift;
31			$self={};
32			bless $self, $class;
33			$self->init($cache);
34			return $self;
35			}
36
37			sub init {
38			use Utilities::AddDir;
39			my $self=shift;
40			my $cache=shift;
41			if (! defined $cache ) { $cache="/tmp/SCRAMcache" }; # default cache
42			AddDir::adddir($cache);
43			$self->{cache}=$cache;
44	williamc	1.2	use URL::URL_cvs;
45			use URL::URL_file;
46			$self->{urlmodules}={
47			'cvs' => 'URL_cvs',
48			'file' => 'URL_file'
49			};
50	williamc	1.1	$self->{filebase}="";
51	williamc	1.2	$self->setbase("file", {}); # Base file as default
52	williamc	1.1	}
53
54			sub get ($@) {
55			my $self=shift;
56			my $origurl=shift;
57	williamc	1.3	my $dirname=shift;
58	williamc	1.1	my $rest;
59			my $type;
60			my $url;
61			my $version;
62
63	williamc	1.3	if ( ! defined $dirname ) {
64			$dirname=$self->{cache};
65	williamc	1.1	}
66	williamc	1.3	chdir $dirname or carp "Unable to Enter Directory $dirname $!\n";
67	williamc	1.1	chomp $origurl;
68			# get our version info from the url (after last ??)
69			( $url, $version) = split /\?\?/, $origurl;
70			if ( $url=~/:/ ) {
71			($type,$rest) = split /:/, $url;
72			}
73			else {
74			$type='label';
75			$rest=$url.":".$version;
76	williamc	1.2	}
77			if ( ! ( exists $self->{'urlmodules'}{$type}) ) {
78	williamc	1.1	print "URLhandler: Unsupported type $type\n";
79			carp;
80			}
81	williamc	1.2	else {
82	williamc	1.3	print "Debug : type=$type , number of elements=".$#{$self->{urlostack}{$type}}." ".${$self->{urlostack}{$type}}[$#{$self->{urlostack}{$type}}]."\n";
83			if ( $#{$self->{urlostack}{$type}} < 0 ) {
84			print "URLhandler : base not set for type $type \n";
85			}
86			else {
87			eval{${$self->{urlostack}{$type}}[$#{$self->{urlostack}{$type}}]}->
88			get($rest);
89			}
90	williamc	1.2	}
91	williamc	1.1	}
92
93			sub setbase {
94			my $self=shift;
95			my $type=shift;
96			my @args=@_;
97	williamc	1.2	my $oref;
98	williamc	1.1
99			# Check type is supported
100	williamc	1.2	if ( ! exists $self->{urlmodules}{$type} ) {
101	williamc	1.1	print "URLhandler error: Unsupported type $type\n";
102			return 1;
103			}
104			else {
105	williamc	1.2	# A new URL object - pushed onto the stack
106			$oref=eval{$self->{urlmodules}{$type}}->new();
107			push @{$self->{urlostack}{$type}}, $oref;
108	williamc	1.3	print "Debug : Setting type=$type to $oref $#{$self->{urlostack}{$type}}\n";
109	williamc	1.2	$oref->setbase(@args);
110	williamc	1.1	}
111			}
112
113			sub unsetbase {
114			my $self=shift;
115			my $type=shift;
116	williamc	1.2	my $oref;
117	williamc	1.1
118	williamc	1.3	print " Debug : Unsetting base type $type\n";
119	williamc	1.1	# Check type is supported
120	williamc	1.2	if ( ! exists $self->{urlmodules}{$type} ) {
121	williamc	1.1	print "URLhandler error: Unsupported type $type\n";
122			return 1;
123			}
124			else {
125	williamc	1.2	# pop off the stack and call the unset base method
126			if ( $#{$self->{urlostack}{$type}} >=0 ) {
127			$oref=pop @{$self->{urlostack}{$type}};
128			$oref->unsetbase();
129			undef $oref;
130	williamc	1.1	}
131	williamc	1.2	else {
132			print "URLhandler error: Unable to unset type $type\n";
133			return 1;
134	williamc	1.1	}
135			}
136			}
137
138			# ------------------------ General Support Routines ----------------------------
139
140			sub cachefilename {
141			my $self=shift;
142			use File::Basename;
143			use Utilities::AddDir;
144			my $filebase=dirname($rest);
145			$cache="/tmp/williamc/urlhandler$$";
146			adddir($cache);
147			$filename=$cache."/".$filebase;
148			}
149