view release on metacpan or  search on metacpan

lib/CDDB.pm  view on Meta::CPAN

		};
		if ( $@ ) {
			carp 'Unable to load the Encode module, falling back to ascii';
			$utf8 = 0;
		}
	}

	eval 'sub encode { $_[1] };sub decode { $_[1] }' unless $utf8;

	# Change the cddbp protocol level.
	my $cddb_protocol = $param{Protocol_Version};
	$cddb_protocol = ($utf8 ? 6 : 1) unless defined $cddb_protocol;
	carp <<EOF if $utf8 and $cddb_protocol < 6;
You have requested protocol level $cddb_protocol. However,
utf-8 support is only available starting from level 6
EOF

	# Mac Freaks Got Spaces!  Augh!
	$login =~ s/\s+/_/g;

	my $self = bless {
		hostname      => $hostname,
		login         => $login,
		mail_from     => undef,
		mail_host     => undef,
		libname       => $client_name,
		libver        => $client_version,
		cddbmail      => $submit_to,
		debug         => $debug,
		host          => $host,
		port          => $port,
		cddb_protocol => $cddb_protocol,
		utf8          => $utf8,
		lines         => [],
		frame         => '',
		response_code => '000',
		response_text => '',
	}, $type;

	$self;
}

#------------------------------------------------------------------------------
# Disconnect from a cddbp server.  This is needed sometimes when a
# server decides a session has performed enough requests.

sub disconnect {
	my $self = shift;
	if ($self->{handle}) {
		$self->command('quit');     # quit
		$self->response();          # wait for any response
		delete $self->{handle};     # close the socket
	}
	else {
		$self->debug_print( 0, '--- disconnect on unconnected handle' );
	}
}

#------------------------------------------------------------------------------
# Connect to a cddbp server.  Connecting and disconnecting are done
# transparently and are performed on the basis of need.  Furthermore,
# this routine will cycle through servers until one connects or it has
# exhausted all its possibilities.  Returns true if successful, or
# false if failed.

sub connect {
	my $self = shift;
	my $cddbp_host;

	# Try to get our hostname yet again, in case it failed during the
	# constructor call.
	unless (defined $self->{hostname}) {
		$self->{hostname} = &hostname() or croak "can't get hostname: $!";
	}

	# The handshake loop tries to complete an entire connection
	# negociation.  It loops until success, or until HOST returns
	# because all the hosts have failed us.

	HANDSHAKE: while ('true') {

		# Loop through the CDDB protocol hosts list up to twice in order
		# to find a server that will respond.  This implements a 2x retry.

		HOST: for (1..(@cddbp_hosts * 2)) {

			# Hard disconnect here to prevent recursion.
			delete $self->{handle};

			($self->{host}, $self->{port}) = @{$cddbp_hosts[$cddbp_host_selector]};

			# Assign the host we selected, and attempt a connection.
			$self->debug_print(
				0,
				"=== connecting to $self->{host} port $self->{port}"
			);
			$self->{handle} = new IO::Socket::INET(
				PeerAddr => $self->{host},
				PeerPort => $self->{port},
				Proto    => 'tcp',
				Timeout  => 30,
			);

			# The host did not answer.  Clean up after the failed attempt
			# and cycle to the next host.
			unless (defined $self->{handle}) {
				$self->debug_print(
					0,
					"--- error connecting to $self->{host} port $self->{port}: $!"
				);

				delete $self->{handle};
				$self->{host} = $self->{port} = '';

				# Try the next host in the list.  Wrap if necessary.
				$cddbp_host_selector = 0 if ++$cddbp_host_selector > @cddbp_hosts;

				next HOST;
			}

			# The host accepted our connection.  We'll push it back on the