#!/usr/bin/perl
-
+#
# perl -I ../lib irspy-rewrite-records.pl localhost:8018/IR-Explain---1
+use lib '../lib';
+use Data::Dumper;
+use Getopt::Long;
+use ZOOM::IRSpy;
+use ZOOM::IRSpy::Utils qw(render_record validate_record);
+
use strict;
use warnings;
-use ZOOM::IRSpy;
-use ZOOM::IRSpy::Utils qw(render_record);
-my($dbname) = @ARGV;
-die "$0 no database name specified" if !defined $dbname;
+my $irspy_to_zeerex_xsl = '../xsl/irspy2zeerex.xsl';
+my $debug = 1;
+my $cql_query = "cql.allRecords=1";
+
+sub usage {
+ my $message = shift;
+
+ warn "$message\n" if defined $message;
-my $irspy_to_zeerex_xsl = $ARGV[1] || '../xsl/irspy2zeerex.xsl';
+ <<EOF
+usage $0 [ options ] database
+
+--xslt=$irspy_to_zeerex_xsl set xslt sheet
+--debug=0..2 verbose level
+--query=$cql_query
+EOF
+}
+
+GetOptions(
+ "xslt" => \$irspy_to_zeerex_xsl,
+ "debug=i" => \$debug,
+ "query=s" => \$cql_query,
+);
+
+my $dbname = shift;
+die usage("no database name specified\n") if !defined $dbname;
$ZOOM::IRSpy::irspy_to_zeerex_xsl = $irspy_to_zeerex_xsl
if $irspy_to_zeerex_xsl;
-my $spy = new ZOOM::IRSpy($dbname, "admin", "fruitbat");
-my $rs = $spy->{conn}->search(new ZOOM::Query::CQL("cql.allRecords=1"));
-print STDERR "rewriting ", $rs->size(), " target records";
+my $spy = new ZOOM::IRSpy( $dbname, "admin", "fruitbat" );
+my $rs = $spy->{conn}->search( new ZOOM::Query::CQL($cql_query) );
+print STDERR "rewriting ", $rs->size(), " target records\n" if $debug;
-foreach my $i (1 .. $rs->size()) {
- my $xml = render_record($rs, $i-1, "zeerex");
+foreach my $i ( 1 .. $rs->size() ) {
+ my $xml = render_record( $rs, $i - 1, "zeerex" );
my $rec = $spy->{libxml}->parse_string($xml)->documentElement();
- ZOOM::IRSpy::_rewrite_zeerex_record($spy->{conn}, $rec);
- print STDERR ".";
+
+ if ( $debug >= 2 ) {
+ my ( $ok, $errors ) = validate_record($rec);
+ if ( !$ok ) {
+ my @e = @$errors;
+ my $id = shift @e;
+ print "Id: $id => ", join( " / ", @e ), "\n";
+ }
+ }
+ ZOOM::IRSpy::_rewrite_zeerex_record( $spy->{conn}, $rec );
+ print STDERR "." if $debug == 1;
}
-print STDERR "\nDone\n";
+print STDERR "Done\n" if $debug;
+
modify_xml_document
bib1_access_point
render_record
+ validate_record
calc_reliability_string
calc_reliability_stats);
}
} else {
- next if !$value; # No need to create a new empty node
+ next if !defined $value; # No need to create a new empty node
my($ppath, $selector) = $xpath =~ /(.*)\/(.*)/;
dom_add_node($xc, $ppath, $selector, $value, @addAfter);
#print "New $key ($xpath) = '$value'<br/>\n";
return (0, 0, 0) if $nall == 0;
my @okpings = $xc->findnodes('i:status/i:probe[@ok = "1"]');
my $nok = @okpings;
- my $percent = int(100*$nok/$nall);
+ my $percent = int(100*$nok/$nall + 0.5);
return ($nok, $nall, $percent);
}
+#
+# validate_record( record, ( "port" => 1, "database" => 1, "country" => 0, ... ))
+#
+sub validate_record {
+ my $rec = shift;
+ my %args = @_;
+
+ my %required = map { $_ => 1 } qw/port host database protocol/;
+ my %optional = map { $_ => 1 } qw/country type hosturl contact language/;
+ my %tests = ( %required, %args );
+
+ my $xc = irspy_xpath_context($rec);
+
+ my $protocol = $xc->findnodes("e:serverInfo/\@protocol") || "";
+ my $port = $xc->findnodes("e:serverInfo/e:port") || "";
+ my $host = $xc->findnodes("e:serverInfo/e:host") || "";
+ my $dbname = $xc->findnodes("e:serverInfo/e:database") || "";
+
+ my $id = irspy_make_identifier($protocol, $host, $port, $dbname);
+
+ if ($protocol =~ /\s+$/ || $dbname =~ /\s+$/) {
+ warn "xxx: $protocol:$host:$port:$dbname: whitespaces\n";
+ }
+
+ my @errors = $id;
+
+ if ($tests{'protocol'}) {
+ push(@errors, 'protocol number is not valid') if $protocol !~ /^(z39\.50|sru|srw|tcp)$/i;
+ }
+
+ if ($tests{'port'}) {
+ push(@errors, 'port number is not valid') if $port !~ /^\d+$/;
+ }
+
+ if ($tests{'host'}) {
+ push(@errors, 'host name is not valid') if $host !~ /^[0-9a-z]+[0-9a-z\.\-]*\.[0-9a-z]+$/i;
+ }
+
+ if ($tests{'database'}) {
+ push(@errors, 'database name is not valid') if $dbname =~ m,/,i;
+ push(@errors, 'database has trailing spaces') if $dbname =~ /^\s+|\s+$/;
+ }
+
+ if ($tests{'hosturl'}) {
+ my $hosturl = $xc->findnodes("i:status/i:hostURL") || "";
+ push(@errors, 'This hosturl name is not valid') if $hosturl !~ /^\w+$/i;
+ }
+
+ return ( !$#errors, \@errors );
+}
1;
qw(e:title e:description) ],
[ subjects => 2, "Subjects", "e:databaseInfo/e:subjects",
qw(e:title e:description) ],
+ [ disabled => [ qw(0 1) ],
+ "Target Test Disabled", "i:status/i:disabled" ],
);
# Update record with submitted data
--- /dev/null
+ <p>The target will not be tested automatically if set and is not zero.</p>
+
+ <p>This option is mainly for the administrator of IRSpy in case of trouble.</p>
# Extensions
index.zeerex.libType = 1=zeerex:libType 4=3
index.zeerex.country = 1=zeerex:country 4=3
+index.zeerex.disabled = 1=zeerex:disabled 4=3
# Relation attributes are selected according to the CQL relation by
# looking up the "relation.<relation>" property:
<z:index name="zeerex:country" type="0">
<xsl:value-of select="i:status/i:country"/>
</z:index>
+ <z:index name="zeerex:disabled" type="0">
+ <xsl:value-of select="i:status/i:disabled"/>
+ </z:index>
</z:record>
</xsl:template>