-%# $Id: edit.mc,v 1.28 2007-03-19 18:51:18 mike Exp $
+%# $Id: edit.mc,v 1.40 2009-04-15 18:16:46 wosch Exp $
<%args>
$op
-$id => undef
+$id => undef ### should be extracted using utf8param()
$update => undef
</%args>
<%doc>
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");
+
+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 $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 $host = $r->param("host");
- my $port = $r->param("port");
- my $dbname = $r->param("dbname");
- if (!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 host, port and database name.</p>\n] if $update;
+ Please specify protocol, host, port and database name.</p>\n];
undef $update;
+ } elsif ($host !~ /^\w+\.[\w.]*\w$/i) {
+ print qq[<p class="error">
+ This host name is not valid.</p>\n];
+ undef $update;
+ sleep 25;
+ } elsif ($port !~ /^\d*$/i) {
+ print qq[<p class="error">
+ This port number is not valid.</p>\n];
+ undef $update;
+ sleep 25;
} else {
- my $query = cql_target($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("$host:$port/$dbname"));
+ my $qnewid = xml_encode(uri_escape($newid));
print qq[<p class="error">
-There is already
-<a href='?op=edit&id=$fakeid'>a record</a>
-for this host, port and database name.
-</p>\n];
+ There is already
+ <a href='?op=edit&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);
(
[ title => 0, "Name", "e:databaseInfo/e:title",
qw() ],
- [ country => [
- "",
- "United States",
- "Afghanistan",
- "Albania",
- "Algeria",
- "American Samoa",
- "Andorra",
- "Angola",
- "Anguilla",
- "Antarctica",
- "Antigua and Barbuda",
- "Argentina",
- "Armenia",
- "Aruba",
- "Australia",
- "Austria",
- "Azerbaijan",
- "Bahamas",
- "Bahrain",
- "Bangladesh",
- "Barbados",
- "Belarus",
- "Belgium",
- "Belize",
- "Benin",
- "Bermuda",
- "Bhutan",
- "Bolivia",
- "Bosnia and Herzegowina",
- "Botswana",
- "Bouvet Island",
- "Brazil",
- "British Indian Ocean Terr.",
- "Brunei Darussalam",
- "Bulgaria",
- "Burkina Faso",
- "Burundi",
- "Cambodia",
- "Cameroon",
- "Canada",
- "Cape Verde",
- "Cayman Islands",
- "Central African Republic",
- "Chad",
- "Chile",
- "China",
- "Christmas Island",
- "Cocos (Keeling) Islands",
- "Colombia",
- "Comoros",
- "Congo",
- "Cook Islands",
- "Costa Rica",
- "Cote d'Ivoire",
- "Croatia (Hrvatska)",
- "Cuba",
- "Cyprus",
- "Czech Republic",
- "Denmark",
- "Djibouti",
- "Dominica",
- "Dominican Republic",
- "East Timor",
- "Ecuador",
- "Egypt",
- "El Salvador",
- "Equatorial Guinea",
- "Eritrea",
- "Estonia",
- "Ethiopia",
- "Falkland Islands/Malvinas",
- "Faroe Islands",
- "Fiji",
- "Finland",
- "France",
- "France, Metropolitan",
- "French Guiana",
- "French Polynesia",
- "French Southern Terr.",
- "Gabon",
- "Gambia",
- "Georgia",
- "Germany",
- "Ghana",
- "Gibraltar",
- "Greece",
- "Greenland",
- "Grenada",
- "Guadeloupe",
- "Guam",
- "Guatemala",
- "Guinea",
- "Guinea-Bissau",
- "Guyana",
- "Haiti",
- "Heard & McDonald Is.",
- "Honduras",
- "Hong Kong",
- "Hungary",
- "Iceland",
- "India",
- "Indonesia",
- "Iran",
- "Iraq",
- "Ireland",
- "Israel",
- "Italy",
- "Jamaica",
- "Japan",
- "Jordan",
- "Kazakhstan",
- "Kenya",
- "Kiribati",
- "Korea, North",
- "Korea, South",
- "Kuwait",
- "Kyrgyzstan",
- "Lao People's Dem. Rep.",
- "Latvia",
- "Lebanon",
- "Lesotho",
- "Liberia",
- "Libyan Arab Jamahiriya",
- "Liechtenstein",
- "Lithuania",
- "Luxembourg",
- "Macau",
- "Macedonia",
- "Madagascar",
- "Malawi",
- "Malaysia",
- "Maldives",
- "Mali",
- "Malta",
- "Marshall Islands",
- "Martinique",
- "Mauritania",
- "Mauritius",
- "Mayotte",
- "Mexico",
- "Micronesia",
- "Moldova",
- "Monaco",
- "Mongolia",
- "Montserrat",
- "Morocco",
- "Mozambique",
- "Myanmar",
- "Namibia",
- "Nauru",
- "Nepal",
- "Netherlands",
- "Netherlands Antilles",
- "New Caledonia",
- "New Zealand",
- "Nicaragua",
- "Niger",
- "Nigeria",
- "Niue",
- "Norfolk Island",
- "Northern Mariana Is.",
- "Norway",
- "Oman",
- "Pakistan",
- "Palau",
- "Panama",
- "Papua New Guinea",
- "Paraguay",
- "Peru",
- "Philippines",
- "Pitcairn",
- "Poland",
- "Portugal",
- "Puerto Rico",
- "Qatar",
- "Reunion",
- "Romania",
- "Russian Federation",
- "Rwanda",
- "S.Georgia & S.Sandwich Is.",
- "Saint Kitts and Nevis",
- "Saint Lucia",
- "Samoa",
- "San Marino",
- "Sao Tome & Principe",
- "Saudi Arabia",
- "Senegal",
- "Seychelles",
- "Sierra Leone",
- "Singapore",
- "Slovakia (Slovak Republic)",
- "Slovenia",
- "Solomon Islands",
- "Somalia",
- "South Africa",
- "Spain",
- "Sri Lanka",
- "St. Helena",
- "St. Pierre & Miquelon",
- "St. Vincent & Grenadines",
- "Sudan",
- "Suriname",
- "Svalbard & Jan Mayen Is.",
- "Swaziland",
- "Sweden",
- "Switzerland",
- "Syrian Arab Republic",
- "Taiwan",
- "Tajikistan",
- "Tanzania",
- "Thailand",
- "Togo",
- "Tokelau",
- "Tonga",
- "Trinidad and Tobago",
- "Tunisia",
- "Turkey",
- "Turkmenistan",
- "Turks & Caicos Islands",
- "Tuvalu",
- "U.S. Minor Outlying Is.",
- "Uganda",
- "Ukraine",
- "United Arab Emirates",
- "United Kingdom",
- "Uruguay",
- "Uzbekistan",
- "Vanuatu",
- "Vatican (Holy See)",
- "Venezuela",
- "Viet Nam",
- "Virgin Islands (British)",
- "Virgin Islands (U.S.)",
- "Wallis & Futuna Is.",
- "Western Sahara",
- "Yemen",
- "Yugoslavia",
- "Zaire",
- "Zambia",
- "Zimbabwe",
- ],
+ [ 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" ],
[ dbname => 0, "Database Name", "e:serverInfo/e:database",
qw(e:host e:port) ],
- [ type => [ "", qw(Academic Public Corporate Special National Education Other) ],
+ [ 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() ],
# 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} = utf8param($r, $key);
}
my @changedFields = modify_xml_document($xc, \%fieldsByKey, \%data);
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>
Changed <% $nchanges %> field<% $nchanges == 1 ? "" : "s" %>:
<% join(", ", map { xml_encode($_->[2]) } @changedFields) %>.
</p>
+% return if $op eq "new";
% }
+ <p>
+ Although anyone is allowed to add a new target, please note that
+ <b>you will not be able to edit the newly added target unless you
+ have administrator privileges</b>. So please be sure that the
+ details are correct before submitting them.
+ </p>
<form method="get" action="">
<table class="fullrecord" border="1" cellspacing="0" cellpadding="5" width="100%">
<%perl>
<tr>
<td align="right" colspan="2">
<input type="submit" name="update" value="Update"/>
+% $op = "edit" if $op eq "new" && defined $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) %>"/>
% }
projects / irspy-moved-to-github.git / blobdiff