X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;ds=inline;f=web%2Fhtdocs%2Fdetails%2Fedit.mc;h=375e3efee758d7f88bf795367f510de951ea7435;hb=ffa668f5cfcace8660285e58d2b777c83eeb35f2;hp=4bb0670eac0559a2f7887facb5c8ae1ba3abe6a2;hpb=14d42e4137b1dd2b5cdfc983e45ac45d5a36805b;p=irspy-moved-to-github.git
diff --git a/web/htdocs/details/edit.mc b/web/htdocs/details/edit.mc
index 4bb0670..375e3ef 100644
--- a/web/htdocs/details/edit.mc
+++ b/web/htdocs/details/edit.mc
@@ -1,7 +1,6 @@
-%# $Id: edit.mc,v 1.31 2007-04-27 14:32:09 mike Exp $
<%args>
$op
-$id => undef
+$id => undef ### should be extracted using utf8param()
$update => undef
%args>
<%doc>
@@ -32,51 +31,81 @@ duplicate ID.
die "op = new but id defined" if $op eq "new" && defined $id;
die "op != new but id undefined" if $op ne "new" && !defined $id;
-my $conn = new ZOOM::Connection("localhost:8018/IR-Explain---1", 0,
+my $db = ZOOM::IRSpy::connect_to_registry();
+my $conn = new ZOOM::Connection($db, 0,
user => "admin", password => "fruitbat",
elementSetName => "zeerex");
+
+my $protocol = utf8paramTrim($r, "protocol");
+my $host = utf8paramTrim($r, "host");
+my $port = utf8paramTrim($r, "port");
+my $dbname = utf8paramTrim($r, "dbname");
+my $title = utf8paramTrim($r, "title");
+
+if ((!defined $port || $port eq "") &&
+ (defined $protocol && $protocol ne "")) {
+ # Port-guessing based on defaults for each protocol
+ $port = $protocol eq "Z39.50" ? 210 : 80;
+ warn "guessed port $port";
+ &utf8param($r, port => $port);
+}
+
+my $newid;
+if (defined $protocol && $protocol ne "" &&
+ defined $host && $host ne "" &&
+ defined $port && $port ne "" &&
+ defined $title && $title ne "" &&
+ defined $dbname && $dbname ne "") {
+ $newid = irspy_make_identifier($protocol, $host, $port, $dbname);
+}
+
my $rec = '
(New ID specified.)
\n]; - $id = undef; - } -} else { - # No ID supplied -- this is a brand new record - my $protocol = $r->param("protocol"); - my $host = $r->param("host"); - my $port = $r->param("port"); - my $dbname = $r->param("dbname"); - if (!defined $protocol || $protocol eq "" || - !defined $host || $host eq "" || - !defined $port || $port eq "" || - !defined $dbname || $dbname eq "") { +if (!defined $id) { + if (!$update) { + # About to enter data for a new record + # Nothing to do at this stage + } elsif (!defined $newid) { + # Tried to create new record but data is insufficient print qq[-You must specify protocol, host, port and database name.
\n] if $update; + Please specify name, protocol, host, port and database name.\n]; undef $update; + } elsif ($host !~ /^[\w-]+\.[\w.-]*\w$/i) { + print qq[+ This host name is not valid.
\n]; + undef $update; + sleep 25; + } elsif ($port !~ /^\d*$/i) { + print qq[+ This port number is not valid.
\n]; + undef $update; + sleep 25; } else { - ### Should use a utility function for this - my $query = cql_target($protocol, $host, $port, $dbname); - my $rs = $conn->search(new ZOOM::Query::CQL($query)); + # Creating new record, all necessary data is present. Check + # that the new record is not a duplicate of an existing one. + my $rs = $conn->search(new ZOOM::Query::CQL(cql_target($newid))); if ($rs->size() > 0) { - my $fakeid = - xml_encode(uri_escape(irspy_make_identifier($protocol, $host, - $port, $dbname))); + my $qnewid = xml_encode(uri_escape_utf8($newid)); print qq[-There is already -a record -for this host, port and database name. -
\n]; + There is already + a record + for this protocol, host, port and database name. + \n]; undef $update; } } +} else { + # assert(defined $id); + # Copying or editing an existing record: fetch it for editing + my $query = cql_target($id); + my $rs = $conn->search(new ZOOM::Query::CQL($query)); + if ($rs->size() > 0) { + $rec = $rs->record(0); + } else { + ### Is this an error? I don't think the UI will ever provoke it + print qq[(New ID specified.)
\n]; + $id = undef; + } } my $xc = irspy_xpath_context($rec); @@ -92,6 +121,7 @@ my @fields = [ port => 0, "Port", "e:serverInfo/e:port" ], [ dbname => 0, "Database Name", "e:serverInfo/e:database", qw(e:host e:port) ], + [ udb => 0, "Access Name (Unique DB)", "e:databaseInfo/i:udb", qw(e:host e:port e:database) ], [ type => $m->comp("libtype-list.mc"), "Type of Library", "i:status/i:libraryType" ], [ username => 0, "Username (if needed)", "e:serverInfo/e:authentication/e:user", @@ -308,14 +338,16 @@ my @fields = qw(e:title e:description) ], [ subjects => 2, "Subjects", "e:databaseInfo/e:subjects", qw(e:title e:description) ], + [ disabled => [ qw(0 1) ], + "Target Test Disabled", "i:status/i:disabled" ], ); # Update record with submitted data my %fieldsByKey = map { ( $_->[0], $_) } @fields; my %data; -foreach my $key ($r->param()) { +foreach my $key (&utf8param($r)) { next if grep { $key eq $_ } qw(op id update); - $data{$key} = $r->param($key); + $data{$key} = trimField( utf8param($r, $key) ); } my @changedFields = modify_xml_document($xc, \%fieldsByKey, \%data); if ($update && @changedFields) { @@ -325,7 +357,8 @@ if ($update && @changedFields) { "e:metaInfo/e:dateModified" ] }, { dateModified => isodate(time()) }); die "Didn't set dateModified!" if !@x; - ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode(), $id); + ZOOM::IRSpy::_rewrite_zeerex_record($conn, $xc->getContextNode(), + $op eq "edit" ? $id : undef); } %perl> @@ -337,7 +370,14 @@ if ($update && @changedFields) { Changed <% $nchanges %> field<% $nchanges == 1 ? "" : "s" %>: <% join(", ", map { xml_encode($_->[2]) } @changedFields) %>. +% return if $op eq "new"; % } ++ Although anyone is allowed to add a new target, please note that + you will not be able to edit the newly added target unless you + have administrator privileges. So please be sure that the + details are correct before submitting them. +