| Revision: | 1.5.2.2 |
| Committed: | Mon Oct 18 06:51:32 1999 UTC (25 years, 7 months ago) by williamc |
| Content type: | text/plain |
| Branch: | V0_9branch |
| CVS Tags: | BuildSystemProto1, V0_18_0, V0_18_0model, V0_17_1, V0_18_0alpha, V0_17_0, V0_16_4, V0_16_3, V0_16_2, V0_16_1, V0_16_0, V0_15_1, V0_15_0, V0_15_0beta, V0_14_0, V0_12_12_4, V0_12_12_3, V0_13_3, V0_13_2, V0_12_12_2, V0_12_12_1, V0_12_12_0, PlayGround_0, V0_13_1, V0_13_0, V0_12_12, V0_12_11, V0_12_9b, V0_12_10, V0_12_9, V0_12_8, V0_12_7, V0_12_6, V0_12_5, V0_12_4, V0_12_3, V0_12_2, V0_12_1, V0_12_0, V0_11_4, V0_11_3, V0_11_2, V0_11_1, V0_11_0, V0_10_19, V0_10_18, V0_10_17, V0_10_16, V0_10_15, V0_10_14, V0_10_13, V0_10_12, V0_10_11, V0_10_10, V0_10_9, V0_10_8, V0_10_7, V0_10_6, V0_10_5, V0_10_4, V0_10_3, V0_10_2, V0_10_1, V0_10_0 |
| Branch point for: | V0_17branch, V0_16branch, V0_15branch, HPWbranch |
| Changes since 1.5.2.1: | +29 -10 lines |
| Log Message: | Add Multi-Database support |
| # | User | Rev | Content |
|---|---|---|---|
| 1 | williamc | 1.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 | williamc | 1.4 | require 5.004; |
| 9 | williamc | 1.1 | 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 | williamc | 1.4 | my @urltypes = qw(label file cvs http); |
| 34 | williamc | 1.1 | 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 | williamc | 1.5.2.2 | $returnval=labelsort($label, $ENV{SCRAM_LOOKUPDB}, $filename); |
| 49 | williamc | 1.5 | if ( $returnval ne "" ) { |
| 50 | williamc | 1.5.2.2 | return $returnval; |
| 51 | williamc | 1.5 | } |
| 52 | ($proj,$ver)=split /:/, $label; | ||
| 53 | print "Error : Unknown project name or version (".$proj." ".$ver.")\n"; | ||
| 54 | exit 1; | ||
| 55 | williamc | 1.5.2.2 | } |
| 56 | |||
| 57 | sub labelsort { | ||
| 58 | my $label=shift; | ||
| 59 | my $filename=shift; | ||
| 60 | my $fileoutname=shift; | ||
| 61 | my $returnval=""; | ||
| 62 | |||
| 63 | use FileHandle; | ||
| 64 | my $fh=FileHandle->new(); | ||
| 65 | open ( $fh, $filename ) | ||
| 66 | || die "urlhandler: Unable to open DataBase $ENV{SCRAM_LOOKUPDB} $!"; | ||
| 67 | while ( <$fh> ) { | ||
| 68 | next if /^#/; | ||
| 69 | if ( $_=~/\!DB (.*)/ ) { | ||
| 70 | my $db=$1; | ||
| 71 | if ( -f $db ) { | ||
| 72 | $returnval=labelsort($label,$db, $fileoutname); | ||
| 73 | last if ($returnval ne ""); | ||
| 74 | } | ||
| 75 | } | ||
| 76 | if ( $_=~s/^$label\:// ) { | ||
| 77 | $returnval = urlhandler($_,$fileoutname); | ||
| 78 | } | ||
| 79 | } | ||
| 80 | close $fh; | ||
| 81 | return $returnval; | ||
| 82 | williamc | 1.1 | } |
| 83 | |||
| 84 | sub file { | ||
| 85 | use File::Copy; | ||
| 86 | my $urlfile=shift; | ||
| 87 | my $filename=shift; | ||
| 88 | if ( -e "$urlfile" ) { | ||
| 89 | if ( $filename=~/.*/ ) { | ||
| 90 | copy ( $urlfile, $filename ) || return $urlfile; | ||
| 91 | return $filename; | ||
| 92 | } | ||
| 93 | return $urlfile; | ||
| 94 | } | ||
| 95 | else { | ||
| 96 | print "urlhandler: Unable to find file $urlfile : $!\n"; | ||
| 97 | exit 1; | ||
| 98 | } | ||
| 99 | } | ||
| 100 | |||
| 101 | sub cvs { | ||
| 102 | print "Coming soon\n"; | ||
| 103 | } | ||
| 104 | |||
| 105 | williamc | 1.3 | sub http { |
| 106 | williamc | 1.4 | my $urlfile=shift; |
| 107 | my $filename=shift; | ||
| 108 | williamc | 1.5.2.1 | # use LWP::Simple; |
| 109 | williamc | 1.5 | print "Hello $filename, $urlfile\n"; |
| 110 | williamc | 1.5.2.1 | # open (STORE, ">$filename") || die "unable to open file $filename $!\n"; |
| 111 | # print STORE (get 'http:'.$urlfile); | ||
| 112 | williamc | 1.4 | close STORE; |
| 113 | williamc | 1.3 | } |
| 114 | |||
| 115 | williamc | 1.1 | sub cachefilename { |
| 116 | use File::Basename; | ||
| 117 | williamc | 1.2 | use Utilities::AddDir; |
| 118 | williamc | 1.1 | my $filebase=dirname($rest); |
| 119 | $cache="/tmp/williamc/urlhandler$$"; | ||
| 120 | adddir($cache); | ||
| 121 | $filename=$cache."/".$filebase; | ||
| 122 | } | ||
| 123 |