Changeset 13317

Timestamp:

May 9, 2007, 4:35:36 PM (19 years ago)

Author:

Paul Price

Message:

Not using URI module to parse URIs in caturi --- there are too many exceptions.

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.44 2007-05-07 21:03:10 price Exp $
+# $Id: Config.pm,v 1.45 2007-05-10 02:35:36 price Exp $
 
 package PS::IPP::Config;
@@ -170 +170 @@
     my @segments = @_;          # Path segments
 
-    my $old = URI->new( $base ) or die "Unable to parse URI: $base\n"; # URI
-    $old = $old->canonical();   # Clean up
-    my $scheme = $old->scheme(); # Scheme, e.g., file, path
-    unshift @segments, $old->path_segments();
-
-    for (my $i = 0; $i < scalar @segments; $i++) {
-        splice( @segments, $i--, 1 ) unless $segments[$i] =~ /\S+/;
-    }
-
-    my $new = URI->new();       # URI to return
-    $new->scheme( $scheme );
-    $new->authority( $old->authority() );
-
-    # Catch "neb:", "neb:/" and "neb://" for the base name
-    my $opaque = $old->opaque();
-    unshift( @segments, '', '' ) if $opaque eq '' or $opaque eq '/' or $opaque eq '//';
-    $new->opaque( '/') if $old->opaque() eq '//';
-
-    $new->path_segments( @segments );
-
-    return $new->canonical()->as_string();
+    my ($scheme) = $base =~ m|^(\S+):|; # The scheme, e.g., file://, path://
+    $base =~ s|^\S+:/*||;
+    my $root = '/' if $base =~ m|^/|; # Any root slashes?
+
+    unshift @segments, $base if $base =~ /\S+/;
+
+    # Remove leading and trailing slashes
+    foreach my $segment ( @segments ) {
+        $segment =~ s|^/*||;
+        $segment =~ s|/*$||;
+    }
+
+    # Join everything together
+    my $joined = join('/', @segments);
+    if (defined $scheme) {
+        $joined = $scheme . "://" . $joined;
+    } else {
+        $joined = $root . $joined;
+    }
+
+    return $joined;
 }
 
@@ -388 +388 @@
     my $template = shift;       # Template filename from which to get working directory if 
 
+    my $resolved = $name;       # Resolved version of file name
     if (defined $workdir) {
-        $name = caturi( $workdir, $name );
+        $resolved = caturi( $workdir, $name );
     } elsif (defined $template) {
         # Take directory from template and apply to name
         my $dir = _strip_filename( $template );
-        $name = caturi( $dir, $name );
+        $resolved = caturi( $dir, $name );
     }
 
@@ -401 +402 @@
 
     # Might need to create a directory
-    $name = $self->convert_filename_absolute( $name );
-    my ( $vol, $dirs, $file ) = File::Spec->splitpath( $name );
+    $resolved = $self->convert_filename_absolute( $resolved );
+    my ( $vol, $dirs, $file ) = File::Spec->splitpath( $resolved );
     system "mkdir -p $dirs";