#!/usr/local/bin/perl -w

=pod

=head1 TOZOPE -- Copy files into Zope

=head2 Usage

tozope [-U usrname] [-P pwd] [-f file] file [file ...]

=head2 Description

Tozope is a command line script for installing files into Zope. The
script determines the type of the file (html, image, or ordinary file)
from the file extension.  The script sets the metadata for each
upladed file from the default values contained in this script.

The arguments are the files to upload. Wild card characters may be
used in the file name and they will be expanded by the Unix shell.

=head2 Input

=over 4

=item file

The name of the file to be uploaded. More than one file can be passed
on the command line. Each file may have a metadata file associated
with it. 

The metadata file has the same root name as the the file, but has the
extension '.meta'. Files may contain comments, which are preceded by a
# character. Metadata items are name=value pairs, one per line. If a
line does not an equals sign, the value is appended to the previous
line. If the value is surrounded by square brackets, it is treated as
a list of values. Values in the list are separated by commas and may
optionally be surrounded by quotes.

=back

=head2 Options

=over 4

=item -U

Your Zope user name. If it is not supplied, the script will prompt you 
for it.

=item -P

Your Zope password. If it is not supplied (this is recommended), the
script will prompt you for it.

=item -f

A file containing a list of files to be uploaded one per line. These
file names are added to any files passed as command line arguments

=item -m

The url of the folder containing the previous version of the uploaded
files. The script will read the metadata of the previous version if it
exists under the same name in the metadata folder. Values in the
metadata file will override values read from the folder.

=item -a

Only upload metadata. Do not upload files.

=item -q

Query the user before creating a new directory. Exit script if user
answers no.


=item -v

Print the version string and exit.

=back

=head2 Customization

Set up a deault metadata file in your home directory called
".tozoperc".  It sould contain default values for metadata items as
name=value pairs. These values will be used whenever a corresponding
value is not found in the metadata file associated with the file to be 
uploaded.

The C<default_metadata> hash contains the metadata the will be set for
the uploaded files. Edit the values (on the right hand side of the
arrow) to set the values you wish to use. The C<addfile_suffix> hash
contains the name of the method used to install the uploaded file in
Zope.  The method is chosen based on the file extension. If none of
the extensions match, the method labelled '*' is used. The three
methods allow you to add documents (html or dtml code), images, an
files (downloadable info). Add a new entry to recognize a new
extension. The C<readmeta_suffix> is the Xope method that reads
metadata on an aobject and the C<metadata_suffix> is the Zope method
that sets metadata.  It probably should not be changed. The
C<base_folder> is used to construct an absolute url when a relative
url is passed as the first argument to the script. It should be set to
the url of the machine you are uploading to. Make sure it has a
trailing slash. The C<default_file> contains the name of the file
containg the default metadata. The C<default_metadata> hash contains
really default values for metadata items. These values are used if the
are not overridden in the metadata file. The C<netadata_types> hash
associates types with metadata items where the type is something other
than string.

=head2 Installation

Copy this script into a directory in your path and name it C<tozope>.
Set permissions so that it is executable with the C<chmod>
command. Edit the configuration variables as needed. Contact me at
C<bsimon@stsci.edu> if you have any problems.

=cut


#----------------------------------------------------------------------
# Upload files to Zope without setting metadata
#----------------------------------------------------------------------

use strict;

use URI;
use Getopt::Std;
use Term::ReadKey;
use LWP::UserAgent;
use Text::ParseWords;
use Cwd qw(abs_path);
use HTTP::Request::Common;
##use LWP::Debug qw(+ -conns);

#----------------------------------------------------------------------
# Configuration variables
#----------------------------------------------------------------------

$| = 1;
our $version = '2.1';

# Domain used in authenticating
our $domain = 'Zope';

# Zope methods for uploading, parameterized by extension
our %addfile_suffix = (
		      dat => 'manage_addSTDocument',
		      gif => 'manage_addSTImage',
		      jpg => 'manage_addSTImage',
		      png => 'manage_addSTImage',
		      doc => 'manage_addSTFile',
		      html => 'manage_addSTDocument',
		      pdf => 'manage_addSTFile',
		      txt => 'manage_addSTFile',
		      xls => 'manage_addSTFile',
		      '*' => 'manage_addSTFile',
		   );

# Zope method for creating a new folder
our $addfolder_suffix = 'manage_addProduct/STObjects/manage_addSTFolder';
 
# Zope method for deleting a file
our $delete_suffix = 'manage_delObjects';

# Zope method for getting metadata
our $readmeta_suffix = 'listMetadata';

# Zope method for setting metadata
our $addmeta_suffix = 'editMetadata';

# Extension used by metadata files
our $meta_extension = 'meta';

# Default server base
our $base_folder = 'http://rodan.stsci.edu:8084/stsci/hst/HST_overview/TwoGyroMode/AllSkyInformation/';

# File to intialize defaults
our $default_file = '~/.tozoperc';

# Default metadata names and values 
our $default_metadata = {
			  'subject' => 'STScI', 
			  'description' => ' ',
			  'creator' => ' ',
			  'contributors' => ' ',
			  'effective_date' => 'None',
			  'expiration_date' => 'None',
			  'source' => 'None',
			  'relation' => 'None',
			  'coverage' => 'n/a',
			  'rights' => 'None',
			  'publisher' => 'Space Telescope Science Institute',
			  'language' => 'en-US',
			  'type' => 'text',
			  'audience' => 'anonymous',
			  'doc_style' => 'status report',
			};

our $metadata_types = {
			'subject' => 'list',
			'description' => 'text',
			'contributors' => 'lines',
		      };

#----------------------------------------------------------------------
# Main routine
#----------------------------------------------------------------------

# Read command line flags

my %opt;
getopts ('U:P:f:m:vqa', \%opt);

if ($opt{v}) {
    print "$version\n";
    exit (0);
}

# Set metadata only flag

my $meta_only = $opt{a};

# If -m flag set, read metadata from corresponding file in metadata firectory

my $meta_directory;
$meta_directory = fix_url ($base_folder, $opt{m}) if defined $opt{m};

# If -f flag set, read arguments from file and push on ARGV

if (defined $opt{f}) {
    my $fd;
    open ($fd, "<$opt{f}") || die "Can't read $opt{f}: $!\n";
    while (<$fd>) {
	s/^\s+//;
	s/\s+$//;
	next unless $_;
	push @ARGV, $_;
    }
    close ($fd);
}

my $first_metadata = initialize_metadata ();

# Open internet connection

my $host_url = $base_folder;
$host_url =~ s%^[^/]*//%%;	# remove http://
$host_url =~ s%/.*$%%;		# remove everything after slash

my $ua = connect_server ($host_url, $opt{U}, $opt{P});

# Loop over list of files to upload

foreach my $file (@ARGV) {
    next if $file =~ /\.$meta_extension$/o;

    # Get folder name from file name

    my ($folder_name) = split (/-/, $file);
    my $folder_url = fix_url ($base_folder, $folder_name);

    unless ($meta_only) {
	# Create the folder for the files if it does not exist

	if (! file_exists ($ua, $folder_url, '')) {
	    if ($opt{q}) {
		ask_user ("$folder_url does not exist\nShould I create it?\n")
		  or die "Program terminated\n";
	    }

	    add_file ($ua, $folder_url, '', $meta_directory, $first_metadata);
	}

	add_file ($ua, $folder_url, $file, $meta_directory, $first_metadata);
    }

    add_metadata ($ua, $folder_url, $file, $meta_directory, $first_metadata);

    print "Added $folder_name/$file\n";
}

#----------------------------------------------------------------------
# ABSOLUTE_NAME -- Counstruct the full pathname of a file
#----------------------------------------------------------------------

sub absolute_name {
    my ($path) = @_;

    my @path = split (/\//, $path);

    my $file = pop (@path);

    if (@path) {
	$path = join ('/', @path);
    } else {
	$path = '.';
    }

    $path = abs_path ($path) if $path;

    return "$path/$file";
}

#----------------------------------------------------------------------
# ADD_FILE -- Add a file and its metadata to Zope 
#----------------------------------------------------------------------

sub add_file {
    my ($ua, $folder_url, $file, $meta_directory, $first_metadata) = @_;

    # Add file to Zope thru html forms interface

    if ($file eq '') {
	create_folder ($ua, $folder_url);

    } else {
	my ($root, $ext) = split (/\./, $file);
	my $addfile_suffix = $addfile_suffix{$ext} || $addfile_suffix{'*'};

	if (file_exists ($ua, $folder_url, $file)) {
	    delete_file ($ua, $folder_url, $file, $delete_suffix);
	}

	create_file ($ua, $folder_url, $file, $addfile_suffix);
    }

}

#----------------------------------------------------------------------
# ADD_METADATA -- Add metadata to file
#----------------------------------------------------------------------

sub add_metadata {
    my ($ua, $folder_url, $file, $meta_directory, $first_metadata) = @_;


    # Read current metadata if file already exists

    my $metadata = existing_metadata ($ua, $meta_directory, $file, 
				      $first_metadata);

    # Update with contents of meta file

    $metadata = new_metadata ($file, $metadata);

    # Make the changes in Zope

    my $meta_array = reformat_metadata ($metadata);

    create_metadata ($ua, $folder_url, $file, $addmeta_suffix, $meta_array);
}

#----------------------------------------------------------------------
# ASK_USER -- Ask the user a question with a yes or no answer
#----------------------------------------------------------------------

sub ask_user {
    my ($question) = @_;

    chomp $question;

    while (1) {
	print $question, "\n(Yes or No ?) ";

	my $answer = ReadLine (0);
	chomp $answer;

	return 1 if $answer =~ /^(y|yes)\s*$/i;
	return 0 if $answer =~ /^(n|no)\s*$/i;

	$question = "Please answer yes or no";
    }
}

#----------------------------------------------------------------------
# BASE_NAME -- Get file name minus any leading directories
#----------------------------------------------------------------------

sub base_name {
    my ($file) = @_;

    my ($base) = $file =~ /([^\/]*)$/;
    return $base;
}

#----------------------------------------------------------------------
# CONNECT_SERVER -- Create a connection to the web server
#----------------------------------------------------------------------

sub connect_server {
    my ($host, $user, $pass) = @_;

    my $ua = LWP::UserAgent->new;

    ($user, $pass) = getword ($user, $pass);
    $ua->credentials ($host, $domain, $user, $pass);

    return $ua;
}

#----------------------------------------------------------------------
# CREATE_FILE -- Create a new file in Zope
#----------------------------------------------------------------------

sub create_file {
    my ($ua, $folder_url, $file, $addfile_suffix) = @_;

    my $form_input = [];

    # Make the file name the Zope ID

    my $base = base_name ($file);
    push (@$form_input, 'id', $base); 

    # Placing the filename field in an array marks it as a file
    # rather than a string to the request method

    my $path = absolute_name ($file);
    push (@$form_input, 'file', [$path]);

    my $form_url = "$folder_url/$addfile_suffix";

    my $response = $ua->request (POST $form_url, 
				 'Content_Type' => 'form-data',
				 'Content' => $form_input);

    show_error ($response) if $response->is_error;
}

#----------------------------------------------------------------------
# CREATE_FOLDER -- Create a new folder in Zope
#----------------------------------------------------------------------

sub create_folder {
    my ($ua, $folder_url) = @_;

    $folder_url =~ s{/$}{};
    my ($parent, $folder) = $folder_url =~ m{^(.*)/([^/]*)};

    # Make the file name the Zope ID

    my $form_input = ['id', $folder, 
		      'createPublic:int', 0, 
		      'createUserF:int', 0];

    my $form_url = "$parent/$addfolder_suffix";

    my $response = $ua->request (POST $form_url, $form_input);

    show_error ($response) if $response->is_error;
}

#----------------------------------------------------------------------
# CREATE_METADATA -- Create metadata for file
#----------------------------------------------------------------------

sub create_metadata {
    my ($ua, $folder_url, $file, $addmeta_suffix, $metadata) = @_;

    my $base = base_name ($file);
    my $form_url = "$folder_url/$base/$addmeta_suffix";
    $form_url =~ s{([^:]/)/+}{$1}g;

    # The default content type is url_encoded, so there is 
    # no need to specify it

    my $response = $ua->request (POST $form_url, $metadata);

    show_error ($response) if $response->is_error;
}

#----------------------------------------------------------------------
# DELETE_FILE -- Create a new file in Zope
#----------------------------------------------------------------------

sub delete_file {
    my ($ua, $folder_url, $file, $delete_suffix) = @_;

    my $form_input = [];

    # Make the file name the Zope ID

    my $id = base_name ($file);
    push (@$form_input, 'ids:list', $id); 

    my $form_url = "$folder_url/$delete_suffix";

    my $response = $ua->request (POST $form_url, $form_input);

    show_error ($response) if $response->is_error;
}

#----------------------------------------------------------------------
# EXISTING_METADATA -- Read metadata on existing objects
#----------------------------------------------------------------------

sub existing_metadata {
    my ($ua, $meta_directory, $file, $metadata) = @_;

    return $metadata unless defined $meta_directory;

    my $base = base_name ($file);
    my $qry = "$meta_directory/$base/$readmeta_suffix";
    $qry =~ s{([^:]/)/+}{$1}g;

    # The default content type is url_encoded, so there is 
    # no need to specify it

    my $response = $ua->request (GET $qry);
    return $metadata if $response->is_error;

    my $page = $response->content ();
    return extract_metadata ($page, $metadata);
}

#----------------------------------------------------------------------
# EXTRACT_LINE -- Extract a single metadata item 
#----------------------------------------------------------------------

sub extract_line {
    my ($buf, $metadata) = @_;

    my $type;
    my ($name, $value) = split (/\s*=\s*/, $buf, 2);

    if ($name =~ /:/) {
	($name, $type) = split (/:/, $name, 2);

    } elsif ($metadata->{$name}) {
	($name, $type) = split (/:/, $metadata->{$name}{name}, 2);

    } else {
	$type = '';
    }

    $value = extract_value ($value);

    $metadata->{$name} = {};

    if ($type) {
	$metadata->{$name}{name} = "$name:$type";

    } elsif (ref $value) {
	$metadata->{$name}{name} = "$name:list";

    } else {
	$metadata->{$name}{name} = $name;
    }

    $metadata->{$name}{value} = $value;

    return $metadata;
}

#----------------------------------------------------------------------
# EXTRACT_METADATA -- Extract metadata from page
#----------------------------------------------------------------------

sub extract_metadata {
    my ($page, $metadata) = @_;

    my $buf;
    my @line = split (/\n/, $page);

    foreach my $line (@line) {
	$line =~ s/\#[^\#]+$//;
	$line =~ s/^\s+//;
	$line =~ s/\s+$//;

	if (defined($buf) && ($line =~ /=/ || $line !~ /\S/)) {
	    $metadata = extract_line ($buf, $metadata);

	    if ($line =~ /\S/) {
		$buf = $line;
	    } else {
		undef $buf;
	    }

	} elsif ($line =~ /\S/) {
	    if (defined $buf) {
		$buf .= " $line";
	    } else {
		$buf = $line;
	    }
	}
   }

    $metadata = extract_line ($buf, $metadata) if defined ($buf);
    return $metadata;
}

#----------------------------------------------------------------------
# EXTRACT_VALUE -- Extract a value or list of values from a string
#----------------------------------------------------------------------

sub extract_value {
    my ($value) = @_;

    return $value unless $value =~ s/^\s*\[([^\]]*)\]\s*$/$1/;

    my $keep = 0;
    my @value = parse_line ('\s*,\s*', $keep, $value);

    return \@value;
}

#----------------------------------------------------------------------
# FIX_URL -- Put url in canonical form
#----------------------------------------------------------------------

sub fix_url {
    my ($base, $url) = @_;

    my $abs_url = URI->new_abs ($url, $base)->canonical;
    $abs_url =~ s/\/$//;
    return $abs_url;
}

#----------------------------------------------------------------------
# FILE_EXISTS -- Check for the existence of a Zope folder
#----------------------------------------------------------------------

sub file_exists {
    my ($ua, $folder_url, $file) = @_;

    $folder_url .= '/' unless $folder_url =~ /\/$/;
    my $file_url = $folder_url . $file; 

    my $response = $ua->request (HEAD $file_url);
    return ! $response->is_error;
}

#----------------------------------------------------------------------
# GETWORD -- Read user name and password 
#----------------------------------------------------------------------

sub getword {
    my ($user, $pass) = @_;

    unless ($user) {
	print 'Zope User Name: ';
	$user = ReadLine (0);
	chomp ($user);
    }

    unless ($pass) {
	print 'Zope Password: ';
	ReadMode ('noecho');
	$pass = ReadLine (0);
	chomp ($pass);
	ReadMode ('normal');
	print "\n";
    }

    return ($user, $pass);
}

#----------------------------------------------------------------------
# INITIALIZE_METADATA -- Create the structure used to hold metadata
#----------------------------------------------------------------------

sub initialize_metadata {

    my $metadata = {};
    foreach my $name (keys %$default_metadata) {
	$metadata->{$name} = {};
	$metadata->{$name}{value} = $default_metadata->{$name};

	if (my $type = $metadata_types->{$name}) {
	    $metadata->{$name}{name} = "$name:$type";
	} else {
	    $metadata->{$name}{name} = $name;
	}
    }

    return read_metadata ($default_file, $metadata);
}

#----------------------------------------------------------------------
# NEW_METADATA -- Read metadata values from text file
#----------------------------------------------------------------------

sub new_metadata {
    my ($file, $metadata) = @_;

    # Set default title from the basename

    my ($root, $ext) = split (/\./, $file);

    my $base = base_name ($root);

    $metadata->{title} = {name => 'title', value => "\u$base"} 
      unless exists $metadata->{title};

    # Read remaining metadata items from the file

    my $metafile = "$root.$meta_extension";
    return read_metadata ($metafile, $metadata);
}

#----------------------------------------------------------------------
# READ_METADATA -- Read metadata values from a file
#----------------------------------------------------------------------

sub read_metadata {
    my ($metafile, $metadata) = @_;

    $metadata = {} unless defined $metadata;
    $metafile =~ s/^~/$ENV{HOME}/;

    if ( -e $metafile) {
	my $fd;
	local $/;

	open ($fd, $metafile) || die "Can't open $metafile: $!";

	my $page = <$fd>;
	$metadata = extract_metadata ($page, $metadata);
	close ($fd);
    }

    return $metadata;
}

#----------------------------------------------------------------------
# REFORMAT_METADATA -- Reformat input for use by Request::Common
#----------------------------------------------------------------------

sub reformat_metadata {
    my ($metadata) = @_;
    my $meta_array = [];

    foreach my $id (keys %$metadata) {
	my $name = $metadata->{$id}{name};
	my $value = $metadata->{$id}{value};

	if (ref ($value) eq 'ARRAY') {
	    # Multiple values were passed in as arrays

	    foreach my $item (@$value) {
		push (@$meta_array, $name, $item);
	    }

	} else {
	    push (@$meta_array, $name, $value);
	}
    }

    return $meta_array;
}

#----------------------------------------------------------------------
# SHOW_ERROR -- Get error message from Zope response
#----------------------------------------------------------------------

sub show_error {
    my ($response) = @_;

    my ($type) = 
      $response->content =~ /<strong>Error Type: (.*)<\/strong>/;
    my ($value) = 
      $response->content =~ /<strong>Error Value: (.*)<\/strong>/;

    print STDERR $response->status_line, "\n";
    print STDERR $type, "\n" if defined ($type);
    print STDERR $value, "\n" if defined ($value);

    exit(1);
}
