view release on metacpan or  search on metacpan

Lyskom.pm  view on Meta::CPAN

all.

This sub is intended for internal use.

=cut

sub is_error {
    my $self = shift;
    my ($code, $err_no, $err_status) = @_;

    if ($code =~ /^=/) {
        $self->{err_no} = 0;
        $self->{err_status} = 0;
        $self->{err_string} = "";
        return 0;               # Not an error
    } elsif ($code =~ /^%%/) {
        $self->{err_no} = 4711;
        $self->{err_status} = $err_status;
        $self->{err_string} = "Protocol error!";
        return 1;               # Is an error
    } elsif ($code =~ /^%/) {
        $self->{err_no} = $err_no;
        $self->{err_status} = $err_status;
        $self->{err_string} = $error[$err_no];
        return 1;               # Is an error
    } else {
        croak "An unknown error? ($code)\n";
    }
}

sub err_no {my $s = shift; return $s->{err_no}}
sub err_status {my $s = shift; return $s->{err_status}}
sub err_string {my $s = shift; return $s->{err_string}}

=item new([options])

Creates a new Net::Lyskom object and connect to a LysKOM server. By
default it connects to the server at Lysator (I<kom.lysator.liu.se>,
port 4894). To connect to another server, use named arguments.

    $a = Net::Lyskom->new(Host => "kom.csd.uu.se", Port => 4894);

If the connection succeded, an object is returned, if not C<undef> is
returned.

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    my %arg = @_;

    my $host = $arg{Host} || "kom.lysator.liu.se";
    my $port = $arg{Port} || 4894;

    my $name =
      $arg{Name} ||
        $ENV{USER} ||
          $ENV{LOGNAME} ||
            ((getpwuid($<))[0]);

    $self->{refno} = 1;

    $self->{socket} = IO::Socket::INET->new(
                                            PeerAddr => $host,
                                            PeerPort => $port,
                                           )
      or croak "Can't connect to remote server: $!\n";

    $self->{socket}->print("A".holl($name)."\n");

    my $tmp = $self->{socket}->getline;
    while (!$tmp || $tmp !~ /LysKOM/) {
        $tmp = $self->{socket}->getline;
    }

    bless $self, $class;
    return $self;
}

=item getres()

Get responses and asynchronous messages from the server. The asynchronous
messages is passed to C<handle_async()>. This method is intended for
internal use, and shall normally not be used anywhere else then in
this module.

=cut

sub getres {
    my $self = shift;
    my @res;

    @res = $self->getres_sub;
    while ($res[0] =~ m/^:/) {
        $self->handle_asynch(@res);
        @res = $self->getres_sub;
    }
    return @res;
}

=item getres_sub()

Helper function to C<getres()>. Be careful and I<understand> what you are
up to before using it.

=cut

sub getres_sub {
    my $self = shift;
    my ($f, $r);
    my @res;

    $r = $self->{socket}->getline;
    while ($r) {
        if ($r =~ m|^(\d+)H(.*)$|) { # Start of a hollerith string
            my $tot_len = $1;
            my $res;
            $r = $2."\n";