X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=web%2Fhtdocs%2Fdetails%2Fedit.mc;h=4d926f668a9a1e18de27fe28e14a752955e15bc1;hp=120859903c3758506c735a9a2d4c91bc68220818;hb=f3a397adb560c87e648fb7817daa64c3dea29167;hpb=14d5be6edf2be05e728f4f497bfc0131f80ca224 diff --git a/web/htdocs/details/edit.mc b/web/htdocs/details/edit.mc index 1208599..4d926f6 100644 --- a/web/htdocs/details/edit.mc +++ b/web/htdocs/details/edit.mc @@ -1,7 +1,6 @@ -%# $Id: edit.mc,v 1.24 2006-12-06 10:37:23 mike Exp $ <%args> $op -$id => undef +$id => undef ### should be extracted using utf8param() $update => undef <%doc> @@ -32,46 +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:3313/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 = ''; -if (defined $id && ($op ne "copy" || !$update)) { - # Existing record - my $query = 'rec.id="' . cql_quote($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; - } -} 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[

+ Please specify title, protocol, host, port and database name.

\n]; + undef $update; + } elsif ($host !~ /^\w+\.[\w.]*\w$/i) { print qq[

-You must specify host, port and database name.

\n] if $update; + 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 { - 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_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); @@ -79,256 +113,15 @@ my @fields = ( [ title => 0, "Name", "e:databaseInfo/e:title", qw() ], - [ country => [ - "", - "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", - "United States", - "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() ], @@ -345,20 +138,215 @@ my @fields = qw(e:title e:description) ], [ history => 5, "History", "e:databaseInfo/e:history", qw(e:title e:description) ], - [ language => 0, "Language of Records", "e:databaseInfo/e:langUsage", + [ 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) ], + [ 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) { @@ -368,7 +356,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()); + ZOOM::IRSpy::_rewrite_zeerex_record($conn, $xc->getContextNode(), + $op eq "edit" ? $id : undef); } @@ -380,7 +369,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. +

<%perl> @@ -414,7 +410,9 @@ foreach my $ref (@fields) {
+% $op = "edit" if $op eq "new" && defined $update; +% $id = $newid if defined $newid; % if (defined $id) { % }