Net-Finger-1.06/ 40755 1750 1750 0 7370353732 12355 5ustar dennisdennisNet-Finger-1.06/Makefile.PL100644 1750 1750 432 7370352664 14406 0ustar dennisdennisuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Net::Finger', 'VERSION_FROM' => 'Finger.pm', # finds $VERSION 'dist' => { 'COMPRESS' => 'gzip --best' }, ); Net-Finger-1.06/Changes100644 1750 1750 2320 7370353664 13746 0ustar dennisdennisRevision history for Perl extension Net::Finger. 1.0 Tue Dec 15 16:32:05 EST 1998 - Wrote it in about 30 minutes while staying late at work. Cleaned it up the next day for CPAN submission. See the BUGS section in the pod for the things I'd like to work into it sometime. 1.01 Sun Dec 20 12:27:51 CST 1998 - Fixed a silly bug with apostrophes in quoted strings. Thanks muchly to James Mastros for pointing this out. 1.02 Sometime on February 11th - Chris Nandor, the Pudgemeister, pointed out that \r\n won't mean what I was using it to mean on a Mac. We now use \015\012. 1.03 Wed Mar 3 12:33:45 EST 1999 - The inifitely studly Vladimir Pastukhov sent me a patch for the nifty "hostname:port" feature. Replaced the constant DEBUG stuff with the user-frobbable $Net::Finger::debug flag. 1.04 Thu Mar 4 12:00:34 EST 1999 - The Pudgemeister does it again. Damn, am I stupid. 1.05 Sat Jun 12 14:55:40 CDT 1999 - John Porter is wee. I am neen. Fixed a bug with $_ that I deserve to be righteously slapped for. Thanks, John! 1.06 Thu Nov 1 15:14:27 PST 2001 - Many thanks to Alan Burlison, who sent in a patch for a bug that inhibited verbose output when using the "@host" syntax. Net-Finger-1.06/test.pl100644 1750 1750 703 7370352664 13751 0ustar dennisdennis# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' BEGIN { $| = 1; print "1..1\n"; } END {print "not ok 1\n" unless $loaded;} use Net::Finger; $loaded = 1; print "ok 1\n"; # I'm not going to define tests here, since they would rely on # having a working network and working finger server on a # hard-wired other end. Shudder. Too many external variables. Net-Finger-1.06/Finger.pm100644 1750 1750 11571 7370353705 14247 0ustar dennisdennis################################################################## # # # 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__ =head1 NAME Net::Finger - a Perl implementation of a finger client. =head1 SYNOPSIS use Net::Finger; # You can put the response in a scalar... $response = finger('corbeau@execpc.com'); unless ($response) { warn "Finger problem: $Net::Finger::error"; } # ...or an array. @lines = finger('corbeau@execpc.com', 1); =head1 DESCRIPTION Net::Finger is a simple, straightforward implementation of a finger client in Perl -- so simple, in fact, that writing this documentation is almost unnecessary. This module has one automatically exported function, appropriately entitled C. It takes two arguments: =over =item * A username or email address to finger. (Yes, it does support the vaguely deprecated "user@host@host" syntax.) If you need to use a port other than the default finger port (79), you can specify it like so: "username@hostname:port". =item * (Optional) A boolean value for verbosity. True == verbose output. If you don't give it a value, it defaults to false. Actually, whether this output will differ from the non-verbose version at all is up to the finger server. =back C is context-sensitive. If it's used in a scalar context, it will return the server's response in one large string. If it's used in an array context, it will return the response as a list, line by line. If an error of some sort occurs, it returns undef and puts a string describing the error into the package global variable C<$Net::Finger::error>. If you'd like to see some excessively verbose output describing every step C takes while talking to the other server, put a true value in the variable C<$Net::Finger::debug>. Here's a sample program that implements a very tiny, stripped-down finger(1): #!/usr/bin/perl -w use Net::Finger; use Getopt::Std; use vars qw($opt_l); getopts('l'); $x = finger($ARGV[0], $opt_l); if ($x) { print $x; } else { warn "$0: error: $Net::Finger::error\n"; } =head1 BUGS =over =item * Doesn't yet do non-blocking requests. (FITNR. Really.) =item * Doesn't do local requests unless there's a finger server running on localhost. =item * Contrary to the name's implications, this module involves no teledildonics. =back =head1 AUTHOR Dennis Taylor, Ecorbeau@execpc.comE =head1 SEE ALSO perl(1), finger(1), RFC 1288. =cut Net-Finger-1.06/MANIFEST100644 1750 1750 57 7370352664 13550 0ustar dennisdennisChanges Finger.pm MANIFEST Makefile.PL test.pl