#!/usr/local/bin/perl
use lib '/usr/local/rib/lib';
# NHSE Repository in a Box (RIB)
#
# The authors of this software are Paul McMahan and Jeff Horner.
# Copyright (c) 1997 by the University of Tennessee.
# Permission to use, copy, modify, and distribute this software for any
# purpose without fee is hereby granted, provided that this entire notice
# is included in all copies of any software which is or includes a copy
# or modification of this software and in all copies of the supporting
# documentation for such software.
# THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTY. IN PARTICULAR, NEITHER THE AUTHORS NOR UNIVERSITY OF TENNESSEE
# MAKE ANY REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE
# MERCHANTABILITY OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
#
# $Id: add_nonlocal_link.pl,v 1.2 1997/12/18 18:08:53 rib Exp $
#
# $Log: add_nonlocal_link.pl,v $
# Revision 1.2 1997/12/18 18:08:53 rib
# - Changed gen_catalog so that the input box for the search on the top level
# catalog page isn't so wide. changed to SIZE=45
#
# - fixed a bug in install_file.pl which caused the header/footer file on
# the verification page to be encoded in the box but not in the
# regular body of the page.
#
# - fixed a bug in gen_catalog which caused the documents in catalog/ to
# be indexed instead of the documents in catalog/*/
#
# - added a note to edit_object.pl that tells the user that they need
# to update the catalog if the object was an asset and if a catalog
# currently exists.
#
# - changed add_nonlocal_link.pl to not be so strict in checking the urls
# before it attempts to add them. it no longer counts a url that's
# already in the repository as an error leading towards exit
#
# Revision 1.1.1.1 1997/12/10 15:59:32 jhorner
# RIB pre 1.0
#
# Revision 1.1 1997/05/06 18:16:02 jhorner
# Initial revision
#
use strict;
use RIB::Util ();
use RIB::ConfigParser ();
use LWP::UserAgent ();
use HTTP::Request ();
use HTML::Entities ();
my $util = RIB::Util->new();
my %in = RIB::Util->ReadParse();
$util->PrintHeader();
my $repository = $util->GetRepoName();
if (!$repository) {
$util->ErrorMessage("repository was not specifed in your input.");
}
my $filepath = $util->GetRibDir() . "/repositories/" . $repository;
my $urlpath = $util->GetRibUrl() . "/repositories/" . $repository;
my $back_to_top = $util->BackToTop($repository);
#############################################################################
print "";
print "Add a link\n";
print "\n";
print "\n";
print "
\n";
print "
Add links to Assets in a foreign repository
\n";
print "
\n";
print "
\n";
## STEP 4
if ($in{verified} and $in{urls}) {
# Start of critical section for .nonlocal file
unless($util->InitNonLocal($repository)){
$util->ErrorMessage("internal error : Couldn't access nonlocal file, Please contact "
. "your RIB administrator");
}
print "Adding links to foreign Assets...\n";
print "
\n";
foreach (split (/\s+/, $in{urls})) {
print "
$_
\n";
if ($util->NonLocalLink($_)) {
print "
not added : already in this repository's list of links\n";
} elsif (!$util->AddNonLocalLink($_)){
print "
not added : internal error. (possibly a lock file).\n";
} else {
print "
added.\n";
}
print "
\n";
}
print "
\n";
$util->CommitNonLocal();
# End of critical section for .nonlocal file
print $back_to_top;
print "
";
print "Delete a link\n";
exit;
}
## STEP 3
elsif ($in{listurl} or $in{textarea}) {
$in{listurl} =~ s/^\s*(\S+).*/$1/; # get rid of whitespace
my (@urls, $url, $list);
if ($in{type} eq 'list') {
if ($in{listurl}) {
my $ua = LWP::UserAgent->new("RIB/1.0");
my $req = HTTP::Request->new('GET',$in{listurl});
my $res = $ua->request($req);
if ($res->is_error){
$util->ErrorMessage("Couldn't retrieve " . $req->url . ": "
. $res->code. " ". $res->message);
}
$list = $res->content();
} else {
$list = $in{textarea}
}
print "Examining list ";
$in{listurl} && print "at $in{listurl}\n";
print "...\n";
print "
\n";
my $errors = 0;
while ($list=~s/^\s*(\S+)\s*//m) {
if ($errors > 10) {
print "
\n";
print "Too many errors -bailing out...\n";
if ($in{type} eq 'list') {
$util->ErrorMessage("The file that you specified appears to not be a list of "
. "urls but is perhaps an object file(?). Remember that "
. "the url that you specified on the previous page was supposed "
. "to point at a collection of urls to Asset "
. "description files, and not an individual Asset description "
. "file. If you want to specify a url which points to an "
. "individual Asset description file then click "
. "here.\n");
} else {
$util->ErrorMessage("The list of urls that you specified on the previous page "
. "could not be added.");
}
}
$url = $1;
print "
$url
\n";
if ($url !~ /^(http|ftp|gopher|file):\/\//) {
print "
cannot be added : doesn't appear to be a valid url\n";
$errors++;
} elsif ($url =~ /^\Q$urlpath\E/) {
print "
cannot be added : would create a link to an Asset\n";
print "already in this repository\n";
} else {
print "
looks ok...\n";
push (@urls, $url);
}
print "
\n";
}
print "\n";
}
else {
$in{textarea} =~ s/^\s*(\S+)\s*/$1/;
push (@urls, $1);
}
if (@urls) {
print "Are you sure\n";
print "that you want to add the following url(s) to this ";
print "repository's list of nonlocal Assets?
\n";
print "
\n";
} else {
print "None of the url(s) that you specified could be added to this repository's list ";
print "of foreign Assets. \n";
print "Click here if you would ";
print "like to try to submit another ";
$in{type} eq 'list' ? print "collection of urls.\n" : "url.\n";
}
print $back_to_top;
exit;
}
## STEP 2
elsif ($in{type} eq 'single') {
print "\n";
print $back_to_top;
exit;
}
elsif ($in{type} eq 'list') {
print "\n";
print "
or you can paste the links into the form below.\n";
print "