Changeset 10568 for trunk/PS-IPP-Config/lib/PS/IPP/Config.pm

Timestamp:

Dec 8, 2006, 9:41:12 AM (20 years ago)

Author:

Paul Price

Message:

Fixing relative and absolute filenames.

File:

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

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

@@ -1 +1 @@
 # Copyright (c) 2006  Paul Price, Joshua Hoblitt
 #
-# $Id: Config.pm,v 1.14 2006-12-08 18:51:24 price Exp $
+# $Id: Config.pm,v 1.15 2006-12-08 19:41:12 price Exp $
 
 package PS::IPP::Config;
@@ -113 +113 @@
     my $scheme = $uri->scheme(); # Scheme, e.g., file, path
     if (lc($scheme) eq 'file') {
-        return File::Spec->canonpath( $uri->path() );
+        my $host = $uri->host();
+        my $path;
+        if (defined $host) {
+            # The user has file://some/directory/ but *probably* wants
+            # /some/directory/ i.e., the URI is technically wrong
+            # (should be one or three leading slashes, not two).  We
+            # choose to fix it and give the user what we think they
+            # want, rather than what they asked for.
+            $path = File::Spec->catfile( undef, $blah, $uri->path() );
+        } else {
+            $path = $uri->path();
+        }
+
+        return File::Spec->canonpath( $path );
     }
 
     if (lc($scheme) eq 'path') {
+        my $authority = $uri->authority();
+        my $path = $self->datapath( $authority );
         my @segments = $uri->path_segments();
-        my $source = shift @segments;
-        my $path = $self->datapath( $source );
-        my $rel = File::Spec->catfile( @segments );
-        return File::Spec->rel2abs( $rel, $path );
+        return File::Spec->catfile( $path, @segments );
     }
 
@@ -135 +147 @@
     my ($vol, $dir, $file) = File::Spec->splitpath( $name );
     my @dirs = File::Spec->splitdir( $dir );
+    pop @dirs;                  # Get rid of filename
 
     my $path_list = _mdLookupMD($self->{_ipprc}, 'DATAPATH'); # List of paths
@@ -140 +153 @@
     my $best_name;
     my $best_score;
-  PATH_CHECK: foreach my $path_item (@$path_list) {
+  CFR_PATH_CHECK: foreach my $path_item (@$path_list) {
       my $path_name = $path_item->{name}; # Name of the path
-      my $path = $path_item->{value}; # The path
+      my $path = File::Spec->canonpath( $path_item->{value} ); # The path
       my @path_dirs = File::Spec->splitdir( $path );
 
@@ -148 +161 @@
       next if scalar @path_dirs > scalar @dirs;
       for (my $i = 0; $i < scalar @path_dirs; $i++) {
-          next PATH_CHECK if $path_dirs[$i] ne $dirs[$i];
+          next CFR_PATH_CHECK if $path_dirs[$i] ne $dirs[$i];
       }
       # It is suitable; see if it is 'best' (minimizes the number of directories)
       my $score = scalar @path_dirs;
-      if ($score > $best_score) {
+      if (not defined $best_score or $score > $best_score) {
           $best_path = $path;
           $best_score = $score;
@@ -161 +174 @@
     if (defined $best_score) {
         my $rel = File::Spec->abs2rel( $name, $best_path );
+        my @segments = File::Spec->splitdir( $rel );
         $uri->scheme( 'path' );
-        $uri->path_segments( $best_name, $rel );
+        $uri->authority( $best_name );
+        $uri->path_segments( @segments );
     } else {
         $uri->scheme( 'file' );