web/htdocs/details/edit.mc

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