t/3-simpleserver.t

   1 # $Id: 3-simpleserver.t,v 1.1 2007-10-05 12:12:10 mike Exp $
   2
   3 use strict;
   4 use warnings;
   5
   6 use strict;
   7 use warnings;
   8 use Test::More tests => 52;
   9 BEGIN { use_ok('Net::Z3950::PQF') };
  10
  11 my $parser = new Net::Z3950::PQF();
  12 ok(defined $parser, "created parser");
  13 my $top = $parser->parse(
  14 '@and @or @set 123 @attr 1=1023 frog @attr 2=3 @attr zthes 1=magic bar');
  15
  16 my $ss = $top->toSimpleServer();
  17 check_node($ss, "top node", "Net::Z3950::RPN::And", "an AND node");
  18 is(@$ss, 2, "top has two subtrees");
  19
  20 my $sub = $ss->[0];
  21 check_node($sub, "first subtree", "Net::Z3950::RPN::Or", "an OR node");
  22 is(@$sub, 2, "first subnode has two subtrees");
  23
  24 my $subsub = $sub->[0];
  25 check_node($subsub, "first subsubtree", "Net::Z3950::RPN::RSID", "an RSID");
  26 is($subsub->{id}, 123, "RSID value");
  27 check_attributes($subsub->{attributes}, "first subsubtree", 0);
  28
  29 $subsub = $sub->[1];
  30 check_node($subsub, "second subsubtree", "Net::Z3950::RPN::Term", "a Term");
  31 is($subsub->{term}, "frog", "term value");
  32 check_attributes($subsub->{attributes}, "second subsubtree", 1);
  33 check_attribute($subsub->{attributes}->[0],
  34                 "second subsubtree, only attribute", "bib-1", 1 => 1023);
  35
  36 $sub = $ss->[1];
  37 check_node($sub, "second subtree", "Net::Z3950::RPN::Term", "a Term");
  38 is($sub->{term}, "bar", "term value");
  39 check_attributes($sub->{attributes}, "second subtree", 2);
  40 check_attribute($sub->{attributes}->[0],
  41                 "second subtree, second attribute", "bib-1", 2 => 3);
  42 check_attribute($sub->{attributes}->[1],
  43                 "second subtree, first attribute", "zthes", 1 => "magic");
  44
  45 #use YAML; print Dump($ss);
  46
  47
  48 sub check_node {
  49     my($node, $caption, $class, $description) = @_;
  50
  51     ok(defined $node, "$caption is defined");
  52     ok(ref $node, "$caption is a reference");
  53     ok($node->isa($class), "$caption is $description");
  54 }
  55
  56
  57 sub check_attributes {
  58     my($attrs, $caption, $count) = @_;
  59
  60     ok(defined $attrs, "$caption has attributes");
  61     ok(ref $attrs, "$caption attributes are a reference");
  62     ok($attrs->isa("Net::Z3950::RPN::Attributes"), "$caption attributes type");
  63     is(@{ $attrs }, $count, "$caption attribute count = $count");
  64 }
  65
  66
  67 sub check_attribute {
  68     my($attr, $caption, $set, $type, $value) = @_;
  69
  70     ok(defined $attr, "$caption is defined");
  71     ok(ref $attr, "$caption is a reference");
  72     ok($attr->isa("Net::Z3950::RPN::Attribute"), "$caption type");
  73     is($attr->{attributeSet}, $set, "$caption attribute set");
  74     is($attr->{attributeType}, $type, "$caption attribute set");
  75     is($attr->{attributeValue}, $value, "$caption attribute set");
  76 }