Changeset 16203 for trunk/Nebulous/lib

Timestamp:

Jan 23, 2008, 12:27:51 PM (18 years ago)

Author:

jhoblitt

Message:

add Nebulous::Util::parse_neb_key()

File:

• trunk/Nebulous/lib/Nebulous/Util.pm (modified) (4 diffs)

trunk/Nebulous/lib/Nebulous/Util.pm

@@ -1 +1 @@
 # Copyright (c) 2004  Joshua Hoblitt
 #
-# $Id: Util.pm,v 1.7 2007-05-08 02:27:42 jhoblitt Exp $
+# $Id: Util.pm,v 1.8 2008-01-23 22:27:51 jhoblitt Exp $
 
 package Nebulous::Util;
@@ -12 +12 @@
 use base qw( Exporter );
 
+use File::Spec::Functions;
 use Log::Log4perl qw( :levels );
 use URI::file;
@@ -22 +23 @@
     _get_filehandle
     _open_uri
+    parse_neb_key
 );
 
@@ -78 +80 @@
 }
 
+sub parse_neb_key
+{
+    my $text = shift;
+
+    # white space is not allowed
+    if ($text =~ qr/\s+/) {
+        die "keys and URIs may not contain whitespace";
+    }
+
+    my $uri = URI->new($text);
+    my $scheme = $uri->scheme;
+    my $path = $uri->opaque;
+    
+    my $volume;
+    # if this is a valid uri 
+    if (defined $scheme) {
+        # if so, does it use the neb scheme?
+        die "URI does not use the 'neb' scheme"
+            unless $scheme eq 'neb'; 
+
+        # neb:path (not allowed)
+        # neb://<volume name>/...
+        # neb:/path... (leading '/' is stripped)
+        # neb:///path... (same as neb:/path)
+
+        # volume specifier must be at least one character
+        # strip off volume component if it exists
+        $path =~ s|^//([^/]+)||;
+        $volume = $1;
+
+        # require a leading slash if there is no volume name
+        if ((not defined $volume) and (not $path =~ m|^/|)) {
+            die "neb URI scheme requires a leading slash, eg. neb:/";
+        }
+    }
+
+    # strip leading slashes
+    $path =~ s|^/+||;
+
+    # remove multiple /'s and trailing slashes
+    $path = canonpath($path);
+
+    return ($path, $volume);
+}
+
 1;