| Revision: | 1.5.2.1 |
| Committed: | Wed May 5 14:00:24 1999 UTC (26 years ago) by williamc |
| Content type: | text/plain |
| Branch: | V0_9branch |
| CVS Tags: | V0_10_0beta, V0_9_42, V0_9_41, V0_9_40, V0_9_39, V0_9_38, V0_9_37, V0_9_36, V0_9_35, V0_9_34, V0_9_33, V0_9_32, V0_9_31, V0_9_30, V0_9_29, V0_9_28, V0_9_27, V0_9_26, V0_9_25, V0_9_24, V0_9_23, V0_9_22, V0_9_21, V0_9_20, V0_9_19, V0_9_18, V0_9_17, V0_9_16, V0_9_15, V0_9_14, V0_9_13, V0_9_12, V0_9_11, V0_9_10, V0_9_9, V0_9_8, V0_9_7 |
| Changes since 1.5: | +3 -3 lines |
| Log Message: | Disable LWP required stuff |
| # | Content |
|---|---|
| 1 | # url handler -> returns the location of the file |
| 2 | # |
| 3 | # returns file location - or crashes out |
| 4 | # can pass a file name for the item to be stored as |
| 5 | # if not then stores in a default cache. |
| 6 | |
| 7 | package urlhandler; |
| 8 | require 5.004; |
| 9 | require Exporter; |
| 10 | @ISA = qw(Exporter); |
| 11 | @EXPORT = qw(urlhandler); |
| 12 | |
| 13 | |
| 14 | sub urlhandler($@) { |
| 15 | my $origurl=shift; |
| 16 | my $filename=shift; |
| 17 | my $rest; |
| 18 | my $type; |
| 19 | my $url; |
| 20 | my $version; |
| 21 | |
| 22 | chomp $origurl; |
| 23 | # get our version info from the url (after last ??) |
| 24 | ( $url, $version) = split /\?\?/, $origurl; |
| 25 | if ( $url=~/:/ ) { |
| 26 | ($type,$rest) = split /:/, $url; |
| 27 | } |
| 28 | else { |
| 29 | $type='label'; |
| 30 | $rest=$url.":".$version; |
| 31 | } |
| 32 | |
| 33 | my @urltypes = qw(label file cvs http); |
| 34 | foreach $ty ( @urltypes ) { |
| 35 | do { return &$ty($rest, $filename); $supported='yes'; last; } |
| 36 | if $type eq $ty; |
| 37 | } |
| 38 | if ( ! ( $supported=~/yes/ )) { |
| 39 | print "urlhandler: Unsupported type $type\n"; |
| 40 | exit 1; |
| 41 | } |
| 42 | } |
| 43 | sub label { |
| 44 | my $label=shift; |
| 45 | my $filename=shift; |
| 46 | my $returnval=""; |
| 47 | |
| 48 | open ( LOOKUP, "$ENV{SCRAM_LOOKUPDB}" ) |
| 49 | || die "urlhandler: Unable to open DataBase $ENV{SCRAM_LOOKUPDB} $!"; |
| 50 | while ( <LOOKUP> ) { |
| 51 | next if /^#/; |
| 52 | if ( $_=~s/^$label\:// ) { |
| 53 | $returnval = urlhandler($_,$filename); |
| 54 | } |
| 55 | } |
| 56 | close LOOKUP; |
| 57 | if ( $returnval ne "" ) { |
| 58 | return $returnval; |
| 59 | } |
| 60 | ($proj,$ver)=split /:/, $label; |
| 61 | print "Error : Unknown project name or version (".$proj." ".$ver.")\n"; |
| 62 | exit 1; |
| 63 | } |
| 64 | |
| 65 | sub file { |
| 66 | use File::Copy; |
| 67 | my $urlfile=shift; |
| 68 | my $filename=shift; |
| 69 | if ( -e "$urlfile" ) { |
| 70 | if ( $filename=~/.*/ ) { |
| 71 | copy ( $urlfile, $filename ) || return $urlfile; |
| 72 | return $filename; |
| 73 | } |
| 74 | return $urlfile; |
| 75 | } |
| 76 | else { |
| 77 | print "urlhandler: Unable to find file $urlfile : $!\n"; |
| 78 | exit 1; |
| 79 | } |
| 80 | } |
| 81 | |
| 82 | sub cvs { |
| 83 | print "Coming soon\n"; |
| 84 | } |
| 85 | |
| 86 | sub http { |
| 87 | my $urlfile=shift; |
| 88 | my $filename=shift; |
| 89 | # use LWP::Simple; |
| 90 | print "Hello $filename, $urlfile\n"; |
| 91 | # open (STORE, ">$filename") || die "unable to open file $filename $!\n"; |
| 92 | # print STORE (get 'http:'.$urlfile); |
| 93 | close STORE; |
| 94 | } |
| 95 | |
| 96 | sub cachefilename { |
| 97 | use File::Basename; |
| 98 | use Utilities::AddDir; |
| 99 | my $filebase=dirname($rest); |
| 100 | $cache="/tmp/williamc/urlhandler$$"; |
| 101 | adddir($cache); |
| 102 | $filename=$cache."/".$filebase; |
| 103 | } |
| 104 |