Changeset 14791

Timestamp:

Sep 7, 2007, 11:21:19 AM (19 years ago)

Author:

Paul Price

Message:

Need to fix scheme identifier --- doesn't work when there are other
colons in the path. Moved scheme identifier into its own function
(should have done that a long time ago), and now only identify the
schemes that we know and love.

File:

• trunk/PS-IPP-Config/lib/PS/IPP/Config.pm (modified) (13 diffs)

trunk/PS-IPP-Config/lib/PS/IPP/Config.pm

@@ -1 +1 @@
 # Copyright (c) 2006  Paul Price, Joshua Hoblitt
 #
-# $Id: Config.pm,v 1.66 2007-08-24 01:03:35 price Exp $
+# $Id: Config.pm,v 1.67 2007-09-07 21:21:19 price Exp $
 
 package PS::IPP::Config;
@@ -178 +178 @@
 }
 
+# Return the scheme used for a filename
+sub file_scheme
+{
+    my $name = shift;           # Filename for which to get the scheme
+    my ($scheme) = $name =~ /^(path|neb|file):/; # The scheme, e.g., file://, path://
+    # $scheme may be undef if the input doesn't contain one of the above recognised schemes
+    return $scheme;
+}
+
+
 # Concatenate elements of a URI
 sub caturi
@@ -185 +195 @@
 
     carp "base is not inited" if not defined $base;
-    my ($scheme) = $base =~ m|^(\S+):|; # The scheme, e.g., file://, path://
+    my $scheme = file_scheme($base); # The scheme, e.g., file://, path://
     $base =~ s|^\S+:/*||;
 
@@ -263 +273 @@
 }
 
-
 # Resolve a URI to a file name
 sub file_resolve
@@ -270 +279 @@
     my $name = shift;           # File name to check
 
-    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
+    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
 
     return $name unless defined $scheme; # Probably a file name instead of a URI
@@ -297 +306 @@
     $self->file_prepare( $name );
 
-    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
+    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
     if (defined $scheme) {
         $scheme = lc($scheme);
@@ -332 +341 @@
     $self->file_prepare( $name );
 
-    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
+    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
     if (defined $scheme) {
         $scheme = lc($scheme);
@@ -362 +371 @@
     $self->file_prepare( $name );
 
-    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
+    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
     if (defined $scheme and lc($scheme) eq 'neb') {
         $name =~ s|^(\S+):/*||;
@@ -378 +387 @@
     my $name = shift;           # File name to check
 
-    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
+    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
     if (defined $scheme and lc($scheme) eq 'neb') {
         $name =~ s|^(\S+):/*||;
@@ -397 +406 @@
     $self->file_prepare( $target );
 
-    my ($scheme) = $target =~ m|^(\S+):|; # The scheme, e.g., file://, path://
+    my $scheme = file_scheme($target); # The scheme, e.g., file://, path://
     if (defined $scheme and lc($scheme) eq 'neb') {
         $target =~ s|^(\S+):/*||;
@@ -436 +445 @@
     }
 
-    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
+    my $scheme = file_scheme($name); # The scheme, e.g., file://, path://
     return $name if defined $scheme and lc($scheme) eq 'neb'; # Nothing to be done: Nebulous handles it all
 
@@ -465 +474 @@
 
     $name =~ s|/$||; # drop tailing slashes (foobar/ to foobar)
-    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file, path
+    my $scheme = file_scheme($name); # The scheme, e.g., file, path
 
     ## if this is already an absolute path (/PATH/file), just return the path
@@ -511 +520 @@
     
     # First, check to see if it's already in a relative form
-    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file, path
+    my $scheme = file_scheme($name); # The scheme, e.g., file, path
     if (defined $scheme) {
         $scheme = lc($scheme);