X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=web%2Fhtdocs%2Fdetails%2Fedit.mc;h=e813ae0aae87a7b320dd77a24cc090b230337d1e;hb=ede0de7215f54e2c51825ba8a43cc24ff996e533;hp=c3ed2245e04a01a7ee6afd9aae8e55e9f68881fb;hpb=eab6d13888c7950df57196f9efe918471ddc7fd5;p=irspy-moved-to-github.git
diff --git a/web/htdocs/details/edit.mc b/web/htdocs/details/edit.mc
index c3ed224..e813ae0 100644
--- a/web/htdocs/details/edit.mc
+++ b/web/htdocs/details/edit.mc
@@ -1,103 +1,400 @@
-%# $Id: edit.mc,v 1.4 2006-10-27 17:16:20 mike Exp $
+%# $Id: edit.mc,v 1.34 2007-05-03 12:54:18 mike Exp $
<%args>
-$id
+$op
+$id => undef ### should be extracted using utf8param()
+$update => undef
%args>
-<%once>
-use ZOOM;
-%once>
+<%doc>
+Since this form is used in many different situations, some care is
+merited in considering the possibilities:
+
+Situation Op ID Update
+----------------------------------------------------------------------
+Blank form for adding a new target new
+New target rejected, changes required new X
+New target accepted and added new X
+---------------------------------------------------------------------
+Existing target to be edited edit X
+Edit rejected, changes required edit X X
+Target successfully updated edit X X
+----------------------------------------------------------------------
+Existing target to be copied copy X
+New target rejected, changes required copy X X
+New target accepted and added copy X X
+----------------------------------------------------------------------
+
+Submissions, whether of new targets, edits or copies, may be rejected
+due either to missing mandatory fields or host/name/port that form a
+duplicate ID.
+%doc>
<%perl>
-my $conn = new ZOOM::Connection("localhost:3313/IR-Explain---1", 0,
- user => "admin", password => "fruitbat");
-$conn->option(elementSetName => "zeerex");
-my $qid = $id;
-$qid =~ s/"/\\"/g;
-my $query = qq[rec.id="$qid"];
-my $rs = $conn->search(new ZOOM::Query::CQL($query));
-my $n = $rs->size();
-if ($n == 0) {
- $m->comp("/details/error.mc",
- title => "Error", message => "No such ID '$id'");
-} else {
- my $rec = $rs->record(0);
- my $xc = irspy_xpath_context($rec);
- my @fields =
- (
- [ protocol => 0, "Protocol", "e:serverInfo/\@protocol" ],
- [ host => 0, "Host", "e:serverInfo/e:host" ],
- [ port => 0, "Port", "e:serverInfo/e:port" ],
- [ dbname => 0, "Database Name", "e:serverInfo/e:database" ],
- [ username => 0, "Username (if needed)", "e:serverInfo/e:authentication/e:user" ],
- [ password => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password" ],
- [ title => 0, "title", "e:databaseInfo/e:title", lang => "en", primary => "true" ],
- [ description => 5, "Description", "e:databaseInfo/e:description", lang => "en", primary => "true" ],
- [ author => 0, "Author", "e:databaseInfo/e:author" ],
- [ contact => 0, "Contact", "e:databaseInfo/e:contact" ],
- [ extent => 3, "Extent", "e:databaseInfo/e:extent" ],
- [ history => 5, "History", "e:databaseInfo/e:history" ],
- [ language => 0, "Language of Records", "e:databaseInfo/e:langUsage" ],
- [ restrictions => 2, "Restrictions", "e:databaseInfo/e:restrictions" ],
- [ subjects => 2, "Subjects", "e:databaseInfo/e:subjects" ],
- ### Remember to set e:metaInfo/e:dateModified
- );
- my %fieldsByKey = map { ( $_->[0], $_) } @fields;
- my $update = $r->param("update");
- if (defined $update) {
- # Update record with submitted data
- foreach my $key ($r->param()) {
- next if grep { $key eq $_ } qw(id update);
- my $value = $r->param($key);
- my $ref = $fieldsByKey{$key} or die "no field '$key'";
- my($name, $nlines, $caption, $xpath, %attrs) = @$ref;
- my @nodes = $xc->findnodes($xpath);
- if (@nodes) {
- warn scalar(@nodes), " nodes match '$xpath'" if @nodes > 1;
- my $node = $nodes[0];
- if ($node->isa("XML::LibXML::Attr")) {
- $node->setValue($value);
- print "Attr $key <- '$value' ($xpath)
\n";
- } elsif ($node->isa("XML::LibXML::Element")) {
- my $child = $node->firstChild();
- die "element child $child is not text"
- if !ref $child || !$child->isa("XML::LibXML::Text");
- $child->setData($value);
- print "Elem $key <- '$value' ($xpath)
\n";
- } else {
- warn "unexpected node type $node";
- }
- } else {
- print "$key='$value' ($xpath) no nodes
\n";
- ### Make new node ... heaven knows how ...
- }
+# Sanity checking
+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,
+ 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 = '
+ Please specify protocol, host, port and database name.
\n]; + undef $update; + } else { + # 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 $qnewid = xml_encode(uri_escape($newid)); + print qq[+ There is already + a record + for this protocol, host, port and database name. +
\n]; + undef $update; } - ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode()); } +} 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); +my @fields = + ( + [ title => 0, "Name", "e:databaseInfo/e:title", + qw() ], + [ country => $m->comp("country-list.mc"), + "Country", "i:status/i:country" ], + [ protocol => [ qw(Z39.50 SRW SRU) ], + "Protocol", "e:serverInfo/\@protocol" ], + [ host => 0, "Host", "e:serverInfo/e:host" ], + [ port => 0, "Port", "e:serverInfo/e:port" ], + [ dbname => 0, "Database Name", "e:serverInfo/e:database", + qw(e:host e:port) ], + [ type => $m->comp("libtype-list.mc"), + "Type of Library", "i:status/i:libraryType" ], + [ username => 0, "Username (if needed)", "e:serverInfo/e:authentication/e:user", + qw() ], + [ password => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password", + qw(e:user) ], + [ description => 5, "Description", "e:databaseInfo/e:description", + qw(e:title) ], + [ author => 0, "Author", "e:databaseInfo/e:author", + qw(e:title e:description) ], + [ hosturl => 0, "URL to Hosting Organisation", "i:status/i:hostURL" ], + [ contact => 0, "Contact", "e:databaseInfo/e:contact", + qw(e:title e:description) ], + [ extent => 3, "Extent", "e:databaseInfo/e:extent", + qw(e:title e:description) ], + [ history => 5, "History", "e:databaseInfo/e:history", + qw(e:title e:description) ], + [ language => [ +# This list was produced by feeding +# http://www.loc.gov/standards/iso639-2/ISO-639-2_values_8bits.txt +# through the filter +# awk -F'|' '$3 {print$4}' +# and shortening some of the longer names by hand + "", + "English", + "Afar", + "Abkhazian", + "Afrikaans", + "Akan", + "Albanian", + "Amharic", + "Arabic", + "Aragonese", + "Armenian", + "Assamese", + "Avaric", + "Avestan", + "Aymara", + "Azerbaijani", + "Bashkir", + "Bambara", + "Basque", + "Belarusian", + "Bengali", + "Bihari", + "Bislama", + "Bosnian", + "Breton", + "Bulgarian", + "Burmese", + "Catalan; Valencian", + "Chamorro", + "Chechen", + "Chinese", + "Church Slavic; Old Slavonic", + "Chuvash", + "Cornish", + "Corsican", + "Cree", + "Czech", + "Danish", + "Divehi; Dhivehi; Maldivian", + "Dutch; Flemish", + "Dzongkha", + "Esperanto", + "Estonian", + "Ewe", + "Faroese", + "Fijian", + "Finnish", + "French", + "Western Frisian", + "Fulah", + "Georgian", + "German", + "Gaelic; Scottish Gaelic", + "Irish", + "Galician", + "Manx", + "Greek, Modern (1453-)", + "Guarani", + "Gujarati", + "Haitian; Haitian Creole", + "Hausa", + "Hebrew", + "Herero", + "Hindi", + "Hiri Motu", + "Hungarian", + "Igbo", + "Icelandic", + "Ido", + "Sichuan Yi", + "Inuktitut", + "Interlingue", + "Interlingua", + "Indonesian", + "Inupiaq", + "Italian", + "Javanese", + "Japanese", + "Kalaallisut; Greenlandic", + "Kannada", + "Kashmiri", + "Kanuri", + "Kazakh", + "Khmer", + "Kikuyu; Gikuyu", + "Kinyarwanda", + "Kirghiz", + "Komi", + "Kongo", + "Korean", + "Kuanyama; Kwanyama", + "Kurdish", + "Lao", + "Latin", + "Latvian", + "Limburgan; Limburger; Limburgish", + "Lingala", + "Lithuanian", + "Luxembourgish; Letzeburgesch", + "Luba-Katanga", + "Ganda", + "Macedonian", + "Marshallese", + "Malayalam", + "Maori", + "Marathi", + "Malay", + "Malagasy", + "Maltese", + "Moldavian", + "Mongolian", + "Nauru", + "Navajo; Navaho", + "Ndebele, South; South Ndebele", + "Ndebele, North; North Ndebele", + "Ndonga", + "Nepali", + "Norwegian Nynorsk", + "Norwegian Bokmål", + "Norwegian", + "Chichewa; Chewa; Nyanja", + "Occitan (post 1500); Provençal", + "Ojibwa", + "Oriya", + "Oromo", + "Ossetian; Ossetic", + "Panjabi; Punjabi", + "Persian", + "Pali", + "Polish", + "Portuguese", + "Pushto", + "Quechua", + "Raeto-Romance", + "Romanian", + "Rundi", + "Russian", + "Sango", + "Sanskrit", + "Serbian", + "Croatian", + "Sinhala; Sinhalese", + "Slovak", + "Slovenian", + "Northern Sami", + "Samoan", + "Shona", + "Sindhi", + "Somali", + "Sotho, Southern", + "Spanish; Castilian", + "Sardinian", + "Swati", + "Sundanese", + "Swahili", + "Swedish", + "Tahitian", + "Tamil", + "Tatar", + "Telugu", + "Tajik", + "Tagalog", + "Thai", + "Tibetan", + "Tigrinya", + "Tonga (Tonga Islands)", + "Tswana", + "Tsonga", + "Turkmen", + "Turkish", + "Twi", + "Uighur; Uyghur", + "Ukrainian", + "Urdu", + "Uzbek", + "Venda", + "Vietnamese", + "Volapük", + "Welsh", + "Walloon", + "Wolof", + "Xhosa", + "Yiddish", + "Yoruba", + "Zhuang; Chuang", + "Zulu", + ], + "Language of Records", "e:databaseInfo/e:langUsage", + qw(e:title e:description) ], + [ restrictions => 2, "Restrictions", "e:databaseInfo/e:restrictions", + qw(e:title e:description) ], + [ subjects => 2, "Subjects", "e:databaseInfo/e:subjects", + qw(e:title e:description) ], + ); + +# Update record with submitted data +my %fieldsByKey = map { ( $_->[0], $_) } @fields; +my %data; +foreach my $key ($r->param()) { + next if grep { $key eq $_ } qw(op id update); + $data{$key} = utf8param($r, $key); +} +my @changedFields = modify_xml_document($xc, \%fieldsByKey, \%data); +if ($update && @changedFields) { + my @x = modify_xml_document($xc, { dateModified => + [ dateModified => 0, + "Data/time modified", + "e:metaInfo/e:dateModified" ] }, + { dateModified => isodate(time()) }); + die "Didn't set dateModified!" if !@x; + ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode(), + $op eq "edit" ? $id : undef); +} + %perl> -The record has been updated.
\n" if defined $update; - +<%perl> + if (@changedFields && 0) { + my $x = $xc->getContextNode()->toString(); + $x = xml_encode($x); + #$x =~ s/$/$x\n"; + } +%perl>