src/URL/URLhandler.pm

# url handler -> returns the location of thefilu# 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,variablehash) : set the url defaults for a specific url type
#                              arguments are dependenton type
# unsetbase(type)  : deactivate a previously set base
# setcache(dir)    : set the default cache location
#
# ----------------------------------------------------------------------
# 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 URL::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_cvsfile;
        use URL::URL_file;
        $self->{urlmodules}={
                        'cvsfile' => 'URL::URL_cvsfile',
                        'cvs' => 'URL::URL_cvs',
                        'file' => 'URL::URL_file'
                };
        $self->{filebase}="";
        $self->setbase("file", {}); # Base file as default
}

sub setcache {
        my $self=shift;
        my $cache=shift;

        $self->{cache}=$cache;
}

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

        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 {
           if ( $#{$self->{urlostack}{$type}} < 0 ) {
                print "URLhandler : base not set for type $type \n";
           }
           else {
             $rv=
             eval{${$self->{urlostack}{$type}}[$#{$self->{urlostack}{$type}}]}->
                                get($rest, $dirname);
           }
        }
        if ( $rv ne "" ) {
                $rv=$dirname."/".$rv;
        }
        return $rv;
}

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;
          $oref->setbase(@args);
        }
}

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

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