#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

# $Id: FingerDB.pm,v 1.13 2004/10/17 14:02:52 eric Exp $

use strict;
require Exporter;

$W3C::Rdf::FingerDB::REVISION = '$Id: FingerDB.pm,v 1.13 2004/10/17 14:02:52 eric Exp $ ';

package W3C::Rdf::FingerDB;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw();
$VERSION = 0.94;
$DSLI = 'adpO';

use Net::Telnet;

use W3C::Rdf::RdfDB;
package W3C::Rdf::FingerDB;
@W3C::Rdf::FingerDB::ISA = qw(W3C::Rdf::RdfDB);
use W3C::Util::Exception;
use W3C::Rdf::Atoms qw($ATTRIB_GroundFact);

sub triplesMatching {
    my ($self, $view, $lookFors, $flags) = @_;

    my @results;
    foreach my $lookFor (@$lookFors) {
	my ($p, $s, $o, $c, $r, $a) = @$lookFor;
	if ($s->getUri =~ m|^finger://([^/]+)/(?:W/)?([^@]+)(?:@([^/]+))?$|) {
	    my ($host, $name, $atHost) = ($1, $2, $3);

	    if ($p->getUri =~ m|^http://dev.w3.org/cvsweb/perl/modules/W3C/Rdf/FingerDB.pm\#(\w+)$|) {
		my $attr = $1;

		$self->checkCache($host, $name);
		if (my $value = $self->{FINGER_INFO}{$host}{$name}{$attr}) {
		    my $str = $self->{-atomDictionary}->getString($value, undef, 'PLAIN');

		    if ($o && $o != $str) {
		    } else {
			my $a = $self->{-sourceAttribution};
			if (!$a) {
			    $a = $self->{-atomDictionary}->getGroundFactAttribution(
							 $self->{-atomDictionary}->getUri($s), 
									  undef, undef, undef);
			}
			my $statement = $self->{-atomDictionary}->getStatement($p, $s, $str, undef);
			$statement->getAttributionList->ensureDirectAttribution($a);
			push (@results, $statement);
		    }
		}
	    }
	}
    }
    return @results;
}

######## The bulk of this module is finger protocol code.
########

sub errorHandler {
    my ($errmsg) = @_;
    if ($errmsg =~ m/^unknown remote host: ([\d\.]+)$/) {
	&throw(new W3C::Util::Exception(-message => $errmsg));
    } elsif ($errmsg =~ m/^print failed: (.*)$/) {
	my $reason = $1;
	if ($reason eq 'handle is closed') {
	    &throw(new W3C::Util::Exception(-message => $errmsg));
	} else {
	    &throw(new W3C::Util::Exception(-message => $errmsg));
	}
    } elsif ($errmsg =~ m/^unexpected read error: (.*)$/) {
	my $reason = $1;
	if ($reason eq 'Broken pipe') {
	    &throw(new W3C::Util::Exception(-message => $errmsg));
	} elsif ($reason eq 'Connection reset by peer') {
	    &throw(new W3C::Util::Exception(-message => $errmsg));
	} else {
	    &throw(new W3C::Util::Exception(-message => $errmsg));
	}
    } else {
	&throw(new W3C::Util::Exception(-message => $errmsg));
    }
}

sub checkCache {
    my ($self, $host, $name) = @_;

    my $curTime = time;
    if (!exists $self->{LAST_UPDATE}{$host}{$name} || 
	$self->{LAST_UPDATE}{$host}{$name} + $self->{-cacheTimeout} <= $curTime) {

	# clear out that user's finger info
	$self->{LAST_UPDATE}{$host}{$name} = $curTime;
	$self->{FINGER_INFO}{$host}{$name} = {};

	# parse and import the finger data
	# $self->parseFingerInfo($host, $name, &fakeUserInfo($host));
	# $self->parseFingerInfo($host, $name, &fakeHostInfo($host));
	$self->parseFingerInfo($host, $name, &getFingerInfo($host, $name));
    }
}

sub parseFingerInfo {
    my ($self, $host, $name, $results) = @_;
# GIVEN:
#Login: eric           			Name: Eric Prud'hommeaux
#Directory: /home/eric               	Shell: /bin/bash
#On since Sun Jul 30 19:23 (EDT) on tty1   1 day 1 hour idle
#No mail.
#No Plan.

    # split into lines
    my @lines = split(/[\r\n]+/, $results);

    # start at first line
    my $i= 0;

    # import attr: value atoms in first few lines
    while ($i < @lines && $lines[$i] =~ m/^(\w+)\s*\:\s*(.*)$/) {
	my ($attr, $value) = ($1, $2);
	while ($value =~ m/^(.*?)(\w+)\s*\:\s*(.*)$/) {
	    $value = $1;
	    my ($nextAttr, $nextValue) = ($2, $3);
	    $value =~ s/\s+$//;
	    $self->storeFingerInfo($host, $name, $attr, $value);
	    ($attr, $value) = ($nextAttr, $nextValue);
	}
	$self->storeFingerInfo($host, $name, $attr, $value);
	$i++;
    }

    # parse the On since line
    if ($lines[$i] =~ m/^On since (.*?) on (\w+) *(.*?)( idle)?/) {
	my ($onSince, $tty, $idle) = ($1, $2, $3);
	$self->storeFingerInfo($host, $name, 'onSince', $onSince);
	$self->storeFingerInfo($host, $name, 'tty', $tty);
	$self->storeFingerInfo($host, $name, 'idle', $idle);
    } else {
	&throw(new W3C::Util::Exception(-message => "couldn't parse $lines[$i]"));
    }

    # guess that next line is mail info
    $i++;
    $self->storeFingerInfo($host, $name, 'mail', $lines[$i]);

    # assume remaining lines are the plan
    $i++;
    $self->storeFingerInfo($host, $name, 'plan', join ("\n", @lines[$i..@lines-1]));
}

sub storeFingerInfo {
    my ($self, $host, $name, $attr, $value) = @_;
    $self->{FINGER_INFO}{$host}{$name}{$attr} = $value;
    # print "http://finger.net/get/$host/$name -http://finger.net/attrs/$attr-> \"$self->{FINGER_INFO}{$host}{$name}{$attr}\"\n";
}

# Telnet to the port and get the finger info.
sub getFingerInfo {
    my ($host, $name) = @_;
    # connect to remote finger server
    my $t = new Net::Telnet(Binmode => 1, Errmode => sub {&errorHandler(@_)}, Port => 'finger', Timeout => 10);
    $t->open($host);
    $t->print("$name\r\n");
    my $ret = $t->get;
    $t->close;
    return $ret;
}

# Substitute for getFingerInfo for debugging or demo or whatever.
sub fakeUserInfo {
return <<EOF
Login: eric                             Name: Debian Q. User
Directory: /home/eric                   Shell: /bin/bash
On since Wed Nov 26 16:04 (JST) on tty1     4 days 8 hours idle
     (messages off)
On since Sun Nov 30 12:00 (JST) on pts/0 from :0.0
    2 hours 44 minutes idle
On since Wed Nov 26 16:06 (JST) on pts/1 from :0.0
    21 hours 20 minutes idle
On since Wed Nov 26 16:07 (JST) on pts/2 from :0.0
    13 hours 4 minutes idle
On since Wed Nov 26 16:11 (JST) on pts/3 from :0.0
    3 hours 48 minutes idle
On since Wed Nov 26 16:11 (JST) on pts/4 from :0.0
    26 minutes 16 seconds idle
On since Thu Nov 27 09:23 (JST) on pts/8 from :0.0
    26 minutes 18 seconds idle
On since Fri Nov 28 08:18 (JST) on pts/12 from :0.0
   2 days 7 hours idle
On since Wed Nov 26 21:06 (JST) on pts/13 from :0.0
   39 minutes 22 seconds idle
On since Fri Nov 28 13:36 (JST) on pts/9 from :0.0
    9 hours 51 minutes idle
On since Mon Dec  1 01:01 (JST) on pts/15 from :0.0
On since Fri Nov 28 23:33 (JST) on pts/17 from :0.0
   1 day 11 hours idle
No mail.
No Plan.
EOF
    ;
}

# Substitute for getFingerInfo for debugging or demo or whatever.
sub fakeHostInfo {
return <<EOF
Login     Name             Tty      Idle  Login Time   Office     Office Phone
eric      Debian Q. User  *tty1       4d  Nov 26 16:04
eric      Debian Q. User   pts/0    3:19  Nov 30 12:00 (:0.0)
eric      Debian Q. User   pts/1   21:55  Nov 26 16:06 (:0.0)
eric      Debian Q. User   pts/2   13:39  Nov 26 16:07 (:0.0)
eric      Debian Q. User   pts/3    4:23  Nov 26 16:11 (:0.0)
eric      Debian Q. User   pts/4       9  Nov 26 16:11 (:0.0)
eric      Debian Q. User   pts/8       9  Nov 27 09:23 (:0.0)
eric      Debian Q. User   pts/12     2d  Nov 28 08:18 (:0.0)
eric      Debian Q. User   pts/13      3  Nov 26 21:06 (:0.0)
eric      Debian Q. User   pts/9   10:26  Nov 28 13:36 (:0.0)
eric      Debian Q. User   pts/15         Dec  1 01:01 (:0.0)
eric      Debian Q. User   pts/17     1d  Nov 28 23:33 (:0.0)
root      root            *pts/10  10:26  Nov 28 13:36 (na)
EOF
    ;
}

1;

__END__

=head1 NAME

W3C::Rdf::ObjectDB - RDF DB mapping to finger protocol

=head1 SYNOPSIS

  use W3C::Rdf::FingerDB;
  my $FingerDB = new W3C::Rdf::FingerDB(-atomDictionary => $atoms);

=head1 DESCRIPTION

C<W3C::Rdf::FingerDB> is an RDF database following the C<W3C::Rdf::RdfDB>
interface. This provides information available via the finger protocol
(details about what users are logged on) as RDF data. This allows queries
to, for instance, look for documents (in an annotation server) of users
who are currently logged on (found in the FingerDB).

This module is part of the W3C::Rdf CPAN module.

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

C<W3C::Rdf::RdfDB>

=head1 COPYRIGHT

Copyright Massachusetts Institute of technology, 1998.

THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND COPYRIGHT HOLDERS MAKE NO REPRESENTATIONS
OR WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY OR
FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE OR DOCUMENTATION WILL NOT INFRINGE
ANY THIRD PARTY PATENTS, COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS. 

COPYRIGHT HOLDERS WILL NOT BE LIABLE FOR ANY DIRECT, INDIRECT, SPECIAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF ANY USE OF THE SOFTWARE OR DOCUMENTATION. 

The name and trademarks of copyright holders may NOT be used in advertising or publicity pertaining 
to the software without specific, written prior permission. Title to copyright in this software and 
any associated documentation will at all times remain with copyright holders. 

=cut
