Towards orthogonalisation.
[irspy-moved-to-github.git] / web / htdocs / details / edit.mc
1 %# $Id: edit.mc,v 1.20 2006-11-17 22:39:17 mike Exp $
2 <%doc>
3 Since this form is used in many different situations, some care is
4 merited in considering the possibilities:
5
6 New?    Copy    ID?     Situation
7 --------------------------------------------------------------------------
8 Y                       Blank form for adding a new target.
9 Y                       New target submitted successfully.
10 Y                       Partial new target submitted, requiring more
11
12                 Y       Existing target to be edited.
13                 Y       Existing target has been updated.
14
15         Y       Y       Existing target to be copied.
16         Y               New or copied target rejected due to duplicate ID.
17 --------------------------------------------------------------------------
18 </%doc>
19 <%args>
20 $new => undef
21 $copy => undef
22 $id => undef
23 </%args>
24 <%perl>
25 my $conn = new ZOOM::Connection("localhost:3313/IR-Explain---1", 0,
26                                 user => "admin", password => "fruitbat",
27                                 elementSetName => "zeerex");
28 my $rec = '<explain xmlns="http://explain.z3950.org/dtd/2.0/"/>';
29 if (defined $id && $id ne "") {
30     # Existing record
31     my $query = 'rec.id="' . cql_quote($id) . '"';
32     my $rs = $conn->search(new ZOOM::Query::CQL($query));
33     if ($rs->size() > 0) {
34         $rec = $rs->record(0);
35     } else {
36         $id = undef;
37     }
38
39 } else {
40     # New record
41     my $host = $r->param("host");
42     my $port = $r->param("port");
43     my $dbname = $r->param("dbname");
44     if (!defined $host || $host eq "" ||
45         !defined $port || $port eq "" ||
46         !defined $dbname || $dbname eq "") {
47         print qq[<p class="error">
48 You must specify host, port and database name.</p>\n];
49         $r->param(update => 0);
50     } else {
51         my $query = cql_target($host, $port, $dbname);
52         my $rs = $conn->search(new ZOOM::Query::CQL($query));
53         if ($rs->size() > 0) {
54             my $fakeid = xml_encode(uri_escape("$host:$port/$dbname"));
55             print qq[<p class="error">
56 There is already
57 <a href='?id=$fakeid'>a record</a>
58 for this host, port and database name.
59 </p>\n];
60         }
61     }
62 }
63
64 my $xc = irspy_xpath_context($rec);
65 my @fields =
66     (
67      [ protocol     => [ qw(Z39.50 SRW SRU SRW/U) ],
68        "Protocol", "e:serverInfo/\@protocol" ],
69      [ host         => 0, "Host", "e:serverInfo/e:host" ],
70      [ port         => 0, "Port", "e:serverInfo/e:port" ],
71      [ dbname       => 0, "Database Name", "e:serverInfo/e:database",
72        qw(e:host e:port) ],
73      [ type         => [ qw(Academic Public Corporate Special National Education Other) ],
74        "Type of Library", "i:status/i:libraryType" ],
75      [ country      => 0, "Country", "i:status/i:country" ],
76      [ username     => 0, "Username (if needed)", "e:serverInfo/e:authentication/e:user",
77        qw() ],
78      [ password     => 0, "Password (if needed)", "e:serverInfo/e:authentication/e:password",
79        qw(e:user) ],
80      [ title        => 0, "Title", "e:databaseInfo/e:title",
81        qw() ],
82      [ description  => 5, "Description", "e:databaseInfo/e:description",
83        qw(e:title) ],
84      [ author       => 0, "Author", "e:databaseInfo/e:author",
85        qw(e:title e:description) ],
86      [ hosturl       => 0, "URL to Hosting Organisation", "i:status/i:hostURL" ],
87      [ contact      => 0, "Contact", "e:databaseInfo/e:contact",
88        qw(e:title e:description) ],
89      [ extent       => 3, "Extent", "e:databaseInfo/e:extent",
90        qw(e:title e:description) ],
91      [ history      => 5, "History", "e:databaseInfo/e:history",
92        qw(e:title e:description) ],
93      [ language     => 0, "Language of Records", "e:databaseInfo/e:langUsage",
94        qw(e:title e:description) ],
95      [ restrictions => 2, "Restrictions", "e:databaseInfo/e:restrictions",
96        qw(e:title e:description) ],
97      [ subjects     => 2, "Subjects", "e:databaseInfo/e:subjects",
98        qw(e:title e:description) ],
99      );
100
101 my $nchanges = 0;
102 my $update = $r->param("update");
103
104     # Update record with submitted data
105     my %fieldsByKey = map { ( $_->[0], $_) } @fields;
106     my %data;
107     foreach my $key ($r->param()) {
108         next if grep { $key eq $_ } qw(id update new copy);
109         $data{$key} = $r->param($key);
110     }
111     my $mynchanges = modify_xml_document($xc, \%fieldsByKey, \%data);
112
113 if ($update) {
114     $nchanges = $mynchanges;
115     if ($nchanges) {
116         ### Set e:metaInfo/e:dateModified
117     }
118     ZOOM::IRSpy::_really_rewrite_record($conn, $xc->getContextNode());
119 }
120 </%perl>
121  <h2><% xml_encode($xc->find("e:databaseInfo/e:title"), "[Untitled]") %></h2>
122 % if ($nchanges) {
123  <p style="font-weight: bold">
124   The record has been <% $new ? "created" : "updated" %>.<br/>
125   Changed <% $nchanges %> field<% $nchanges == 1 ? "" : "s" %>.
126  </p>
127 % }
128  <form method="get" action="">
129   <table class="fullrecord" border="1" cellspacing="0" cellpadding="5" width="100%">
130 <%perl>
131 foreach my $ref (@fields) {
132     my($name, $nlines, $caption, $xpath, @addAfter) = @$ref;
133 </%perl>
134    <tr>
135     <th><% $caption %></th>
136     <td>
137 % my $rawdata = $xc->findvalue($xpath);
138 % my $data = xml_encode($rawdata, "");
139 % if (ref $nlines) {
140      <select name="<% $name %>" size="1">
141 %     foreach my $val (@$nlines) {
142       <option value="<% $val %>"
143 % print ' selected="selected"' if $rawdata eq $val;
144         ><% $val %></option>
145 %     }
146      </select>
147 % } elsif ($nlines) {
148      <textarea name="<% $name %>" rows="<% $nlines %>" cols="51"><% $data %></textarea>
149 % } else {
150      <input name="<% $name %>" type="text" size="60" value="<% $data %>"/>
151 % }
152     </td>
153    </tr>
154 %   }
155    <tr>
156     <td align="right" colspan="2">
157      <input type="submit" name="update" value="Update"/>
158 % if (defined $id) {
159      <input type="hidden" name="id" value="<% xml_encode($id) %>"/>
160 % } else {
161      <input type="hidden" name="new" value="1"/>
162 % }
163 % if (defined $copy) {
164      <input type="hidden" name="copy" value="<% xml_encode($copy) %>"/>
165 % }
166     </td>
167    </tr>
168   </table>
169  </form>
170 <%perl>
171     if ($nchanges && 0) {
172         my $x = $xc->getContextNode()->toString();
173         $x = xml_encode($x);
174         #$x =~ s/$/<br\/>/gm;
175         print "<pre>$x</pre>\n";
176     }
177 </%perl>