X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=web%2Fhtdocs%2Fdetails%2Fedit.mc;h=73a938a91c2a5000cfcf89042626d77eb2ed6330;hp=4b0b540e6a8f0be9bc8f85bbb0c7fc14cfa35407;hb=0e0292a11cf43e9b1405c05b69886044d97e29d2;hpb=d8931f76879e7d7b5d0cb8340291b7d2dac65c91

diff --git a/web/htdocs/details/edit.mc b/web/htdocs/details/edit.mc
index 4b0b540..73a938a 100644
--- a/web/htdocs/details/edit.mc
+++ b/web/htdocs/details/edit.mc
@@ -1,7 +1,7 @@
-%# $Id: edit.mc,v 1.30 2007-04-27 14:04:40 mike Exp $
+%# $Id: edit.mc,v 1.33 2007-05-03 12:43:04 mike Exp $
 <%args>
 $op
-$id => undef
+$id => undef ### should be extracted using utf8param()
 $update => undef
 </%args>
 <%doc>
@@ -35,48 +35,56 @@ die "op != new but id undefined" if $op ne "new" && !defined $id;
 my $conn = new ZOOM::Connection("localhost:8018/IR-Explain---1", 0,
 				user => "admin", password => "fruitbat",
 				elementSetName => "zeerex");
+
+my $protocol = utf8param($r, "protocol");
+my $host = utf8param($r, "host");
+my $port = utf8param($r, "port");
+my $dbname = utf8param($r, "dbname");
+my $newid;
+if (defined $protocol && $protocol ne "" &&
+    defined $host && $host ne "" &&
+    defined $port && $port ne "" &&
+    defined $dbname && $dbname ne "") {
+    $newid = irspy_make_identifier($protocol, $host, $port, $dbname);
+}
+
 my $rec = '<explain xmlns="http://explain.z3950.org/dtd/2.0/"/>';
-if (defined $id && ($op ne "copy" || !$update)) {
-    # Existing record
-    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[<p class="error">(New ID specified.)</p>\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[<p class="error">
-You must specify protocol, host, port and database name.</p>\n] if $update;
+		Please specify protocol, host, port and database name.</p>\n];
 	undef $update;
     } 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($newid));
 	    print qq[<p class="error">
-There is already
-<a href='?op=edit&amp;id=$fakeid'>a record</a>
-for this host, port and database name.
-</p>\n];
+		There is already
+		<a href='?op=edit&amp;id=$newid'>a record</a>
+		for this protocol, host, port and database name.
+		</p>\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[<p class="error">(New ID specified.)</p>\n];
+	$id = undef;
+    }
 }
 
 my $xc = irspy_xpath_context($rec);
@@ -86,7 +94,7 @@ my @fields =
        qw() ],
      [ country      => $m->comp("country-list.mc"),
        "Country", "i:status/i:country" ],
-     [ protocol     => [ qw(Z39.50 SRW SRU SRW/U) ],
+     [ protocol     => [ qw(Z39.50 SRW SRU) ],
        "Protocol", "e:serverInfo/\@protocol" ],
      [ host         => 0, "Host", "e:serverInfo/e:host" ],
      [ port         => 0, "Port", "e:serverInfo/e:port" ],
@@ -315,7 +323,7 @@ my %fieldsByKey = map { ( $_->[0], $_) } @fields;
 my %data;
 foreach my $key ($r->param()) {
     next if grep { $key eq $_ } qw(op id update);
-    $data{$key} = $r->param($key);
+    $data{$key} = utf8param($r, $key);
 }
 my @changedFields = modify_xml_document($xc, \%fieldsByKey, \%data);
 if ($update && @changedFields) {
@@ -325,7 +333,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::_really_rewrite_record($conn, $xc->getContextNode(),
+					$op eq "edit" ? $id : undef);
 }
 
 </%perl>
@@ -372,6 +381,7 @@ foreach my $ref (@fields) {
     <td align="right" colspan="2">
      <input type="submit" name="update" value="Update"/>
      <input type="hidden" name="op" value="<% xml_encode($op) %>"/>
+% $id = $newid if defined $newid;
 % if (defined $id) {
      <input type="hidden" name="id" value="<% xml_encode($id) %>"/>
 % }