156a7f216679d192b8c7b30c598987fe7cdde8cd
[irspy-moved-to-github.git] / web / htdocs / details / found.mc
1 %# $Id: found.mc,v 1.31 2007-07-04 20:54:11 mike Exp $
2 <%once>
3 sub print_navlink {
4     my($params, $cond, $caption, $skip) = @_;
5
6     if ($cond) {
7         print('     <a href="', navlink($params, $caption, $skip),
8               '"', ">$caption</a>\n");
9     } else {
10         print qq[     <span class="disabled">$caption</span>\n];
11     }
12 }
13
14 sub navlink {
15     my($params, $caption, $skip) = @_;
16     local $params->{_skip} = $skip;
17     my $url = "?" . join("&", map { "$_=" . $params->{$_}  } sort keys %$params);
18     $url = xml_encode($url);
19     return $url;
20 }
21
22 # Identical to the same-named function in full.mc
23 # So maybe this should go into IRSpy::Utils.pm?
24 # Name changed (append 2) to prevent inadvertent clashes in Mason namespace
25 #
26 sub calc_reliability2 {
27     my($xc) = @_;
28
29     my @allpings = $xc->findnodes("i:status/i:probe");
30     my $nall = @allpings;
31     return "[untested]" if $nall == 0;
32     my @okpings = $xc->findnodes('i:status/i:probe[@ok = "1"]');
33     my $nok = @okpings;
34     return "$nok/$nall = " . int(100*$nok/$nall) . "%";
35 }
36
37
38 # Just make this once; forge the connection on first use
39 our $conn = undef;
40 </%once>
41 <%perl>
42 my %params = map { ( $_, utf8param($r, $_)) } grep { $r->param($_) } $r->param();
43 my $query;
44 if ($params{_query}) {
45     $query = $params{_query};
46 } else {
47     $query = "";
48     foreach my $key (keys %params) {
49         next if $key =~ /^_/;
50         my $val = $params{$key};
51         next if $val eq "";
52         $query .= " and " if $query ne "";
53         $query .= "$key = ($val)";
54     }
55 }
56 $query = 'cql.allRecords=1' if $query eq "";
57
58 my $sort = $params{"_sort"};
59 if ($sort) {
60     my $modifiers = "";
61     if ($sort =~ s/(\/.*)//) {
62         $modifiers = $1;
63     }
64     $query .= " or $sort=/sort";
65     $query .= "-desc" if $params{_desc};
66     $query .= $modifiers;
67     $query .= " 0";
68 }
69
70 my $tried_to_open = 0;
71 if (!defined $conn) {
72   OPEN:
73     $conn = new ZOOM::Connection("localhost:8018/IR-Explain---1");
74     $conn->option(elementSetName => "zeerex");
75 }
76
77 my $rs;
78 eval { $rs = $conn->search(new ZOOM::Query::CQL($query)) };
79 if ($@ && ref $@ && $@->isa('ZOOM::Exception') &&
80     $@->code() == ZOOM::Error::CONNECTION_LOST && !$tried_to_open) {
81     $tried_to_open = 1;
82     goto OPEN;
83 } elsif ($@) {
84     die $@;
85 }
86
87 my $n = $rs->size();
88
89 my $skip = $params{"_skip"} || 0;
90 my $count = $params{"_count"} || 10;
91
92 my $first = $skip+1;
93 my $last = $first+$count-1;
94 $last = $n if $last > $n;
95 </%perl>
96      <form method="get" action=""><p>
97       <input type="text" name="_query" size="60" value="<% xml_encode($query) %>"/>
98       <input type="submit" name="_search" value="Search"/>
99      </p></form>
100      <p>
101 % if ($n == 0) {
102       No matches
103 % } elsif ($first > $n) {
104 %# "Can't happen"
105       Past end of <% $n %> records
106 % } else {
107       Records <% $first %> to <% $last %> of <% $n %><br/>
108 <%perl>
109 print_navlink(\%params, $skip > 0, "Prev", $count < $skip ? $skip-$count : 0);
110 print_navlink(\%params, $last < $n, "Next", $skip+$count);
111 </%perl>
112 % }
113      </p>
114 % if ($n > 0 && $first <= $n) {
115      <table width="100%">
116       <tr class="thleft">
117        <th>#</th>
118        <th>Title</th>
119        <th>Reliability <& /help/link.mc, help => "info/reliability" &>
120        </th>
121        <th>Host</th>
122        <th>Port</th>
123        <th>DB</th>
124        <th></th>
125        <th></th>
126       </tr>
127 % my @ids;
128 % foreach my $i ($first .. $last) {
129 <%perl>
130 my $xc = irspy_xpath_context($rs->record($i-1));
131 my $title = $xc->find("e:databaseInfo/e:title") || "[UNTITLED]";
132 my $reliability = calc_reliability2($xc);
133 my $host = $xc->find("e:serverInfo/e:host");
134 my $port = $xc->find("e:serverInfo/e:port");
135 my $db = $xc->find("e:serverInfo/e:database");
136 my $id = irspy_record2identifier($xc);
137 push @ids, $id;
138 </%perl>
139       <tr style="background: <% ($i % 2) ? '#ffffc0' : 'white' %>">
140        <td><% $i %></td>
141        <td><a href="<% xml_encode("/full.html?id=" . uri_escape($id))
142                 %>"><% xml_encode($title) %></a></td>
143        <td><% xml_encode($reliability, "", { nbsp => 1 }) %></td>
144        <td><% xml_encode($host, "") %></td>
145        <td><% xml_encode($port, "") %></td>
146        <td><% xml_encode($db, "") %></td>
147        <td>
148         <a href="<% xml_encode("/admin/check.html?id=" . uri_escape($id))
149                 %>" title="Test this target">Test</a
150         >&nbsp;<a href="<% xml_encode("/admin/edit.html?op=edit&id=" .
151                 uri_escape($id))
152                 %>" title="Edit this target's record">Edit</a
153         >&nbsp;<a href="<% xml_encode("/raw.html?id=" . uri_escape($id))
154                 %>" title="Raw XML record">XML</a>
155        </td>
156       </tr>
157 % }
158      </table>
159 <%perl>
160 print_navlink(\%params, $skip > 0, "Prev", $count < $skip ? $skip-$count : 0);
161 print_navlink(\%params, $last < $n, "Next", $skip+$count);
162 </%perl>
163      <p>
164       <a href="<% "/admin/check.html?" .
165         xml_encode(join("&", map { "id=" . uri_escape($_) } @ids))
166         %>">[Test all targets on this list]</a>
167      </p>
168      <p>
169       <a href="<% "/stats.html?query=" . xml_encode(uri_escape($query))
170         %>">[Statistics for targets on this list]</a>
171      </p>
172 % }