web/htdocs/details/edit.mc

   1 %# $Id: edit.mc,v 1.34 2007-05-03 12:54:18 mike Exp $
   2 <%args>
   3 $op
   4 $id => undef ### should be extracted using utf8param()
   5 $update => undef
   6 </%args>
   7 <%doc>
   8 Since this form is used in many different situations, some care is
   9 merited in considering the possibilities:
  10
  11 Situation                                       Op      ID      Update
  12 ----------------------------------------------------------------------
  13 Blank form for adding a new target              new
  14 New target rejected, changes required           new             X
  15 New target accepted and added                   new             X
  16 ---------------------------------------------------------------------
  17 Existing target to be edited                    edit    X
  18 Edit rejected, changes required                 edit    X       X
  19 Target successfully updated                     edit    X       X
  20 ----------------------------------------------------------------------
  21 Existing target to be copied                    copy    X
  22 New target rejected, changes required           copy    X       X
  23 New target accepted and added                   copy    X       X
  24 ----------------------------------------------------------------------
  25
  26 Submissions, whether of new targets, edits or copies, may be rejected
  27 due either to missing mandatory fields or host/name/port that form a
  28 duplicate ID.
  29 </%doc>
  30 <%perl>
  31 # Sanity checking
  32 die "op = new but id defined" if $op eq "new" && defined $id;
  33 die "op != new but id undefined" if $op ne "new" && !defined $id;
  34
  35 my $conn = new ZOOM::Connection("localhost:8018/IR-Explain---1", 0,
  36                                 user => "admin", password => "fruitbat",
  37                                 elementSetName => "zeerex");
  38
  39 my $protocol = utf8param($r, "protocol");
  40 my $host = utf8param($r, "host");
  41 my $port = utf8param($r, "port");
  42 my $dbname = utf8param($r, "dbname");
  43 my $newid;
  44 if (defined $protocol && $protocol ne "" &&
  45     defined $host && $host ne "" &&
  46     defined $port && $port ne "" &&
  47     defined $dbname && $dbname ne "") {
  48     $newid = irspy_make_identifier($protocol, $host, $port, $dbname);
  49 }
  50
  51 my $rec = '<explain xmlns="http://explain.z3950.org/dtd/2.0/"/>';
  52
  53 if (!defined $id) {
  54     if (!$update) {
  55         # About to enter data for a new record
  56         # Nothing to do at this stage
  57     } elsif (!defined $newid) {
  58         # Tried to create new record but data is insufficient
  59         print qq[<p class="error">
  60                 Please specify protocol, host, port and database name.</p>\n];
  61         undef $update;
  62     } else {
  63         # Creating new record, all necessary data is present.  Check
  64         # that the new record is not a duplicate of an existing one.
  65         my $rs = $conn->search(new ZOOM::Query::CQL(cql_target($newid)));
  66         if ($rs->size() > 0) {
  67             my $qnewid = xml_encode(uri_escape($newid));
  68             print qq[<p class="error">
  69                 There is already
  70                 <a href='?op=edit&amp;id=$newid'>a record</a>
  71                 for this protocol, host, port and database name.
  72                 </p>\n];
  73             undef $update;
  74         }
  75     }
  76 } else {
  77     # assert(defined $id);
  78     # Copying or editing an existing record: fetch it for editing
  79     my $query = cql_target($id);
  80     my $rs = $conn->search(new ZOOM::Query::CQL($query));
  81     if ($rs->size() > 0) {
  82         $rec = $rs->record(0);
  83     } else {
  84         ### Is this an error?  I don't think the UI will ever provoke it
  85         print qq[<p class="error">(New ID specified.)</p>\n];
  86         $id = undef;
  87     }
  88 }
  89
  90 my $xc = irspy_xpath_context($rec);
  91 my @fields =
  92     (
  93      [ title        => 0, "Name", "e:databaseInfo/e:title",
  94        qw() ],
  95      [ country      => $m->comp("country-list.mc"),
  96        "Country", "i:status/i:country" ],
  97      [ protocol     => [ qw(Z39.50 SRW SRU) ],
  98        "Protocol", "e:serverInfo/\@protocol" ],
  99      [ host         => 0, "Host", "e:serverInfo/e:host" ],
 100      [ port         => 0, "Port", "e:serverInfo/e:port" ],
 101      [ dbname       => 0, "Database Name", "e:serverInfo/e:database",
 102        qw(e:host e:port) ],
 103      [ type         => $m->comp("libtype-list.mc"),
 104        "Type of Library", "i:status/i:libraryType" ],
 105      [ username     => 0, "Username (if needed)", "e:serverInfo/e:authentication/e:user",
 106        qw() ],
 107      [ password     => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password",
 108        qw(e:user) ],
 109      [ description  => 5, "Description", "e:databaseInfo/e:description",
 110        qw(e:title) ],
 111      [ author       => 0, "Author", "e:databaseInfo/e:author",
 112        qw(e:title e:description) ],
 113      [ hosturl       => 0, "URL to Hosting Organisation", "i:status/i:hostURL" ],
 114      [ contact      => 0, "Contact", "e:databaseInfo/e:contact",
 115        qw(e:title e:description) ],
 116      [ extent       => 3, "Extent", "e:databaseInfo/e:extent",
 117        qw(e:title e:description) ],
 118      [ history      => 5, "History", "e:databaseInfo/e:history",
 119        qw(e:title e:description) ],
 120      [ language     => [
 121 # This list was produced by feeding
 122 #       http://www.loc.gov/standards/iso639-2/ISO-639-2_values_8bits.txt
 123 # through the filter
 124 #       awk -F'|' '$3 {print$4}'
 125 # and shortening some of the longer names by hand
 126                         "",
 127                         "English",
 128                         "Afar",
 129                         "Abkhazian",
 130                         "Afrikaans",
 131                         "Akan",
 132                         "Albanian",
 133                         "Amharic",
 134                         "Arabic",
 135                         "Aragonese",
 136                         "Armenian",
 137                         "Assamese",
 138                         "Avaric",
 139                         "Avestan",
 140                         "Aymara",
 141                         "Azerbaijani",
 142                         "Bashkir",
 143                         "Bambara",
 144                         "Basque",
 145                         "Belarusian",
 146                         "Bengali",
 147                         "Bihari",
 148                         "Bislama",
 149                         "Bosnian",
 150                         "Breton",
 151                         "Bulgarian",
 152                         "Burmese",
 153                         "Catalan; Valencian",
 154                         "Chamorro",
 155                         "Chechen",
 156                         "Chinese",
 157                         "Church Slavic; Old Slavonic",
 158                         "Chuvash",
 159                         "Cornish",
 160                         "Corsican",
 161                         "Cree",
 162                         "Czech",
 163                         "Danish",
 164                         "Divehi; Dhivehi; Maldivian",
 165                         "Dutch; Flemish",
 166                         "Dzongkha",
 167                         "Esperanto",
 168                         "Estonian",
 169                         "Ewe",
 170                         "Faroese",
 171                         "Fijian",
 172                         "Finnish",
 173                         "French",
 174                         "Western Frisian",
 175                         "Fulah",
 176                         "Georgian",
 177                         "German",
 178                         "Gaelic; Scottish Gaelic",
 179                         "Irish",
 180                         "Galician",
 181                         "Manx",
 182                         "Greek, Modern (1453-)",
 183                         "Guarani",
 184                         "Gujarati",
 185                         "Haitian; Haitian Creole",
 186                         "Hausa",
 187                         "Hebrew",
 188                         "Herero",
 189                         "Hindi",
 190                         "Hiri Motu",
 191                         "Hungarian",
 192                         "Igbo",
 193                         "Icelandic",
 194                         "Ido",
 195                         "Sichuan Yi",
 196                         "Inuktitut",
 197                         "Interlingue",
 198                         "Interlingua",
 199                         "Indonesian",
 200                         "Inupiaq",
 201                         "Italian",
 202                         "Javanese",
 203                         "Japanese",
 204                         "Kalaallisut; Greenlandic",
 205                         "Kannada",
 206                         "Kashmiri",
 207                         "Kanuri",
 208                         "Kazakh",
 209                         "Khmer",
 210                         "Kikuyu; Gikuyu",
 211                         "Kinyarwanda",
 212                         "Kirghiz",
 213                         "Komi",
 214                         "Kongo",
 215                         "Korean",
 216                         "Kuanyama; Kwanyama",
 217                         "Kurdish",
 218                         "Lao",
 219                         "Latin",
 220                         "Latvian",
 221                         "Limburgan; Limburger; Limburgish",
 222                         "Lingala",
 223                         "Lithuanian",
 224                         "Luxembourgish; Letzeburgesch",
 225                         "Luba-Katanga",
 226                         "Ganda",
 227                         "Macedonian",
 228                         "Marshallese",
 229                         "Malayalam",
 230                         "Maori",
 231                         "Marathi",
 232                         "Malay",
 233                         "Malagasy",
 234                         "Maltese",
 235                         "Moldavian",
 236                         "Mongolian",
 237                         "Nauru",
 238                         "Navajo; Navaho",
 239                         "Ndebele, South; South Ndebele",
 240                         "Ndebele, North; North Ndebele",
 241                         "Ndonga",
 242                         "Nepali",
 243                         "Norwegian Nynorsk",
 244                         "Norwegian Bokmål",
 245                         "Norwegian",
 246                         "Chichewa; Chewa; Nyanja",
 247                         "Occitan (post 1500); Provençal",
 248                         "Ojibwa",
 249                         "Oriya",
 250                         "Oromo",
 251                         "Ossetian; Ossetic",
 252                         "Panjabi; Punjabi",
 253                         "Persian",
 254                         "Pali",
 255                         "Polish",
 256                         "Portuguese",
 257                         "Pushto",
 258                         "Quechua",
 259                         "Raeto-Romance",
 260                         "Romanian",
 261                         "Rundi",
 262                         "Russian",
 263                         "Sango",
 264                         "Sanskrit",
 265                         "Serbian",
 266                         "Croatian",
 267                         "Sinhala; Sinhalese",
 268                         "Slovak",
 269                         "Slovenian",
 270                         "Northern Sami",
 271                         "Samoan",
 272                         "Shona",
 273                         "Sindhi",
 274                         "Somali",
 275                         "Sotho, Southern",
 276                         "Spanish; Castilian",
 277                         "Sardinian",
 278                         "Swati",
 279                         "Sundanese",
 280                         "Swahili",
 281                         "Swedish",
 282                         "Tahitian",
 283                         "Tamil",
 284                         "Tatar",
 285                         "Telugu",
 286                         "Tajik",
 287                         "Tagalog",
 288                         "Thai",
 289                         "Tibetan",
 290                         "Tigrinya",
 291                         "Tonga (Tonga Islands)",
 292                         "Tswana",
 293                         "Tsonga",
 294                         "Turkmen",
 295                         "Turkish",
 296                         "Twi",
 297                         "Uighur; Uyghur",
 298                         "Ukrainian",
 299                         "Urdu",
 300                         "Uzbek",
 301                         "Venda",
 302                         "Vietnamese",
 303                         "Volapük",
 304                         "Welsh",
 305                         "Walloon",
 306                         "Wolof",
 307                         "Xhosa",
 308                         "Yiddish",
 309                         "Yoruba",
 310                         "Zhuang; Chuang",
 311                         "Zulu",
 312                         ],
 313        "Language of Records", "e:databaseInfo/e:langUsage",
 314        qw(e:title e:description) ],
 315      [ restrictions => 2, "Restrictions", "e:databaseInfo/e:restrictions",
 316        qw(e:title e:description) ],
 317      [ subjects     => 2, "Subjects", "e:databaseInfo/e:subjects",
 318        qw(e:title e:description) ],
 319      );
 320
 321 # Update record with submitted data
 322 my %fieldsByKey = map { ( $_->[0], $_) } @fields;
 323 my %data;
 324 foreach my $key ($r->param()) {
 325     next if grep { $key eq $_ } qw(op id update);
 326     $data{$key} = utf8param($r, $key);
 327 }
 328 my @changedFields = modify_xml_document($xc, \%fieldsByKey, \%data);
 329 if ($update && @changedFields) {
 330     my @x = modify_xml_document($xc, { dateModified =>
 331                                            [ dateModified => 0,
 332                                              "Data/time modified",
 333                                              "e:metaInfo/e:dateModified" ] },
 334                                 { dateModified => isodate(time()) });
 335     die "Didn't set dateModified!" if !@x;
 336     ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode(),
 337                                         $op eq "edit" ? $id : undef);
 338 }
 339
 340 </%perl>
 341  <h2><% xml_encode($xc->find("e:databaseInfo/e:title"), "[Untitled]") %></h2>
 342 % if ($update && @changedFields) {
 343 %     my $nchanges = @changedFields;
 344  <p style="font-weight: bold">
 345   The record has been <% $op ne "edit" ? "created" : "updated" %>.<br/>
 346   Changed <% $nchanges %> field<% $nchanges == 1 ? "" : "s" %>:
 347   <% join(", ", map { xml_encode($_->[2]) } @changedFields) %>.
 348  </p>
 349 % }
 350  <form method="get" action="">
 351   <table class="fullrecord" border="1" cellspacing="0" cellpadding="5" width="100%">
 352 <%perl>
 353 foreach my $ref (@fields) {
 354     my($name, $nlines, $caption, $xpath, @addAfter) = @$ref;
 355 </%perl>
 356    <tr>
 357     <th><% $caption %></th>
 358     <td>
 359 % my $rawval = $xc->findvalue($xpath);
 360 % my $val = xml_encode($rawval, "");
 361 % if (ref $nlines) {
 362      <select name="<% $name %>" size="1">
 363 %     foreach my $option (@$nlines) {
 364       <option value="<% xml_encode($option) %>"<%
 365         ($rawval eq $option ? ' selected="selected"' : "")
 366         %>><% xml_encode($option) %></option>
 367 %     }
 368      </select>
 369 % } elsif ($nlines) {
 370      <textarea name="<% $name %>" rows="<% $nlines %>" cols="51"><% $val %></textarea>
 371 % } else {
 372      <input name="<% $name %>" type="text" size="60" value="<% $val %>"/>
 373 % }
 374     </td>
 375     <td>
 376      <& /help/link.mc, help => "edit/$name" &>
 377     </td>
 378    </tr>
 379 %   }
 380    <tr>
 381     <td align="right" colspan="2">
 382      <input type="submit" name="update" value="Update"/>
 383 % $op = "edit" if $op eq "new" && defined $update;
 384      <input type="hidden" name="op" value="<% xml_encode($op) %>"/>
 385 % $id = $newid if defined $newid;
 386 % if (defined $id) {
 387      <input type="hidden" name="id" value="<% xml_encode($id) %>"/>
 388 % }
 389     </td>
 390    </tr>
 391   </table>
 392  </form>
 393 <%perl>
 394     if (@changedFields && 0) {
 395         my $x = $xc->getContextNode()->toString();
 396         $x = xml_encode($x);
 397         #$x =~ s/$/<br\/>/gm;
 398         print "<pre>$x</pre>\n";
 399     }
 400 </%perl>