t/16-packages.t

   1 # Before `make install' is performed this script should be runnable with
   2 # `make test'. After `make install' it should work as `perl 16-packages.t'
   3
   4 # Tests:
   5 #       connect anonymously => refused
   6 #       connect as "user" with incorrect password => refused
   7 #       connect as "user" with correct password
   8 #               try to create tmpdb => EPERM
   9 #       connect as admin with correct password
  10 #               try to create tmpdb => OK
  11 #               try to create tmpdb => EFAIL
  12
  13 use strict;
  14 use warnings;
  15 use Test::More tests => 39;
  16
  17 BEGIN { use_ok('Net::Z3950::ZOOM') };
  18
  19
  20 # We will create, and destroy, a new database with a random name
  21 my $host = "z3950.indexdata.com:2100";
  22 my $dbname = join("", map { chr(ord("a") + int(rand(26))) } 1..10);
  23
  24 # Connect anonymously, and expect this to fail
  25 my $conn = makeconn($host, undef, undef, 1011);
  26
  27 # Connect as a user, but with incorrect password -- expect failure
  28 Net::Z3950::ZOOM::connection_destroy($conn);
  29 $conn = makeconn($host, "user", "badpw", 1011);
  30
  31 # Connect as a non-privileged user with correct password
  32 Net::Z3950::ZOOM::connection_destroy($conn);
  33 $conn = makeconn($host, "user", "frog", 0);
  34
  35 # Non-privileged user can't create database
  36 makedb($conn, $dbname, 223);
  37
  38 # Connect as a privileged user with correct password, check DB is absent
  39 Net::Z3950::ZOOM::connection_destroy($conn);
  40 $conn = makeconn($host, "admin", "fish", 0);
  41 Net::Z3950::ZOOM::connection_option_set($conn, databaseName => $dbname);
  42 count_hits($conn, $dbname, "the", 109);
  43
  44 # Now create the database and check that it is present but empty
  45 makedb($conn, $dbname, 0);
  46 count_hits($conn, $dbname, "the", 114);
  47
  48 # Trying to create the same database again will fail EEXIST
  49 makedb($conn, $dbname, 224);
  50
  51 # Add a single record, and check that it can be found
  52 updaterec($conn, 1, content_of("samples/records/esdd0006.grs"), 0);
  53 count_hits($conn, $dbname, "the", 0, 1);
  54
  55 # Add the same record with the same ID: overwrite => no change
  56 updaterec($conn, 1, content_of("samples/records/esdd0006.grs"), 0);
  57 count_hits($conn, $dbname, "the", 0, 1);
  58
  59 # Add it again record with different ID => new copy added
  60 updaterec($conn, 2, content_of("samples/records/esdd0006.grs"), 0);
  61 count_hits($conn, $dbname, "the", 0, 2);
  62
  63 # Now drop the newly-created database
  64 dropdb($conn, $dbname, 0);
  65
  66 # A second dropping should fail, as the database is no longer there.
  67 dropdb($conn, $dbname, 235);
  68
  69
  70 sub makeconn {
  71     my($host, $user, $password, $expected_error) = @_;
  72
  73     my $options = Net::Z3950::ZOOM::options_create();
  74     Net::Z3950::ZOOM::options_set($options, user => $user)
  75         if defined $user;
  76     Net::Z3950::ZOOM::options_set($options, password => $password)
  77         if defined $password;
  78
  79     my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
  80     my $conn = Net::Z3950::ZOOM::connection_create($options);
  81     $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo);
  82     ok($errcode == 0, "unconnected connection object created");
  83
  84     Net::Z3950::ZOOM::connection_connect($conn, $host, 0);
  85     $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo);
  86     ok($errcode == $expected_error,
  87        "connection to '$host'" . ($errcode ? " refused ($errcode)" : ""));
  88
  89     return $conn;
  90 }
  91
  92
  93 sub makedb {
  94     my($conn, $dbname, $expected_error) = @_;
  95
  96     my $o = Net::Z3950::ZOOM::options_create();
  97     my $p = Net::Z3950::ZOOM::connection_package($conn, $o);
  98     # Inspection of the ZOOM-C code shows that this can never fail, in fact.
  99     ok(defined $p, "created package");
 100
 101     Net::Z3950::ZOOM::package_option_set($p, databaseName => $dbname);
 102     my $val = Net::Z3950::ZOOM::package_option_get($p, "databaseName");
 103     ok($val eq $dbname, "package option retrieved as expected");
 104
 105     Net::Z3950::ZOOM::package_send($p, "create");
 106     my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
 107     $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo);
 108     ok($errcode == $expected_error, "database creation '$dbname'" .
 109        ($errcode ? " refused ($errcode)" : ""));
 110
 111     # Now we can inspect the package options to find out more about
 112     # how the server dealt with the request.  However, it seems that
 113     # the "package database" described in the standard is not used,
 114     # and that the only options we can inspect are the following:
 115     $val = Net::Z3950::ZOOM::package_option_get($p, "targetReference");
 116     $val = Net::Z3950::ZOOM::package_option_get($p, "xmlUpdateDoc");
 117     # ... and we know nothing about expected or actual values.
 118
 119     Net::Z3950::ZOOM::package_destroy($p);
 120     ok(1, "destroyed createdb package");
 121 }
 122
 123
 124 sub dropdb {
 125     my($conn, $dbname, $expected_error) = @_;
 126
 127     my $o = Net::Z3950::ZOOM::options_create();
 128     my $p = Net::Z3950::ZOOM::connection_package($conn, $o);
 129     # No need to keep ok()ing this, or checking the option-setting
 130     Net::Z3950::ZOOM::package_option_set($p, databaseName => $dbname);
 131     Net::Z3950::ZOOM::package_send($p, "drop");
 132     my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
 133     $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo);
 134     ok($errcode == $expected_error,
 135        ("database drop '$dbname'" . ($errcode ? " refused $errcode" : "") .
 136         ($expected_error ? " expected $expected_error but succeeded" : "")));
 137
 138     Net::Z3950::ZOOM::package_destroy($p);
 139     ok(1, "destroyed dropdb package");
 140 }
 141
 142
 143 # We always use "specialUpdate", which adds a record or replaces it if
 144 # it's already there.  By contrast, "insert" fails if the record
 145 # already exists, and "replace" fails if it does not.
 146 #
 147 sub updaterec {
 148     my($conn, $id, $file, $expected_error) = @_;
 149
 150     my $o = Net::Z3950::ZOOM::options_create();
 151     my $p = Net::Z3950::ZOOM::connection_package($conn, $o);
 152     Net::Z3950::ZOOM::package_option_set($p, action => "specialUpdate");
 153     Net::Z3950::ZOOM::package_option_set($p, recordIdOpaque => $id);
 154     Net::Z3950::ZOOM::package_option_set($p, record => $file);
 155
 156     Net::Z3950::ZOOM::package_send($p, "update");
 157     my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
 158     $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo);
 159     ok($errcode == $expected_error, "record update $id" .
 160        ($errcode ? " failed $errcode '$errmsg' ($addinfo)" : ""));
 161
 162     Net::Z3950::ZOOM::package_destroy($p);
 163     ok(1, "destroyed update package");
 164 }
 165
 166
 167 sub count_hits {
 168     my($conn, $dbname, $query, $expected_error, $expected_count) = @_;
 169
 170     my $rs = Net::Z3950::ZOOM::connection_search_pqf($conn, $query);
 171     my($errcode, $errmsg, $addinfo) = (undef, "dummy", "dummy");
 172     $errcode = Net::Z3950::ZOOM::connection_error($conn, $errmsg, $addinfo);
 173     ok($errcode == $expected_error, "database '$dbname' " .
 174        ($errcode == 0 ? "can be searched" : "not searchable ($errcode)"));
 175     return if $errcode != 0;
 176     my $n = Net::Z3950::ZOOM::resultset_size($rs);
 177     ok($n == $expected_count,
 178        "database '$dbname' has $n records (expected $expected_count)");
 179 }
 180
 181
 182 sub content_of {
 183     my($filename) = @_;
 184
 185     use IO::File;
 186     my $f = new IO::File("<$filename")
 187         or die "can't open file '$filename': $!";
 188     my $text = join("", <$f>);
 189     $f->close();
 190
 191     return $text;
 192 }