vcs.maemo.org Git - pkg-perl/blob - deb-src/libwww-perl/libwww-perl-5.813/t/robot/rules-dbm.t

   1
   2 print "1..13\n";
   3
   4
   5 use WWW::RobotRules::AnyDBM_File;
   6
   7 $file = "test-$$";
   8
   9 $r = new WWW::RobotRules::AnyDBM_File "myrobot/2.0", $file;
  10
  11 $r->parse("http://www.aas.no/robots.txt", "");
  12
  13 $r->visit("www.aas.no:80");
  14
  15 print "not " if $r->no_visits("www.aas.no:80") != 1;
  16 print "ok 1\n";
  17
  18
  19 $r->push_rules("www.sn.no:80", "/aas", "/per");
  20 $r->push_rules("www.sn.no:80", "/god", "/old");
  21
  22 @r = $r->rules("www.sn.no:80");
  23 print "Rules: @r\n";
  24
  25 print "not " if "@r" ne "/aas /per /god /old";
  26 print "ok 2\n";
  27
  28 $r->clear_rules("per");
  29 $r->clear_rules("www.sn.no:80");
  30
  31 @r = $r->rules("www.sn.no:80");
  32 print "Rules: @r\n";
  33
  34 print "not " if "@r" ne "";
  35 print "ok 3\n";
  36
  37 $r->visit("www.aas.no:80", time+10);
  38 $r->visit("www.sn.no:80");
  39
  40 print "No visits: ", $r->no_visits("www.aas.no:80"), "\n";
  41 print "Last visit: ", $r->last_visit("www.aas.no:80"), "\n";
  42 print "Fresh until: ", $r->fresh_until("www.aas.no:80"), "\n";
  43
  44 print "not " if $r->no_visits("www.aas.no:80") != 2;
  45 print "ok 4\n";
  46
  47 print "not " if abs($r->last_visit("www.sn.no:80") - time) > 2;
  48 print "ok 5\n";
  49
  50 $r = undef;
  51
  52 # Try to reopen the database without a name specified
  53 $r = new WWW::RobotRules::AnyDBM_File undef, $file;
  54 $r->visit("www.aas.no:80");
  55
  56 print "not " if $r->no_visits("www.aas.no:80") != 3;
  57 print "ok 6\n";
  58
  59 print "Agent-Name: ", $r->agent, "\n";
  60 print "not " if $r->agent ne "myrobot";
  61 print "ok 7\n";
  62
  63 $r = undef;
  64
  65 print "*** Dump of database ***\n";
  66 tie(%cat, AnyDBM_File, $file, 0, 0644) or die "Can't tie: $!";
  67 while (($key,$val) = each(%cat)) {
  68     print "$key\t$val\n";
  69 }
  70 print "******\n";
  71
  72 untie %cat;
  73
  74 # Try to open database with a different agent name
  75 $r = new WWW::RobotRules::AnyDBM_File "MOMSpider/2.0", $file;
  76
  77 print "not " if $r->no_visits("www.sn.no:80");
  78 print "ok 8\n";
  79
  80 # Try parsing
  81 $r->parse("http://www.sn.no:8080/robots.txt", <<EOT, (time + 3));
  82
  83 User-Agent: *
  84 Disallow: /
  85
  86 User-Agent: Momspider
  87 Disallow: /foo
  88 Disallow: /bar
  89
  90 EOT
  91
  92 @r = $r->rules("www.sn.no:8080");
  93 print "not " if "@r" ne "/foo /bar";
  94 print "ok 9\n";
  95
  96 print "not " if $r->allowed("http://www.sn.no") >= 0;
  97 print "ok 10\n";
  98
  99 print "not " if $r->allowed("http://www.sn.no:8080/foo/gisle");
 100 print "ok 11\n";
 101
 102 sleep(5);  # wait until file has expired
 103 print "not " if $r->allowed("http://www.sn.no:8080/foo/gisle") >= 0;
 104 print "ok 12\n";
 105
 106
 107 $r = undef;
 108
 109 print "*** Dump of database ***\n";
 110 tie(%cat, AnyDBM_File, $file, 0, 0644) or die "Can't tie: $!";
 111 while (($key,$val) = each(%cat)) {
 112     print "$key\t$val\n";
 113 }
 114 print "******\n";
 115
 116 untie %cat;                     # Otherwise the next line fails on DOSish
 117
 118 while (unlink("$file", "$file.pag", "$file.dir", "$file.db")) {}
 119
 120 # Try open a an emty database without specifying a name
 121 eval {
 122    $r = new WWW::RobotRules::AnyDBM_File undef, $file;
 123 };
 124 print $@;
 125 print "not " unless $@;  # should fail
 126 print "ok 13\n";
 127
 128 unlink "$file", "$file.pag", "$file.dir", "$file.db";