web/htdocs/details/edit.mc

   1 %# $Id: edit.mc,v 1.3 2006-10-27 16:58:41 mike Exp $
   2 <%args>
   3 $id
   4 </%args>
   5 <%once>
   6 use ZOOM;
   7 </%once>
   8 <%perl>
   9 my $conn = new ZOOM::Connection("localhost:3313/IR-Explain---1", 0,
  10                                 user => "admin", password => "fruitbat");
  11 $conn->option(elementSetName => "zeerex");
  12 my $qid = $id;
  13 $qid =~ s/"/\\"/g;
  14 my $query = qq[rec.id="$qid"];
  15 my $rs = $conn->search(new ZOOM::Query::CQL($query));
  16 my $n = $rs->size();
  17 if ($n == 0) {
  18     $m->comp("/details/error.mc",
  19              title => "Error", message => "No such ID '$id'");
  20 } else {
  21     my $rec = $rs->record(0);
  22     my $xc = irspy_xpath_context($rec);
  23     my @fields =
  24         (
  25          [ protocol     => 0, "Protocol", "e:serverInfo/\@protocol" ],
  26          [ host         => 0, "Host", "e:serverInfo/e:host" ],
  27          [ port         => 0, "Port", "e:serverInfo/e:port" ],
  28          [ dbname       => 0, "Database Name", "e:serverInfo/e:database" ],
  29          [ username     => 0, "Username (if needed)", "e:serverInfo/e:authentication/e:user" ],
  30          [ password     => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password" ],
  31          [ title        => 0, "title", "e:databaseInfo/e:title", lang => "en", primary => "true" ],
  32          [ description  => 5, "Description", "e:databaseInfo/e:description", lang => "en", primary => "true" ],
  33          [ author       => 0, "Author", "e:databaseInfo/e:author" ],
  34          [ contact      => 0, "Contact", "e:databaseInfo/e:contact" ],
  35          [ extent       => 3, "Extent", "e:databaseInfo/e:extent" ],
  36          [ history      => 5, "History", "e:databaseInfo/e:history" ],
  37          [ language     => 0, "Language of Records", "e:databaseInfo/e:langUsage" ],
  38          [ restrictions => 2, "Restrictions", "e:databaseInfo/e:restrictions" ],
  39          [ subjects     => 2, "Subjects", "e:databaseInfo/e:subjects" ],
  40          ### Remember to set e:metaInfo/e:dateModified
  41          );
  42     my %fieldsByKey = map { ( $_->[0], $_) } @fields;
  43     my $update = $r->param("update");
  44     if (defined $update) {
  45         # Update record with submitted data
  46         foreach my $key ($r->param()) {
  47             next if grep { $key eq $_ } qw(id update);
  48             my $value = $r->param($key);
  49             my $ref = $fieldsByKey{$key} or die "no field '$key'";
  50             my($name, $nlines, $caption, $xpath, %attrs) = @$ref;
  51             my @nodes = $xc->findnodes($xpath);
  52             if (@nodes) {
  53                 warn scalar(@nodes), " nodes match '$xpath'" if @nodes > 1;
  54                 my $node = $nodes[0];
  55                 if ($node->isa("XML::LibXML::Attr")) {
  56                     $node->setValue($value);
  57                     print "Attr $key <- '$value' ($xpath)<br/>\n";
  58                 } elsif ($node->isa("XML::LibXML::Element")) {
  59                     my $child = $node->firstChild();
  60                     die "element child $child is not text"
  61                         if !ref $child || !$child->isa("XML::LibXML::Text");
  62                     $child->setData($value);
  63                     print "Elem $key <- '$value' ($xpath)<br/>\n";
  64                 } else {
  65                     warn "unexpected node type $node";
  66                 }
  67             } else {
  68                 print "$key='$value' ($xpath) no nodes<br/>\n";
  69                 ### Make new node ... heaven knows how ...
  70             }
  71         }
  72         ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode());
  73     }
  74 </%perl>
  75      <h2><% xml_encode($id) %></h2>
  76 % print "     <p>Thanks for the update!</p>\n" if defined $update;
  77      <form method="get" action="">
  78       <table class="fullrecord" border="1" cellspacing="0" cellpadding="5" width="100%">
  79 <%perl>
  80     foreach my $ref (@fields) {
  81         my($name, $nlines, $caption, $xpath, %attrs) = @$ref;
  82 </%perl>
  83        <tr>
  84         <th><% $caption %></th>
  85         <td>
  86 % my $data = xml_encode($xc->find($xpath));
  87 % if ($nlines) {
  88          <textarea name="<% $name %>" rows="<% $nlines %>" cols="61"><% $data %></textarea>
  89 % } else {
  90          <input name="<% $name %>" type="text" size="60" value="<% $data %>">
  91 % }
  92         </td>
  93        </tr>
  94 %   }
  95        <tr>
  96         <td align="right" colspan="2">
  97          <input type="submit" name="update" value="Update"/>
  98          <input type="hidden" name="id" value="<% xml_encode($id) %>"/>
  99         </td>
 100        </tr>
 101       </table>
 102      </form>
 103 % }