File Coverage

blib/lib/Net/Finger.pm

Criterion	Covered	Total	%
statement	12	52	23.0
branch	0	24	0.0
condition	0	5	0.0
subroutine	4	5	80.0
pod	0	1	0.0
total	16	87	18.3

##################################################################
#                                                                #
#  Net::Finger, a Perl implementation of a finger client.        #
#                                                                #
#  By Dennis "FIMM" Taylor,                  #
#                                                                #
#  This module may be used and distributed under the same terms  #
#  as Perl itself. See your Perl distribution for details.       #
#                                                                #
##################################################################
# $Id$

package Net::Finger;

use strict;
use Socket;
use Carp;
use vars qw($VERSION @ISA @EXPORT $error $debug);

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw( &finger );

$VERSION = '1.06';
$debug = 0;


# I know the if ($debug) crap gets in the way of the code a bit, but
# it's a worthy sacrifice as far as I'm concerned.

sub finger {
    my ($addr, $verbose) = @_;
    my ($host, $port, $request, @lines, $line);

    unless (@_) {
        carp "Not enough arguments to Net::Finger::finger()";
    }

    # Set the error indicator to something innocuous.
    $error = "";

    $addr ||= '';
    if (index( $addr, '@' ) >= 0) {
        my @tokens = split /\@/, $addr;
        $host = pop @tokens;
        $request = join '@', @tokens;

    } else {
        $host = 'localhost';
        $request = $addr;
    }

    if ($verbose) {
        $request = "/W $request";
    }

    if ($debug) {
        warn "Creating a new socket.\n";
    }

    unless (socket( SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'))) {
        $error = "Can\'t create a new socket: $!";
        return;
    }
    select SOCK;  $| = 1;  select STDOUT;

    $port = ($host =~ s/:([0-9]*)$// && $1) ? $1 :
	                (getservbyname('finger', 'tcp'))[2];

    if ($debug) {
        warn "Connecting to $host, port $port.\n";
    }

    unless (connect( SOCK, sockaddr_in($port, inet_aton($host)) ))
    {
        $error = "Can\'t connect to $host: $!";
        return;
    }

    if ($debug) {
        warn "Sending request: \"$request\"\n";
    }

    print SOCK "$request\015\012";

    if ($debug) {
        warn "Waiting for response.\n";
    }

    while (defined( $line =  )) {
	$line =~ s/\015?\012/\n/g;    # thanks (again), Pudge!
	push @lines, $line;
    }

    if ($debug) {
        warn "Response received. Closing connection.\n";
    }

    close SOCK;
    return( wantarray ? @lines : join('', @lines) );
}



1;
__END__