Changeset 10545

Timestamp:

Dec 7, 2006, 5:09:11 PM (20 years ago)

Author:

Paul Price

Message:

Fixing convert_filename functions to use URI and File::Spec.

File:

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

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

@@ -1 +1 @@
 # Copyright (c) 2006  Paul Price, Joshua Hoblitt
 #
-# $Id: Config.pm,v 1.12 2006-12-07 22:47:12 price Exp $
+# $Id: Config.pm,v 1.13 2006-12-08 03:09:11 price Exp $
 
 package PS::IPP::Config;
@@ -14 +14 @@
 use PS::IPP::Metadata::Config 0.07;
 use Getopt::Long qw( GetOptions :config gnu_getopt pass_through ); # Set pass_through so we don't kill @ARGV
+use URI;
 
 use base qw( Class::Accessor::Fast );
@@ -108 +109 @@
     my $self = shift;           # Configuration object
     my $name = shift;           # raw name
-    my $base;
-
-    # strip off file:// prefix
-    $name =~ s|^file://||;
-    
-    # replace path://PATH with datapath lookup
-    if ($name =~ m|^path://|) {
-        ($base) = $name =~ m|^path://(.*)|;
-        my @list = split ("/", $base);
-        my $path = shift @list;
-        my $realpath = $self->datapath($path);
-        unshift @list, $realpath;
-        $name = join ("/", @list);
-    }
-
-    $name =~ s|/{2,}|/|g;               # Remove double slashes
-
-    return $name;
+
+    my $uri = URI->new($name) or die "Unable to parse URI: $name\n"; # URI
+    my $scheme = $uri->scheme(); # Scheme, e.g., file, path
+    if (lc($scheme) eq 'file') {
+        return File::Spec->canonpath( $uri->path() );
+    }
+
+    if (lc($scheme) eq 'path') {
+        my @segments = $uri->path_segments();
+        my $source = shift @segments;
+        my $path = $self->datapath($path);
+        my $rel = File::Spec->catfile( @segments );
+        return File::Spec->rel2abs( $rel, $path );
+    }
+
+    return;
 }
 
@@ -133 +132 @@
     my $name = shift;           # raw name
 
-    $name =~ s|/{2,}|/|g;               # Remove double slashes
+    $name = File::Spec->canonpath( $name); # Clean up
+    my ($vol, $dir, $file) = File::Spec->splitpath( $name );
+    my @dirs = File::Spec->splitdir( $dir );
 
     my $path_list = _mdLookupMD($self->{_ipprc}, 'DATAPATH'); # List of paths
     my $best_path;
     my $best_name;
-    my $best_score = length $name;
-    foreach my $path_item (@$path_list) {
-        my $path_name = $path_item->{name}; # Name of the path
-        my $path = $path_item->{value}; # The path
-        if ($path !~ m|/$|) {
-            $path .= '/';
-        }
-        my ($rest) = $name =~ m|^$path(.*)|; # Rest of the string
-        next if not defined $rest;
-        my $score = length $rest;
-        if ($score < $best_score) {
-            $best_path = $path;
-            $best_score = $score;
-            $best_name = $path_name;
-        }
-    }
-    if ($best_score < length $name) {
-        $name =~ s|^$best_path|path://$best_name/|;
+    my $best_score;
+  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_dirs = File::Spec->splitdir( $path );
+
+      # Check if the path is suitable
+      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];
+      }
+      # It is suitable; see if it is 'best' (minimizes the number of directories)
+      my $score = scalar @path_dirs;
+      if ($score > $best_score) {
+          $best_path = $path;
+          $best_score = $score;
+          $best_name = $path_name;
+      }
+  }
+    my $uri = URI->new();       # URI to return
+    if (defined $best_score) {
+        my $rel = File::Spec->abs2rel( $name, $best_path );
+        $uri->scheme( 'path' );
+        $uri->path_segments( $best_name, $rel );
     } else {
-        # Worst case scenario: can't find anything, so put in the absolute path
-        $name = 'file://' . $name;
-    }
-
-    return $name;
+        $uri->scheme( 'file' );
+        $uri->path( $name );
+    }
+
+    return $uri->as_string();
 }