-# $Id: IRSpy.pm,v 1.28 2006-10-12 15:51:37 mike Exp $
+# $Id: IRSpy.pm,v 1.29 2006-10-12 16:54:13 mike Exp $
package ZOOM::IRSpy;
BEGIN {
ZOOM::Log::mask_str("irspy");
- ZOOM::Log::mask_str("irspy_test");
ZOOM::Log::mask_str("irspy_debug");
ZOOM::Log::mask_str("irspy_event");
ZOOM::Log::mask_str("irspy_unhandled");
+ ZOOM::Log::mask_str("irspy_test");
+ ZOOM::Log::mask_str("irspy_task");
}
sub new {
# Out of tasks: we need a new test
NEXT_TEST:
my $address = $conn->option("current_test_address");
- my $nextaddr = defined $address ?
- $this->_next_test($address) : "";
+ my $nextaddr;
+ if (!defined $address) {
+ $nextaddr = "";
+ } else {
+ $this->log("irspy_test", "checking for next test after '$address'");
+ $nextaddr = $this->_next_test($address);
+ }
if (!defined $nextaddr) {
$conn->log("irspy", "has no more tests: removing");
splice @conn, $i0, 1;
or die "invalid nextaddr '$nextaddr'";
$conn->option(current_test_address => $nextaddr);
my $tname = $node->name();
- $conn->log("irspy", "starting test '$nextaddr' = $tname");
+ $conn->log("irspy_test", "starting test '$nextaddr' = $tname");
my $tasks = $conn->tasks();
my $oldcount = @$tasks;
"ZOOM::IRSpy::Test::$tname"->start($conn);
# Prepare to start the first of the newly added tasks
$conn->next_task($tasks->[$oldcount]);
} else {
- $conn->log("irspy", "no tasks added by new test $tname");
+ $conn->log("irspy_task", "no tasks added by new test $tname");
goto NEXT_TEST;
}
}
my $task = $conn->next_task();
die "no next task queued for $conn" if !defined $task;
- $conn->log("irspy", "starting task $task");
+ $conn->log("irspy_task", "starting task $task");
$conn->next_task(0);
$conn->current_task($task);
$task->run();
my $task = $conn->current_task();
die "no task for TASK_DONE on $conn" if !$task;
die "next task already defined for $conn" if $conn->next_task();
- $conn->log("irspy", "completed task $task");
+ $conn->log("irspy_task", "completed task $task");
$conn->next_task($task->{next});
$conn->current_task(0);
} elsif ($res == ZOOM::IRSpy::Status::TEST_GOOD ||
$res == ZOOM::IRSpy::Status::TEST_BAD) {
my $x = ($res == ZOOM::IRSpy::Status::TEST_GOOD) ? "good" : "bad";
- $conn->log("irspy", "test completed ($x)");
+ $conn->log("irspy_test", "test completed ($x)");
$conn->current_task(0);
$conn->next_task(0);
if ($res == ZOOM::IRSpy::Status::TEST_BAD) {
}
}
- $this->log("irspy_event", "no more events: finishing");
+ $this->log("irspy", "exiting main loop");
#$this->_rewrite_records();
return $nskipped;
my $this = shift();
my($address, $omit_child) = @_;
- $this->log("irspy", "checking for next test after '$address'");
-
# Try first child
if (!$omit_child) {
my $maybe = $address eq "" ? "0" : "$address:0";
-# $Id: Connection.pm,v 1.3 2006-10-12 14:35:43 mike Exp $
+# $Id: Connection.pm,v 1.4 2006-10-12 16:54:13 mike Exp $
package ZOOM::IRSpy::Connection;
my $old = $this->{current_task};
if (defined $new) {
$this->{current_task} = $new;
- $this->log("irspy_debug", "set current task to $new");
+ $this->log("irspy_task", "set current task to $new");
}
return $old;
my $old = $this->{next_task};
if (defined $new) {
$this->{next_task} = $new;
- $this->log("irspy_debug", "set next task to $new");
+ $this->log("irspy_task", "set next task to $new");
}
return $old;
my $task = new ZOOM::IRSpy::Task::Connect($this, $udata, %cb);
$this->add_task($task);
- $this->log("irspy", "registered connect()");
}
my $task = new ZOOM::IRSpy::Task::Search($query, $this, $udata, %cb);
$this->add_task($task);
- $this->log("irspy", "registered search_pqf($query)");
}
my $tasks = $this->{tasks};
$tasks->[-1]->{next} = $task if @$tasks > 0;
push @$tasks, $task;
- $this->log("irspy", "added task $task");
+ $this->log("irspy_task", "added task $task");
}
-# $Id: Record.pm,v 1.13 2006-09-26 09:08:09 mike Exp $
+# $Id: Record.pm,v 1.14 2006-10-12 16:54:13 mike Exp $
package ZOOM::IRSpy::Record;
if @nodes == 0;
}
- $this->{irspy}->log("irspy",
+ $this->{irspy}->log("warn",
scalar(@nodes), " matches for '$xpath': using first")
if @nodes > 1;
-# $Id: Connect.pm,v 1.2 2006-10-11 16:47:44 mike Exp $
+# $Id: Connect.pm,v 1.3 2006-10-12 16:54:13 mike Exp $
# See ZOOM/IRSpy/Task/Search.pm for documentation
my $this = shift();
my $conn = $this->conn();
- $conn->log("irspy_test", "connecting");
+ $conn->log("irspy_task", "connecting");
$conn->connect($conn->option("host"));
}
-# $Id: Search.pm,v 1.2 2006-10-11 16:48:19 mike Exp $
+# $Id: Search.pm,v 1.3 2006-10-12 16:54:13 mike Exp $
package ZOOM::IRSpy::Task::Search;
my $conn = $this->conn();
my $query = $this->{query};
- $this->irspy()->log("irspy_test", $conn->option("host"),
+ $this->irspy()->log("irspy_task", $conn->option("host"),
" searching for '$query'");
$this->{rs} = $conn->search_pqf($query);
sub render {
my $this = shift();
- return ref($this) . " " . $this->{query};
+ return ref($this) . "(" . $this->{query}. ")";
}
use overload '""' => \&render;
-# $Id: Main.pm,v 1.8 2006-10-11 16:46:37 mike Exp $
+# $Id: Main.pm,v 1.9 2006-10-12 16:54:13 mike Exp $
package ZOOM::IRSpy::Test::Main;
my $class = shift();
my($conn) = @_;
- $conn->log("irspy", "Main test no-opping");
+ $conn->log("irspy_test", "Main test no-opping");
# Do nothing -- this test is just a subtest container
}
-# $Id: Main.pm,v 1.2 2006-10-06 11:33:08 mike Exp $
+# $Id: Main.pm,v 1.3 2006-10-12 16:54:13 mike Exp $
package ZOOM::IRSpy::Test::Search::Main;
sub subtests { qw(Search::Title Search::Bib1) }
sub start {
+ my $class = shift();
+ my($conn) = @_;
+
+ $conn->log("irspy_test", "Main::Search test no-opping");
# Do nothing -- this test is just a subtest container
}
-# $Id: Title.pm,v 1.6 2006-10-12 14:38:27 mike Exp $
+# $Id: Title.pm,v 1.7 2006-10-12 16:54:13 mike Exp $
# See the "Main" test package for documentation
sub error {
my($conn, $task, $__UNUSED_udata, $exception) = @_;
- $conn->log("irspy_test", "error: $exception");
+ $conn->log("irspy_test", "title search had error: $exception");
my $rec = $conn->record();
$rec->append_entry("irspy:status", "<irspy:search_title ok='0'>" .
isodate(time()) . "</irspy:search_title>");
projects / irspy-moved-to-github.git / commitdiff