| 1 |
– |
#!/usr/local/bin/perl5 |
| 2 |
– |
# |
| 1 |
|
# url handler -> returns the location of the file |
| 2 |
|
# |
| 3 |
|
# returns file location - or crashes out |
| 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); |
| 30 |
|
$rest=$url.":".$version; |
| 31 |
|
} |
| 32 |
|
|
| 33 |
< |
my @urltypes = qw(label file cvs); |
| 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; |
| 45 |
|
my $filename=shift; |
| 46 |
|
my $returnval=""; |
| 47 |
|
|
| 48 |
< |
open ( LOOKUP, "$ENV{SCRAM_LOOKUPDB}" ) |
| 48 |
> |
$returnval=labelsort($label, $ENV{SCRAM_LOOKUPDB}, $filename); |
| 49 |
> |
if ( $returnval ne "" ) { |
| 50 |
> |
return $returnval; |
| 51 |
> |
} |
| 52 |
> |
($proj,$ver)=split /:/, $label; |
| 53 |
> |
print "Error : Unknown project name or version (".$proj." ".$ver.")\n"; |
| 54 |
> |
exit 1; |
| 55 |
> |
} |
| 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 ( <LOOKUP> ) { |
| 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($_,$filename); |
| 77 |
> |
$returnval = urlhandler($_,$fileoutname); |
| 78 |
|
} |
| 79 |
|
} |
| 80 |
< |
close LOOKUP; |
| 80 |
> |
close $fh; |
| 81 |
|
return $returnval; |
| 59 |
– |
|
| 82 |
|
} |
| 83 |
|
|
| 84 |
|
sub file { |
| 102 |
|
print "Coming soon\n"; |
| 103 |
|
} |
| 104 |
|
|
| 105 |
+ |
sub http { |
| 106 |
+ |
my $urlfile=shift; |
| 107 |
+ |
my $filename=shift; |
| 108 |
+ |
# use LWP::Simple; |
| 109 |
+ |
print "Hello $filename, $urlfile\n"; |
| 110 |
+ |
# open (STORE, ">$filename") || die "unable to open file $filename $!\n"; |
| 111 |
+ |
# print STORE (get 'http:'.$urlfile); |
| 112 |
+ |
close STORE; |
| 113 |
+ |
} |
| 114 |
+ |
|
| 115 |
|
sub cachefilename { |
| 116 |
|
use File::Basename; |
| 117 |
< |
use AddDir; |
| 117 |
> |
use Utilities::AddDir; |
| 118 |
|
my $filebase=dirname($rest); |
| 119 |
|
$cache="/tmp/williamc/urlhandler$$"; |
| 120 |
|
adddir($cache); |
