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

Timestamp:

May 21, 2007, 6:22:00 PM (19 years ago)

Author:

Paul Price

Message:

Pulling out the URI module, since it's darn annoying.

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.45 2007-05-10 02:35:36 price Exp $
+# $Id: Config.pm,v 1.46 2007-05-22 04:22:00 price Exp $
 
 package PS::IPP::Config;
@@ -15 +15 @@
 use PS::IPP::Metadata::Config 1.00;
 use Getopt::Long 2.35 qw( GetOptions :config gnu_getopt pass_through ); # Set pass_through so we don't kill @ARGV
-use URI 1.35;
 
 use base qw( Class::Accessor::Fast Exporter );
@@ -253 +252 @@
     my $name = shift;           # File name to check
 
-    my $uri = URI->new( $name );# URI parser
-    my $scheme = $uri->scheme();# Scheme for file name
+    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
 
     return $name unless defined $scheme; # Probably a file name instead of a URI
 
     if ($scheme eq 'neb') {
-        $name = _strip_scheme( $name );
+        $name =~ s|^(\S+):/*||;
         $self->_neb_start();
         my $neb = $self->{nebulous}; # Nebulous handle
@@ -279 +277 @@
     $self->file_prepare( $name );
 
-    my $uri = URI->new( $name );# URI parser
-    my $scheme = $uri->scheme();# Scheme for file name
+    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
     if (defined $scheme) {
         if ($scheme eq 'neb') {
-            $name = _strip_scheme( $name );
+            $name =~ s|^(\S+):/*||;
             $self->_neb_start();
             return $self->{nebulous}->open_create( $name );
@@ -313 +310 @@
     $self->file_prepare( $name );
 
-    my $uri = URI->new( $name );# URI parser
-    my $scheme = $uri->scheme();# Scheme for file name
+    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
     if (defined $scheme and $scheme eq 'neb') {
-        $name = _strip_scheme( $name );
+        $name =~ s|^(\S+):/*||;
         $self->_neb_start();
         $name = $self->{nebulous}->create( $name );
@@ -330 +326 @@
     my $name = shift;           # File name to check
 
-    my $uri = URI->new( $name );# URI parser
-    my $scheme = $uri->scheme();# Scheme for file name
+    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
     if (defined $scheme and $scheme eq 'neb') {
-        $name = _strip_scheme( $name );
+        $name =~ s|^(\S+):/*||;
         $self->_neb_start();
         return (defined $self->{nebulous}->find_instances( $name ) ? 1 : 0);
@@ -350 +345 @@
     $self->file_prepare( $target );
 
-    my $uri = URI->new( $target );# URI parser
-    my $scheme = $uri->scheme();# Scheme for file name
+    my ($scheme) = $target =~ m|^(\S+):|; # The scheme, e.g., file://, path://
     if (defined $scheme and $scheme eq 'neb') {
-        $target = _strip_scheme( $target );
+        $target =~ s|^(\S+):/*||;
         $self->_neb_start();
         $target = $self->{nebulous}->create( $target );
@@ -361 +355 @@
 
     system "cp $source $target";
-}
-
-# Strip the scheme (e.g., "neb://") off a URI name
-sub _strip_scheme
-{
-    my $name = shift;           # File name of interest
-    $name =~ s|^\S+:/*||;
-    return $name;
 }
 
@@ -388 +374 @@
     my $template = shift;       # Template filename from which to get working directory if 
 
-    my $resolved = $name;       # Resolved version of file name
     if (defined $workdir) {
-        $resolved = caturi( $workdir, $name );
+        $name = caturi( $workdir, $name );
     } elsif (defined $template) {
         # Take directory from template and apply to name
         my $dir = _strip_filename( $template );
-        $resolved = caturi( $dir, $name );
-    }
-
-    my $uri = URI->new( $name ); # URI parser
-    my $scheme = $uri->scheme(); # Scheme for file name
+        $name = caturi( $dir, $name );
+    }
+
+    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
     return $name if defined $scheme and $scheme eq 'neb'; # Nothing to be done: Nebulous handles it all
 
     # Might need to create a directory
-    $resolved = $self->convert_filename_absolute( $resolved );
+    my $resolved = $self->convert_filename_absolute( $name );
     my ( $vol, $dirs, $file ) = File::Spec->splitpath( $resolved );
     system "mkdir -p $dirs";
@@ -421 +405 @@
     }
 
-    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') {
-        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, $host, $uri->path() );
-        } else {
-            $path = $uri->path();
-        }
-
-        return File::Spec->canonpath( $path );
-    }
+    $name =~ s|/$||;
+    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file, path
+    $name =~ s|^\S+:/*||;
+    return $name if lc($scheme) eq 'file';
 
     if (lc($scheme) eq 'path') {
-        my $authority = $uri->authority();
-        my $path = $self->datapath( $authority );
-        my @segments = $uri->path_segments();
-        return File::Spec->catfile( $path, @segments );
+        my @dirs = split('/', $name);
+        my $pathName = shift @dirs;
+        my $path = $self->datapath( $pathName );
+        $path =~ s|/*$||;
+        return File::Spec->catfile( $path, @dirs );
     }
 
@@ -455 +426 @@
     my $self = shift;           # Configuration object
     my $name = shift;           # raw name
-
+    
     unless (defined $self and defined $name) {
         carp "Programming error";
         exit($PS_EXIT_PROG_ERROR);
     }
-
+    
     # First, check to see if it's already in a relative form
-    my $scheme = URI->new( $name )->scheme();
-    if ($scheme eq 'path' or $scheme eq 'file') {
-        # We may as well search for a 'better' path
-        $name = $self->convert_filename_absolute( $name );
-    } elsif ($scheme eq 'neb') {
-        # No chance of changing anything --- move along
-        return $name;
-    }
-
+    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file, path
+    if (defined $scheme) {
+        if ($scheme eq 'path' or $scheme eq 'file') {
+            # We may as well search for a 'better' path
+            $name = $self->convert_filename_absolute( $name );
+        } elsif ($scheme eq 'neb') {
+            # No chance of changing anything --- move along
+            return $name;
+        }
+    }
+    
     $name = File::Spec->canonpath( $name); # Clean up
-    my ($vol, $dir, $file) = File::Spec->splitpath( $name );
-    my @dirs = File::Spec->splitdir( $dir );
-    pop @dirs;                  # Get rid of filename
-
+    my @dirs = File::Spec->splitdir( $name );
+    
     my $path_list = metadataLookupMD($self->{_ipprc}, 'DATAPATH'); # List of paths
     my $best_path;
@@ -483 +454 @@
       my $path_name = $path_item->{name}; # Name of the path
       my $path = File::Spec->canonpath( $path_item->{value} ); # The path
+      $path =~ s|/*$||;
       my @path_dirs = File::Spec->splitdir( $path );
-
+      
       # Check if the path is suitable
       next if scalar @path_dirs > scalar @dirs;
@@ -498 +470 @@
       }
   }
-    my $uri = URI->new();       # URI to return
+    
+    $name =~ s|^/||;
+    $name =~ s|/$||;
     if (defined $best_score) {
-        my $rel = File::Spec->abs2rel( $name, $best_path );
-        my @segments = File::Spec->splitdir( $rel );
-        $uri->scheme( 'path' );
-        $uri->authority( $best_name );
-        $uri->path_segments( @segments );
-    } else {
-        $uri->scheme( 'file' );
-        $uri->path( $name );
-    }
-
-    return $uri->as_string();
+        $best_path =~ s|^/||;
+        $best_path =~ s|/$||;
+        $name =~ s|^$best_path|$best_name|;
+        return 'path://' . $name;
+    }
+    return 'file://' . $name;
 }