File Coverage

blib/lib/Net/SynchroEdit/Service.pm

Criterion	Covered	Total	%
statement	74	183	40.4
branch	7	52	13.4
condition	0	3	0.0
subroutine	21	32	65.6
pod	10	11	90.9
total	112	281	39.8

package Net::SynchroEdit::Service;

use 5.008004;
use strict;
use warnings;
use IO::Select;
use IO::Socket;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Net::SynchroEdit ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

SE_ERR_CONNECTION_FAILED SE_ERR_INVALID_WELCOME SE_ERR_STREAM_CLOSED SE_ERR_DOCUMENT_NOT_FOUND SE_ERR_DOCUMENT_UNINITIALIZED SE_ERR_UNRECOGNIZED_REPLY SE_ERR_DOCUMENT_INITIALIZED SE_ERR_DOCUMENT_IN_SESSION SE_ERR_DOCUMENT_OPEN SE_ERR_FAILED_INSTANTIATION SE_ERR_FAILED_MOVING_UPLOAD SE_ERR_FAILED_SOURCE_COPY SE_ERR

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

# Error codes
use constant SE_ERR_CONNECTION_FAILED      => 1;
use constant SE_ERR_INVALID_WELCOME        => 2;
use constant SE_ERR_STREAM_CLOSED          => 3;
use constant SE_ERR_DOCUMENT_NOT_FOUND     => 4;
use constant SE_ERR_DOCUMENT_UNINITIALIZED => 5;
use constant SE_ERR_UNRECOGNIZED_REPLY     => 6;
use constant SE_ERR_DOCUMENT_INITIALIZED   => 7;
use constant SE_ERR_DOCUMENT_IN_SESSION    => 8;
use constant SE_ERR_DOCUMENT_OPEN          => 9;
use constant SE_ERR_FAILED_INSTANTIATION   => 10;
use constant SE_ERR_FAILED_MOVING_UPLOAD   => 11;
use constant SE_ERR_FAILED_SOURCE_COPY     => 12;
use constant SE_ERR                        => 999;


our $VERSION = '0.039';
our @buf     = ();
our %lastSessions;

# Constructor.
#
sub new {
    my $package = shift;
    return bless({}, $package);
}

# Connect to the service.
# Returns true on success and false on failure.
#
### connect([host[, port[, user[, pass]]]])
sub connect {
    my $self = shift;

    # Reset internal vars.
    $self->{'queries'} = 0;
    $self->{'connected'} = 0;
    @buf     = ();
    $self->{'bchop'} = "";
    $self->{'host'}  = "localhost";
    $self->{'port'}  = 7962;
    $self->{'user'}  = "root";
    $self->{'pass'}  = "secret";

    # Acquire arguments, if any.
    $self->{'host'} = shift if @_;
    $self->{'port'} = shift if @_;
    $self->{'user'} = shift if @_;
    $self->{'pass'} = shift if @_;

    # Create new socket to service.
    my $stream = new IO::Socket::INET
	(PeerAddr => $self->{'host'},
	 PeerPort => $self->{'port'},
	 Proto    => "tcp",
	 );
    return unless $stream;

    $self->{'stream'} = $stream;

    # Create select.
    $self->{'select'} = new IO::Select();
    $self->{'select'}->add($self->{'stream'});

    # Read welcome string.
    ($self->{'reader'}) = $self->{'select'}->can_read(10);
    return if not defined $self->{'reader'};
    $self->{'reader'}->sysread($self->{'welcome'}, 1024);

    # Mark us as connected.
    $self->{'connected'} = 1;

    # Send login information.
    print $stream "USER $self->{'user'}\nPASS $self->{'pass'}\n";

    # Fetch information about server.
    return unless $self->fetch_info;
    return 1;
}

# Shutdown a specific session by SID in $timer minutes.
#
### shutdown(SID[, timer])
sub shutdown {
    my $self  = shift;
    my $sid   = shift;
    my $timer = 0;
    $timer = shift if @_;

    return unless $self->query("SHUTDOWN $sid"); # XXX: $timer is currently ignored.
    # my @result = ;
    return unless $self->fetch_status eq "ACK";
    return 1;
}

# Disconnect from response service.
#
### disconnect()
sub disconnect {
    my $self = shift;

    return unless $self->{'connected'};
    close $self->{'stream'};
    undef $self->{'connected'};
    return 1;
}

# Request a list of existing sessions. If $extended is true, an additional STATUS request is sent
# per document.
# On success, returns a map with a set of values. The "SIDS" key contains a list of the sessions,
# space-separated. The data of a particular session can be retrieved using the get() method.
# If $extended, each entry additionally contains AGE, USERS, CONTRIBUTORS, DOCSIZE.
#
### sessions([$extended = 0])
sub sessions {
    my $self = shift;

    my $extended = 0;
    $extended = shift if @_;

    return unless defined $self->query("QUERY");
    my @result = $self->fetch_result;
    my $ix     = $#result+1;
    return if $ix == 1;
    my %retval;
    my $i;
    for ($i = 0; $i < $ix; $i++) {
	my @docexpr = split(/ /, $result[$i++]);
	my @isexpr  = split(/ /, $result[$i]);
	shift @docexpr;
	my $doc     = join(" ", @docexpr);
	shift @isexpr;
	my $sid = shift @isexpr;
	$retval{"$sid-DOCUMENT"} = $doc;
	$retval{"$sid-PORT"} = shift @isexpr;
	$retval{"$sid-FLAGS"} = shift @isexpr;
	if ($extended) {
	    $self->query("STATUS $sid");
	    my %edata = $self->fetch_map;
	    $retval{"$sid-AGE"}          = $edata{'AGE'};
	    $retval{"$sid-USERS"}        = $edata{'USERS'};
	    $retval{"$sid-CONTRIBUTORS"} = $edata{'CONTRIBUTORS'};
	    $retval{"$sid-DOCSIZE"}      = $edata{'DOCSIZE'};
	}
	if (defined $retval{'SIDS'}) {
	    $retval{'SIDS'} = "$retval{'SIDS'} $sid";
	} else {
	    $retval{'SIDS'} = "$sid";
	}
    }
    %lastSessions = %retval;
    return %retval;
}

# Get the shortened variables for a particular sessions session.
#
### get($sid)
sub get {
    my $self = shift;
    my %hashmap = %lastSessions;
    my $sid = shift;

    my %result = ('DOCUMENT',     $hashmap{"$sid-DOCUMENT"},
		  'PORT',         $hashmap{"$sid-PORT"},
		  'FLAGS',        $hashmap{"$sid-FLAGS"},
		  'AGE',          $hashmap{"$sid-AGE"},
		  'USERS',        $hashmap{"$sid-USERS"},
		  'CONTRIBUTORS', $hashmap{"$sid-CONTRIBUTORS"},
		  'DOCSIZE',      $hashmap{"$sid-DOCSIZE"});
    return %result;
}

# Perform service query.
#
### query($cmd)
sub query {
    my $self = shift;

    # Acquire arguments, if any.
    return unless @_;
    my $cmd = shift;
    $self->{'queries'}++;
    return unless $self->{'connected'};
    my $stream = $self->{'stream'};
    print $stream "$cmd\n";
    return 1;
}

# Fill buffer.
sub _fillbuf {
    my $self  = shift;
    my $bchop = $self->{'bchop'};
    my $line  = "";
    $self->{'reader'}->sysread($line, 4096);
    $line = "$bchop$line";
    push(@buf, split(/\n/, $line));
    if (substr($line, (length $line)-1, 1) ne "\n") {
	$bchop = pop @buf;
	print "substr caught unended line; chopping off '$bchop' from '$line'\n";
    }
    $self->{'bchop'} = $bchop;
}

# Get next line.
# NOTE: This function requires that either
# 1) a new line is buffered, or
# 2) there is data from the server waiting.
# If neither 1 nor 2, the code will hang for a while,
# until new data is available, which probably is never.
sub _nextline {
    my $self = shift;
    if (!@buf) {
	$self->_fillbuf;
    }
    return shift @buf;
}

# Read the next pending result, if any.
#
### fetch_result()
sub fetch_result {
    my $self = shift;

    return unless $self->{'connected'};
    return unless $self->{'queries'} > 0;

    $self->{'queries'}--;
    my @result;
    my $line;
    while (($line = $self->_nextline) && $line ne "END") {
	push(@result, $line);
    }
    return @result;
}

# Fetch the first line only in a pending result.
# The remaining data, if any, is discarded.
#
### fetch_status()
sub fetch_status {
    my $self = shift;

    my @result = $self->fetch_result;
    return unless @result;
    return shift @result;
}

# Return the next pending result as a hashmap.
# This is only supported when the response is a list of keys
# and values in the format "KEY VALUE\nKEY2 VALUE2\n..."
#
### fetch_map()
sub fetch_map {
    my $self = shift;

    my @query  = $self->fetch_result;
    my %result;
    my $line;
    my @pair;
    while ($line = shift @query) {
	@pair = split(/ /, $line, 2);
	if ($#pair != 1) {
	    # The result most likely failed, so we set the _ key to $line.
	    $result{'_'} = $line;
	} else {
	    $result{$pair[0]} = $pair[1];
	}
    }
    return %result;
}

# Re-fetch information from service.
# Returns success boolean.
#
### fetch_info()
sub fetch_info {
    my $self = shift;

    return unless $self->query("INFO");

    my %result = $self->fetch_map;
    return if $result{'_'};
    $self->{'localPath'}   = $result{'LOCALPATH'};
    $self->{'uptime'}      = $result{'UPTIME'};
    $self->{'serverModel'} = $result{'SERVERMODEL'};
    return 1;
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__