web/htdocs/details/edit.mc

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