Net::Z3950::Manager - State manager for multiple Z39.50 connections.

	$mgr = new Net::Z3950::Manager(async => 1);
	$conn = $mgr->connect($hostname, $port);
	# Set up some more connections, then:
	while ($conn = $mgr->wait()) {
		# Handle message on $conn
	}

	$mgr = new Net::Z3950::Manager();

	$value = $mgr->option($type);
	$value = $mgr->option($type, $newval);

	$conn = $mgr->connect($hostname, $port);

	$conn = $mgr->wait();

	@conn = $mgr->connections();

	@rs = $mgr->resultSets();

# $Id: Manager.pm,v 1.25 2004/11/01 09:12:23 mike Exp $

package Net::Z3950::Manager;
use Event;
use strict;

# PRIVATE for debugging
sub warnconns {
    return;			# Don't emit this debugging output
    my($this) = shift;
    my($label, @msg) = @_;

    my $c = $this->{connections};
    my $n = @$c;
    warn "$label: $this has $n connections ($c) = { " .
	join(", ", map { "'$_'" } @$c) . " } @msg";

}

sub new {
    my $class = shift();
    # No additional arguments except options

    my $this = bless {
	connections => [],
	options => { @_ },
    }, $class;
    $this->warnconns("creation");
    return $this;
}

sub option {
    my $this = shift();
    my($type, $newval) = @_;

    my $value = $this->{options}->{$type};
    if (!defined $value) {
	$value = _default($type);
    }
    if (defined $newval) {
	$this->{options}->{$type} = $newval;
    }
    return $value;
}

# PRIVATE to the option() method
#
# This function specifies the hard-wired global defaults used when
# constructors and the option() method do not override them.
#
#	### Should have POD documentation for these options.  At the
#	moment, the only place they're described is in the tutorial.
#
sub _default {
    my($type) = @_;

    # Used in Net::Z3950::Manager::wait()
    return undef if $type eq 'die_handler';
    return undef if $type eq 'timeout';

    # Used in Net::Z3950::ResultSet::record() to determine whether to wait
    return 0 if $type eq 'async';
    return 'sync' if $type eq 'mode'; # backward-compatible old option

    # Used in Net::Z3950::Connection::new() (for INIT request)
    # (Values are mostly derived from what yaz-client does.)
    return 1024*1024 if $type eq 'preferredMessageSize';
    return 1024*1024 if $type eq 'maximumRecordSize';
    return undef if $type eq 'user';
    return undef if $type eq 'pass';
    return undef if $type eq 'password'; # backward-compatible
    return undef if $type eq 'group';
    return undef if $type eq 'groupid'; # backward-compatible
    # (Compare the next three values with those in "yaz/zutil/zget.c".
    # The standard doesn't give much help, just saying:
    #	3.2.1.1.6 Implementation-id, Implementation-name, and
    #	Implementation-version -- The request or response may
    #	optionally include any of these three parameters. They are,
    #	respectively, an identifier (unique within the client or
    #	server system), descriptive name, and descriptive version, for
    #	the origin or target implementation. These three
    #	implementation parameters are provided solely for the
    #	convenience of implementors, for the purpose of distinguishing
    #	implementations.
    # )
    return 'Mike Taylor (id=169)' if $type eq 'implementationId';
    return 'Net::Z3950.pm (Perl)' if $type eq 'implementationName';
    return $Net::Z3950::VERSION if $type eq 'implementationVersion';
    return undef if $type eq 'charset';
    return undef if $type eq 'language';

    # Used in Net::Z3950::Connection::startSearch()
    return 'prefix' if $type eq 'querytype';
    return 'Default' if $type eq 'databaseName';
    return 0 if $type eq 'smallSetUpperBound';
    return 1 if $type eq 'largeSetLowerBound';
    return 0 if $type eq 'mediumSetPresentNumber';
    return 'F' if $type eq 'smallSetElementSetName';
    return 'B' if $type eq 'mediumSetElementSetName';
    return "GRS-1" if $type eq 'preferredRecordSyntax';

    # Used in Net::Z3950::Connection::startScan()
    return 1 if $type eq 'responsePosition';
    return 0 if $type eq 'stepSize';
    return 20 if $type eq 'numberOfEntries';

    # Used in Net::Z3950::ResultSet::makePresentRequest()
    return 'B' if $type eq 'elementSetName';

    # Assume the server's not brain-dead unless we're told otherwise
    return 1 if $type eq 'namedResultSets';

    # etc.

    # Otherwise it's an unknown option.
    return undef;
}

sub connect {
    my $this = shift();
    my($hostname, $port, @other_args) = @_;

    # The "indirect object" notation "new Net::Z3950::Connection" fails if
    # we use it here, because we've not yet seen the Connection
    # module (Net::Z3950.pm use's Manager first, then Connection).  It gets
    # mis-parsed as an application of the new() function to the result
    # of the Connection() function in the Net::Z3950 package (I think) but
    # that error message is immediately further obfuscated by the
    # autoloader (thanks for that), which complains "Can't locate
    # auto/Net::Z3950/Connection.al in @INC".  It took me a _long_ time to
    # grok this ...
    return Net::Z3950::Connection->new($this, $hostname, $port, @other_args);
}

sub wait {
    my $this = shift();

    # The next line prevents the Event module from catching our die()
    # calls and turning them into warnings sans bathtub.  By
    # installing this handler, we can get proper death back.
    #
    ###	This is not really the right place to do this, but then where
    #	is?  There's no single main()-like entry-point to this
    #	library, so we may as well set Event's die()-handler just
    #	before we hand over control.
    my $handler = $this->option('die_handler');
    $Event::DIED = defined $handler ? $handler :
	\&Event::verbose_exception_handler;

    my $timeout = $this->option("timeout");
    # Stupid Event::loop() makes a distinction between undef and not there
    my $conn = defined $timeout ? Event::loop($timeout) : Event::loop();
    return ref $conn ? $conn : undef;
}


# PRIVATE to the Net::Z3950::Connection module's new() method
sub _register {
    my $this = shift();
    my($conn) = @_;

    $this->warnconns("pre-register", "adding $conn");
    push @{$this->{connections}}, $conn;
    $this->warnconns("post-register", "added $conn");
}

sub _UNUSED_connections {
    my $this = shift();

    return @{$this->{connections}};
}

sub resultSets {
    my $this = shift();

    my @rs;

    foreach my $conn ($this->connections()) {
	push @rs, @{$conn->{resultSets}};
    }

    return @rs;
}


### PRIVATE to the Net::Z3950::Connection::close() method.
sub forget {
    my $this = shift();
    my($conn) = @_;

    my $connections = $this->{connections};
    my $n = @$connections;
    $this->warnconns("forget()", "looking for $conn");
    for (my $i = 0; $i < $n; $i++) {
	if (defined $connections->[$i] && $connections->[$i] eq $conn) {
	    $this->warnconns("pre-splice", "forgetting $i of $n");
	    splice @{ $this->{connections} }, $i, 1;
	    $this->warnconns("post-splice", "forgot $i of $n");
	    return;
	}
    }

    # This happens far too often (why?) to be allowed
    #die "$this can't forget $conn";
}


sub DESTROY {
    my $this = shift();

    #warn "destroying Net::Z3950 Connection $this";
}

1;