Changeset 13250

Timestamp:

May 4, 2007, 1:36:04 PM (19 years ago)

Author:

Paul Price

Message:

Adding new functions to support Nebulous.

File:

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

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

@@ -1 +1 @@
 # Copyright (c) 2006  Paul Price, Joshua Hoblitt
 #
-# $Id: Config.pm,v 1.39 2007-05-04 19:41:23 eugene Exp $
+# $Id: Config.pm,v 1.40 2007-05-04 23:36:04 price Exp $
 
 package PS::IPP::Config;
@@ -11 +11 @@
 
 use Carp qw( carp );
-use File::Spec;
-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 File::Spec 3.19;
+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 Nebulous::Client 0.02;
 
 use base qw( Class::Accessor::Fast Exporter );
@@ -20 +21 @@
 
 our @EXPORT_OK = qw(
-    $PS_EXIT_SUCCESS
-    $PS_EXIT_UNKNOWN_ERROR
-    $PS_EXIT_SYS_ERROR
-    $PS_EXIT_CONFIG_ERROR
-    $PS_EXIT_PROG_ERROR
-    $PS_EXIT_DATA_ERROR
-    $PS_EXIT_TIMEOUT_ERROR
-    metadataLookupStr
-    metadataLookupMD
-);
+                    $PS_EXIT_SUCCESS
+                    $PS_EXIT_UNKNOWN_ERROR
+                    $PS_EXIT_SYS_ERROR
+                    $PS_EXIT_CONFIG_ERROR
+                    $PS_EXIT_PROG_ERROR
+                    $PS_EXIT_DATA_ERROR
+                    $PS_EXIT_TIMEOUT_ERROR
+                    metadataLookupStr
+                    metadataLookupMD
+                    caturi
+                    );
 
 our $PS_EXIT_SUCCESS = 0;
@@ -160 +162 @@
 }
 
+# Concatenate elements of a URI
+sub caturi
+{
+    my $base = shift;           # Base name (might be "path://SOMETHING" or "neb://SOMETHING")
+    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();
+}
 
 # select a datapath from config.site
@@ -182 +212 @@
 }
 
+# Start up Nebulous
+sub _neb_start
+{
+    my $self = shift;           # Configuration object
+
+    return 1 if defined $self->{nebulous}; # Already started
+
+    my $server = metadataLookupStr( $self->{_ipprc}, 'NEB_SERVER' ); # Nebulous server
+    unless (defined $server) {
+        carp "Unable to find NEB_SERVER in camera configuration file.";
+        exit($PS_EXIT_CONFIG_ERROR);
+    }
+
+    my $neb = Nebulous::Client->new( proxy => $server );
+    unless (defined $neb) {
+        carp "Unable to find NEB_SERVER in camera configuration file.";
+        exit($PS_EXIT_CONFIG_ERROR);
+    }
+
+    $self->{nebulous} = $neb;
+
+    return 1;
+}
+
+
+# Resolve a URI to a file name
+sub file_resolve
+{
+    my $self = shift;           # Configuration object
+    my $name = shift;           # File name to check
+
+    my $uri = URI->new( $name );# URI parser
+    my $scheme = $uri->scheme();# Scheme for file name
+
+    return $name unless defined $scheme; # Probably a file name instead of a URI
+
+    if ($scheme eq 'neb') {
+        $name = _strip_scheme( $name );
+        $self->_neb_start();
+        my $neb = $self->{nebulous}; # Nebulous handle
+        return $neb->find( $name );
+    }
+    if ($scheme eq 'path' or $scheme eq 'file') {
+        return $self->convert_filename_absolute( $name );
+    }
+
+    return $name;
+}
+
+# Create and open file
+sub file_create_open
+{
+    my $self = shift;           # Configuration object
+    my $name = shift;           # File name to check
+
+    $self->file_prepare( $name );
+
+    my $uri = URI->new( $name );# URI parser
+    my $scheme = $uri->scheme();# Scheme for file name
+    if (defined $scheme) {
+        if ($scheme eq 'neb') {
+            $name = _strip_scheme( $name );
+            $self->_neb_start();
+            return $self->{nebulous}->open_create( $name );
+        }
+        if ($scheme eq 'path' or $scheme eq 'file') {
+            $name = $self->convert_filename_absolute( $name );
+        }
+    }
+
+    if (-f $name) {
+        carp "Unable to create file $name --- file exists.";
+        exit($PS_EXIT_SYS_ERROR);
+    }
+
+    my $fh;
+    unless (open $fh, '>', $name) {
+        carp "Unable to create file $name --- $!";
+        exit($PS_EXIT_SYS_ERROR);
+    }
+    return $fh;
+}
+
+# Create a file (intended principally to abstract Nebulous files)
+sub file_create
+{
+    my $self = shift;           # Configuration object
+    my $name = shift;           # File name to check
+
+    $self->file_prepare( $name );
+
+    my $uri = URI->new( $name );# URI parser
+    my $scheme = $uri->scheme();# Scheme for file name
+    if (defined $scheme and $scheme eq 'neb') {
+        $name = _strip_scheme( $name );
+        $self->_neb_start();
+        return $self->{nebulous}->create( $name );
+    }
+
+    return $name;
+}
+
+# Copy a file
+sub file_copy
+{
+    my $self = shift;           # Configuration object
+    my $source = shift;         # Name of source file
+    my $target = shift;         # Name of target file
+
+    $self->file_prepare( $target );
+
+    my $uri = URI->new( $target );# URI parser
+    my $scheme = $uri->scheme();# Scheme for file name
+    if (defined $scheme) {
+        if ($scheme eq 'neb') {
+            $target = _strip_scheme( $target );
+            $self->_neb_start();
+            $target = $self->{nebulous}->create( $target );
+        } else {
+            $target = $self->convert_filename_absolute( $target );
+        }
+    }
+
+    $source = $self->file_resolve( $source );
+
+    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;
+}
+
+# Strip the filename (the last element of the URI), returning the scheme and directory part
+sub _strip_filename
+{
+    my $name = shift;           # File name of interest
+    $name =~ s|/[\w.-]*?$||;
+    return $name;
+}
+
+# Prepare to receive a new file --- create the directory, if appropriate.  Return the appropriate filename
+# Does not register anything with Nebulous
+sub file_prepare
+{
+    my $self = shift;           # Configuration object
+    my $name = shift;           # File name for which to prepare
+    my $workdir = shift;        # Working directory
+    my $template = shift;       # Template filename from which to get working directory if 
+
+    if (defined $workdir) {
+        $name = caturi( $workdir, $name );
+    } elsif (defined $template) {
+        # Take directory from template and apply to name
+        my $dir = _strip_filename( $template );
+        $name = caturi( $dir, $name );
+    }
+
+    my $uri = URI->new( $name ); # URI parser
+    my $scheme = $uri->scheme(); # Scheme for file name
+    return $name if defined $scheme and $scheme eq 'neb'; # Nothing to be done: Nebulous handles it all
+
+    # Might need to create a directory
+    $name = $self->convert_filename_absolute( $name );
+    my ( $vol, $dirs, $file ) = File::Spec->splitpath( $name );
+    system "mkdir -p $dirs";
+
+    return $name;
+}
+
+
+# Convert a relative filename (e.g., "path://PATH/file") to an absolute (e.g., "/path/to/file")
 sub convert_filename_absolute
 {
@@ -221 +426 @@
 }
 
+# Convert a relative filename (e.g., "/path/to/file") to an absolute (e.g., "path://PATH/file")
 sub convert_filename_relative
 {
@@ -229 +435 @@
         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;
     }