File Coverage

blib/lib/Net/Lyskom.pm

Criterion	Covered	Total	%
statement	192	673	28.5
branch	24	230	10.4
condition	5	16	31.2
subroutine	42	120	35.0
pod	85	89	95.5
total	348	1128	30.8

package Net::Lyskom;

use 5.8.3;

use base qw{Net::Lyskom::Object};

use strict;
use IO::Socket;
use Time::Local;
use Encode;
use Net::Lyskom::AuxItem;
use Net::Lyskom::MiscInfo;
use Net::Lyskom::Time;
use Net::Lyskom::TextStat;
use Net::Lyskom::Conference;
use Net::Lyskom::Person;
use Net::Lyskom::Util qw(:all);
use Net::Lyskom::Membership;
use Net::Lyskom::TextMapping;
use Net::Lyskom::ConfZInfo;
use Net::Lyskom::DynamicSession;
use Net::Lyskom::StaticSession;
use Net::Lyskom::Member;
use Net::Lyskom::Info;

use Carp;

use vars qw{ @error };


our $VERSION = '1.2';

=head1 NAME

Net::Lyskom - Perl module used to talk to LysKOM servers.

=head1 SYNOPSIS

  use Net::Lyskom;

  $a = Net::Lyskom->new();
  $conf = 6;

  $a->login(pers_no => 437, password => "God", invisible => 1)
    or die "Failed to log in: $a->err_string\n";

  $b = $a->send_message(7680, "Oook!");

  $b = $a->create_text(
                       subject => "Testsubject",
                       body => "A nice and tidy message body.",
                       recpt => [437],
                      );

  if ($b) {
      print "Text number $b created.\n";
  } else {
      print "Text creation failed: $a->err_string.\n";
  }

=head1 DESCRIPTION

Net::Lyskom is a module used to talk to LysKOM servers. This far
it lacks a lot of functions, but there are enough functions implemented
to program statistics robots and such.

=head2 Metoder

=over

=cut

## Variables


@error = qw(no-error
            unused
            not-implemented
            obsolete-call
            invalid-password
            string-too-long
            login-first
            login-disallowed
            conference-zero
            undefined-conference
            undefined-person
            access-denied
            permission-denied
            not-member
            no-such-text
            text-zero
            no-such-local-text
            local-text-zero
            bad-name
            index-out-of-range
            conference-exists
            person-exists
            secret-public
            letterbox
            ldb-error
            illegal-misc
            illegal-info-type
            already-recipient
            already-comment
            already-footnote
            not-recipient
            not-comment
            not-footnote
            recipient-limit
            comment-limit
            footnote-limit
            mark-limit
            not-author
            no-connect
            out-of-memory
            server-is-crazy
            client-is-crazy
            undefined-session
            regexp-error
            not-marked
            temporary-failure
            long-array
            anonymous-rejected
            illegal-aux-item
            aux-item-permission
            unknown-async
            internal-error
            feature-disabled
            message-not-sent
            invalid-membership-type);


## Methods

=item is_error($code, $err_no, $err_status)

Looks at a response from the server and decides if it is an error
message and if that is the case sets some variables in the object and
returns true.

Calls C if the response does not look as a server response at
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,
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 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. 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. Be careful and I 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";

            $res = substr $r, 0, $tot_len,"";
            while (length($res) < $tot_len) {
                $r = $self->{socket}->getline;
                debug($r);
                $res .= substr $r, 0, ($tot_len-length($res)),"";
            }
            push @res, $res;
            if ($r eq "") {
                $r = $self->{socket}->getline;
            }
            $r =~ s/^ //;
        } else {
            ($f, $r) = split " ", $r, 2;
            push @res,$f;
        }
    }
    return @res;
}

sub send {
    my $s = shift;

    $s->{socket}->print(@_);
}

=item handle_asynch()

Is automaticly called when a asynchronous message is returned from
the server. Currently this routine does nothing.

=cut

sub handle_asynch {
    my $self = shift;
    my @call = @_;

    #debug "Asynch: @call";
}

## Server calls

=item logout

Log out from LysKOM, this call does not disconnect the session, which
means you can login again without the need of calling another new.

     $a->logout();

=cut

sub logout {
    my $self = shift;

    return $self->gen_call_boolean(1);
}

=item change_conference ($conference)

Changes current conference of the session.

    $a->change_conference(4711);

=cut

sub change_conference {
    my $self = shift;
    my $conference = shift;

    return $self->gen_call_boolean(2,$conference);
}

=item change_name ($conference, $new_name)

Change name of the person or conference numbered $conference to $new_name.

    $a->change_name(46, 'Sweden (the strange land)');

=cut

sub change_name {
    my $self = shift;
    my $conference = shift;
    my $new_name = shift;

    return $self->gen_call_boolean(3, $conference, holl($new_name));
}

=item change_what_i_am_doing ($what_am_i_doing)

Tells the server what the logged-in user is doing. You are encouraged to use
this call creatively.

    $a->change_what_i_am_doing('Eating smorgasbord');

=cut

sub change_what_i_am_doing {
    my $self = shift;
    my $what_am_i_doing = shift;

    return $self->gen_call_boolean(4, holl($what_am_i_doing));
}

=item set_priv_bits($person, admin => 1, wheel => 1, statistic => 1, create_pers => 1, create_conf => 1, change_name => 1)

Set the privbits on person $person. User can specify one or more
privileges by name. Privs not specified default to false.

=cut

sub set_priv_bits {
    my $self = shift;
    my $person = shift;
    my %priv = (
                wheel => 0,
                admin => 0,
                statistic => 0,
                create_pers => 0,
                create_conf => 0,
                change_name => 0
               );
    my %arg = @_;

    foreach (keys %arg) {
        $priv{$_} = $arg{$_}
    }

    my $pstring = join "", map {$_?"1":"0"}
      (
       $priv{wheel},
       $priv{admin},
       $priv{statistic},
       $priv{create_pers},
       $priv{create_conf},
       $priv{change_name},
       0, 0, 0, 0, 0, 0, 0, 0, 0, 0
      );

    return $self->gen_call_boolean(7, $person, $pstring);
}

=item set_passwd(person => $person, old_pwd => $old, new_pwd => $new)

Changes the password of $person to $new_pwd.

$old is the password of the currently logged in person. All three
arguments are required.

=cut

sub set_passwd {
    my $self = shift;
    my %arg = @_;

    return $self->gen_call_boolean(8,
                                   $arg{person},
                                   holl($arg{old_pwd}),
                                   holl($arg{new_pwd})
                                  );
}

=item delete_conf($conf)

Deletes the conference with number $conf. If $conf is a mailbox,
the corresponding user is also deleted.

    $a->delete_conf(42);

=cut

sub delete_conf {
    my $self = shift;
    my $conf = shift;

    return $self->gen_call_boolean(11, $conf);
}

=item sub_member($conf_no, $pers_no)

Removes the person $pers_no from the membership list of
conference $conf_no.

    $a->sub_member(42,4711);

=cut

sub sub_member {
    my $self = shift;
    my $conf_no = shift;
    my $pers_no = shift;

    return $self->gen_call_boolean(15, $conf_no, $pers_no);
}

=item set_presentation($conf_no, $text_no)

Set the text $text_no as presentation for $conf_no.
To remove a presentation, use $text_no = 0

    $a->set_presentation(42,4711);

=cut

sub set_presentation {
    my $self = shift;
    my $conf_no = shift;
    my $text_no = shift;

    return $self->gen_call_boolean(16, $conf_no, $text_no);
}

=item set_etc_motd($conf_no, $text_no)

Sets the messages of the day on the conference or person $conf_no to
$text_no and removes the old message.

    $a->set_etc_motd(6,1);

=cut

sub set_etc_motd {
    my $self = shift;
    my $conf_no = shift;
    my $text_no = shift;

    return $self->gen_call_boolean(17, $conf_no, $text_no);
}


=item set_supervisor($conf_no, $admin)

Set person/conference $admin as supervisor for the
conference $conf_no

=cut

sub set_supervisor {
    my $self = shift;
    my $conf_no = shift;
    my $admin = shift;

    return $self->gen_call_boolean(18, $conf_no, $admin);
}

=item set_permitted_submitters($conf_no, $perm_sub)

Set $perm_sub as permitted subscribers for $conf_no. If $perm_sub = 0,
all users are welcome to write in the conference.

=cut

sub set_permitted_submitters {
    my $self = shift;
    my $conf_no = shift;
    my $perm_sub = shift;

    return $self->gen_call_boolean(19, $conf_no, $perm_sub);
}

=item set_super_conf($conf_no, $super_conf)

Sets the conference $super_conf as super conference for $conf_no

=cut

sub set_super_conf {
    my $self = shift;
    my $conf_no = shift;
    my $super_conf = shift;

    return $self->gen_call_boolean(20, $conf_no, $super_conf);
}

=item set_garb_nice($conf_no, $nice)

Sets the garb time for the conference $conf_no to $nice days.

    $a->set_garb_nice(42,7);

=cut

sub set_garb_nice {
    my $self = shift;
    my $conf_no = shift;
    my $nice = shift;

    return $self->gen_call_boolean(22, $conf_no, $nice);
}

=item get_text(text => $text, start_char => $start, end_char => $end)

Get a text from the server, the first argument, C, is the global
text number for the text to get. The retrival stars at position
C (the first character in the text is numbered 0) and ends
at position C.

Default is 0 for C and 2147483647 for C. This
means that a complete message is fetched, unless otherwise stated.

Also note that you can get an entire text, pre-split into subject and
body, via the object returned from the C method.

To get the first 100 chars from text 4711:

    my $text = $a->get_text(text => 4711, start_char => 0, end_char => 100);

=cut

sub get_text {
    my $self = shift;
    my %arg = @_;
    my @res;

    unless ($arg{text}) {
        croak "get_text() called with no text number argument";
    }
    $arg{start_char} = 0 unless $arg{start_char};
    $arg{end_char} = 2147483647 unless $arg{end_char};

    return $self->gen_call_scalar(25, $arg{text}, $arg{start_char}, $arg{end_char});
}

=item delete_text($text)

Deletes the text with the global text number $text from the database.

=cut

sub delete_text {
    my $self = shift;
    my $text = shift;

    return $self->gen_call_boolean(29, $text);
}

=item add_recipient(text_no => $text, conf_no => $conf, type => $type)

Add a recipient to a text. $type can be one of "recpt", "cc" or "bcc".
If not given (or if set to something other than one of those three
strings) it defaults to "recpt". C and C are
required.

=cut

sub add_recipient {
    my $self = shift;
    my %arg = @_;

    if ($arg{type} eq "bcc") {
        $arg{type} = 15
    } elsif ($arg{type} eq "cc") {
        $arg{type} = 1
    } else {
        $arg{type} = 0
    }
    return $self->gen_call_boolean(30,$arg{text_no},$arg{conf_no},$arg{type});
}

=item sub_recipient($text_no, $conf_no)

Remove a recipient from a text.

=cut

sub sub_recipient {
    my $self = shift;
    my $textno = shift;
    my $confno = shift;

    return $self->gen_call_boolean(31, $textno, $confno);
}

=item add_comment($text_no, $comment_to)

Add a comment link between the text comment-to and the text text-no
(text-no becomes a comment to the text comment-to). This call is used
to add comment links after a text has been created.

=cut

sub add_comment {
    my $self = shift;
    my $textno = shift;
    my $commentto = shift;

    return $self->gen_call_boolean(32, $textno, $commentto);
}

=item get_time

Ask the server for the current time. Returns a L object.

=cut

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

    @res = $self->server_call(35);
    if ($self->is_error(@res)) {
        return undef;
    } else {
        shift @res;    # Remove return code
        return Net::Lyskom::Time->new_from_stream(\@res);
    }
}

=item set_unread($conf_no, $no_of_unread)

Only read the $no_of_unread texts in the conference $conf_no.

=cut

sub set_unread {
    my $self = shift;
    my $conf_no = shift;
    my $no_of_unread = shift;

    return $self->gen_call_boolean(40, $conf_no, $no_of_unread);
}

=item set_motd_of_lyskom($text_no)

Sets the login message of LysKOM, can only be executed by a privileged person,
with the proper privileges enabled.

=cut

sub set_motd_of_lyskom {
    my $self = shift;
    my $text_no = shift;

    return $self->gen_call_boolean(41, $text_no);
}

=item enable($level)

Sets the security level for the current session to $level.

=cut

sub enable {
    my $self = shift;
    my $level = shift;

    return $self->gen_call_boolean(42, $level);
}

=item sync_kom

This call instructs the LysKOM server to make sure the permanent copy of its
databas is current. This call is privileged in most implementations.

    $a->sync_kom();

=cut

sub sync_kom {
    my $self = shift;

    return $self->gen_call_boolean(43);
}

=item shutdown_kom($exit_val)

Instructs the server to save all data and shut down. The variable $exit_val is
currently not used.

=cut

sub shutdown_kom {
    my $self = shift;
    my $exit_val = shift;

    return $self->gen_call_boolean(44, $exit_val);
}

=item get_person_stat($persno)

Get status for a person from the server. Returns a L
object.

=cut

sub get_person_stat {
    my $self = shift;
    my $persno = shift;
    my @res;

    @res = $self->server_call(49, $persno);
    if ($self->is_error(@res)) {
        return 0;
    } else {
        shift @res;             # Remove return code
        return Net::Lyskom::Person->new_from_stream(\@res);
    }
}

=item get_unread_confs($pers_no)

Get a list of conference numbers in which the person $pers_no
may have unread texts.

    my @unread_confs = $a->get_unread_confs(7);

=cut

sub get_unread_confs {
    my $self = shift;
    my $pers_no = shift;
    my @res;

    @res = $self->server_call(52, $pers_no);
    if ($self->is_error(@res)) {
        return ();
    } else {
        shift @res;    # Remove return code
        return parse_array_stream(sub{shift @{$_[0]}},\@res);
    }

}

=item send_message($recipient, $message)

Sends the message $message to all members of $recipient that is
currently logged in. If $recipient is 0, the message is sent to all
sessions that are logged in.

=cut

sub send_message {
    my $self = shift;
    my $recipient = shift;
    my $message = shift;

    return $self->gen_call_boolean(53, $recipient, holl($message));
}

=item who_am_i

Get the session number of the current session.

    my $session_number = $a->who_am_i();

=cut

sub who_am_i {
    my $self = shift;

    return $self->gen_call_scalar(56);
}

=item get_last_text($time)

$time should be given a as a unix time_t (that is, as the number of
seconds since 00:00:00 01 Jan 1970 UCT).

=cut

sub get_last_text {
    my $self = shift;
    my $time = shift;

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
                                                localtime($time);
    return $self->gen_call_scalar(58,$sec,$min,$hour,$mday,$mon,$year,$wday,
                                  $yday,($isdst?1:0));
}

=item find_next_text_no($text_no)

Returns the global number of the readable text that follows the text
C<$text_no>.

=cut

sub find_next_text_no {
    my $self = shift;
    my $start = shift;

    return $self->gen_call_scalar(60, $start);
}

=item find_previous_text_no($text_no)

Returns the global number of the readable text that precedes the text
C<$text_no>.

=cut

sub find_previous_text_no {
    my $self = shift;
    my $start = shift;

    return $self->gen_call_scalar(61, $start);
}

=item login(pers_no => $pers, password => $pwd, invisible => $invis)

Log in to LysKOM. $persno is the number of the person which is to be
logged in. $pwd is the password of that person. If $invis is true, a
secret login is done (the session is not visible in who-is-on-lists et al.)

=cut

sub login {
    my $self = shift;
    my %arg = @_;

    return $self->gen_call_boolean(62,
                                   $arg{pers_no},
                                   holl($arg{password}),
                                   ($arg{invisible})?1:0);
}

=item set_client_version($client_name, $client_version)

Tells the server that this is the software $client_name and the
version $client_version.

    $a->set_client_version('My-cool-software','0.001 beta');

=cut

sub set_client_version {
    my $self = shift;
    my $client_name = shift;
    my $client_version = shift;

    return $self->gen_call_boolean(69, holl($client_name), holl($client_version));
}

=item get_client_name($session)

Ask the server for the name of the client software logged in with
session number $session.

=cut

sub get_client_name {
    my $self = shift;
    my $session = shift;

    return $self->gen_call_scalar(70, $session);
}

=item get_client_version($session)

Ask the server for the version of the client software logged in with
session number $session.

=cut

sub get_client_version {
    my $self = shift;
    my $session = shift;

    return $self->gen_call_scalar(71, $session);
}

=item get_version_info

Ask the server for the version info of the server software itself.
Returns a three-element array with the protocol version, server
software name and server software version.

=cut

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

    @res = $self->server_call(75);
    if ($self->is_error(@res)) {
        return ();
    } else {
        shift @res;    # Remove return code
        return @res[0..2];
    }
}

=item lookup_z_name(name => $name, want_pers => $wp, want_conf => $wc)

Lookup the name $name in the server, returns a list of all matching
conferences and/or persons, in the form of L
objects. The server database is searched with standard kom name
expansion.

If $want_pers is true, the server includes persons in the answer, if
$want_conf is true, conferences is included.

=cut

sub lookup_z_name {
    my $self = shift;
    my @res;
    my %arg = @_;

    @res = $self->server_call(76,
                              holl($arg{name}),
                              ($arg{want_pers}?1:0),
                              ($arg{want_conf}?1:0));
    if ($self->is_error(@res)) {
        return 0;
    } else {
        shift @res;             # Remove return code
        return parse_array_stream(sub{Net::Lyskom::ConfZInfo->new_from_stream(@_)},\@res)
    }
}

=item re_z_lookup(name => $name, want_pers => $wp, want_conf => $wc)

Regexp lookup of the name $name in the server, returns a list of all
matching conferences and/or persons, in the form of
L objects.

If $want_pers is true, the server includes persons in the answer, if
$want_conf is true, conferences is included.

=cut

sub re_z_lookup {
    my $self = shift;
    my @res;
    my %arg = @_;

    @res = $self->server_call(74,
                              holl($arg{name}),
                              ($arg{want_pers}?1:0),
                              ($arg{want_conf}?1:0));
    if ($self->is_error(@res)) {
        return 0;
    } else {
        shift @res;             # Remove return code
        return parse_array_stream(sub{Net::Lyskom::ConfZInfo->new_from_stream(@_)},\@res)
    }
}

=item user_active

Tells the server that the user is active.

=cut

sub user_active {
    my $self = shift;

    return $self->gen_call_boolean(82);
}

=item who_is_on_dynamic(want_visible => $wv, want_invisible => $wi, active_last => $al)

Returns a list of L objects. If
C is true, the visible users are included in the answer.
If C is true, invisible users are included.

Only the users active the last C seconds are included in
the answer. If C is zero, all users (who match the
visibility limits) are returned.

If not given, C defaults to true, C
defaults to false and C defaults to 0.

=cut

sub who_is_on_dynamic {
  my $self = shift;
  my %arg = @_;
  my @res;

  $arg{want_visible} = 1 unless $arg{want_visible};
  $arg{want_invisible} = 0 unless $arg{want_invisible};
  $arg{active_last} = 0 unless $arg{active_last};

  @res = $self->server_call(83,
                            ($arg{want_visible}?1:0),
                            ($arg{want_invisible}?1:0),
                            $arg{active_last});
  if ($self->is_error(@res)) {
    return 0;
  } else {
    shift @res;         # Remove return code
    return parse_array_stream(sub{Net::Lyskom::DynamicSession->new_from_stream(@_)},\@res)
  }
}

=item get_static_session_info($session_no)

Returns a C object holding details on the
specified session.

=cut

sub get_static_session_info {
    my $self = shift;
    my $session = shift;
    my @res;

    @res = $self->server_call(84, $session);
    if ($self->is_error(@res)) {
        return undef;
    } else {
        shift @res;
        return Net::Lyskom::StaticSession->new_from_stream(\@res);
    }
}


=item create_text(subject => "This is the subject", body => "This is the text body.", recpt => [6], cc_recpt => [437], bcc_recpt => [19, 23], comm_to => [4711], footn_to => [11147], aux => [@aux_obj_list])

Creates texts. Takes arguments as indicated in the synopsis just above
(that is, as a hash with zero or more of the given keys and strings or
arrayrefs as values, as appropriate). Any of the arguments can be left
out, but a text without at least one recipient is not very useful (nor
is one with neither subject nor body). The C argument should be a
reference to a list of L objects.

If the C list is not given, or given but not containing a
content-type item, an item with content type
C will be added. In this case, the
subject and body will also be converted from Perl's internal encoding
to UTF-8 before being sent out over the network.

Example:

  $k->create_text(
                  subject => "Test",
                  body => "Body",
                  recpt => [437],
                  aux => [
                          Net::Lyskom::AuxItem->new(
                                                    tag => content_type,
                                                    data => "text/plain"
                                                   )
                         ]);


=cut

sub create_text {
    my $self = shift;
    my %arg = @_;
    my @misc;
    my $misc_count = 0;
    my @aux;
    my $aux_count = 0;
    my @call;

    if (
        !$arg{aux}
        or scalar(grep {$_->tag == 1} @{$arg{aux}})==0
       ) {
        # No Aux-items, or at least no Content-Type
        push @{$arg{aux}}, Net::Lyskom::AuxItem->new(
                                                     tag => 'content_type',
                                                     data => 'text/x-kom-basic;charset=utf-8'
                                                    );
        $arg{subject} = encode_utf8($arg{subject});
        $arg{body} = encode_utf8($arg{body});
    }

    push @call, holl($arg{subject}."\n".$arg{body});
    if ($arg{recpt}) {
        foreach (@{$arg{recpt}}) {
            push @misc, 0, $_;
            $misc_count++;
        }
    }
    if ($arg{cc_recpt}) {
        foreach (@{$arg{cc_recpt}}) {
            push @misc, 1, $_;
            $misc_count++;
        }
    }
    if ($arg{bcc_recpt}) {
        foreach (@{$arg{bcc_recpt}}) {
            push @misc, 15, $_;
            $misc_count++;
        }
    }
    if ($arg{comm_to}) {
        foreach (@{$arg{comm_to}}) {
            push @misc, 2, $_;
            $misc_count++;
        }
    }
    if ($arg{footn_to}) {
        foreach (@{$arg{footn_to}}) {
            push @misc, 4, $_;
            $misc_count++;
        }
    }
    push @call, $misc_count, '{', @misc, '}';

    if ($arg{aux}) {
        foreach (@{$arg{aux}}) {
            push @aux, $_->to_server;
            $aux_count++;
        }
    }
    push @call, $aux_count, '{', @aux, '}';

    return $self->gen_call_scalar(86, @call);
}

=item get_text_stat($textno)

Fetch the status for a text from the server. Returns a
L object.

=cut

sub get_text_stat {
    my $self = shift;
    my $textno = shift;
    my @res;

    @res = $self->server_call(90, $textno);
    if ($self->is_error(@res)) {
        return 0;
    } else {
        shift @res;             # Remove return code
        return Net::Lyskom::TextStat->new_from_stream($self, $textno, \@res);
    }
}

=item get_conf_stat(@conf_no)

Get status for one or more conferences from the server. Returns a
L object in scalar context and a list of such
objects in list context.

=cut

sub get_conf_stat {
    my $self = shift;
    my @confno = @_;
    my @res;
    my @tmp;

    @tmp = $self->server_call([map {[91,$_]} @confno]);
    foreach (@tmp) {
        if ($self->is_error(@{$_})) {
            push @res,undef;
        } else {
            shift @{$_};                # Remove return code
            push @res, Net::Lyskom::Conference->new_from_stream($_);
        }
    }

    if (wantarray) {
        return @res;
    } else {
        return $res[0];
    }
}

=item modify_text_info( text => $text, delete => $delete_array_ref, add => $add_array_ref)

Add and/or delete aux items to/from a text. C should be a
reference to an array of aux_info order numbers to remove from the
text. C should be a reference to an array of
C objects to add to the text.

=cut

sub modify_text_info {
    my $self = shift;
    my %arg = @_;
    my @aux;
    my $aux_count = 0;
    my @del;
    my $del_count = 0;
    my @call;

    push @call, 92;
    push @call, $arg{text};

    if ($arg{delete}) {
        foreach (@{$arg{delete}}) {
            push @del, $_;
            $del_count++;
        }
    }
    push @call, $del_count, '{', @del, '}';

    if ($arg{add}) {
        foreach (@{$arg{add}}) {
            push @aux, $_->to_server;
            $aux_count++;
        }
    }
    push @call, $aux_count, '{', @aux, '}';

    return $self->gen_call_boolean(@call);
}

=item butt_ugly_fast_reply($text, $data)

Adds a fast-reply auxitem with the contents $data to the text $text.
Now implemented in terms of C, name retained for
backwards compatibility.

=cut

sub butt_ugly_fast_reply {      # Less ugly re-implementation
    my $self = shift;
    my ($text, $data) = @_;

    $self->modify_text_info(
                            text => $text,
                            add => [
                                    Net::Lyskom::AuxItem->new(
                                                              tag => "fast_reply",
                                                              data => $data
                                                             )
                                   ]
                           );
}

=item query_predefined_aux_items

Ask the server which predefined aux items that exists in the server.

=cut

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

    @res = $self->server_call(96);
    if ($self->is_error(@res)) {
        return ();
    } else {
        shift @res;
        return parse_array_stream(sub{shift @{$_[0]}},\@res);
    }
}

=item get_membership(person => $p, first => $f, no_of_confs => $no, want_read_texts => $w)

Get a membership list for C, in the form of a list of
L objects. Start at position C in the
membership list and get C conferences. If
C is true the server will also send information about
read texts in the conference.

=cut

sub get_membership {
    my $self = shift;
    my %arg = @_;
    my @res;

    $arg{first} = 0 unless $arg{first};
    $arg{no_of_confs} = 10 unless $arg{no_of_confs};
    $arg{want_read_texts} = 1 unless $arg{want_read_texts};

    @res = $self->server_call(99,
                              $arg{person},
                              $arg{first},
                              $arg{no_of_confs},
                              ($arg{want_read_texts})?1:0);
    if ($self->is_error(@res)) {
        return ();
    } else {
        shift @res;    # Remove return code
        return parse_array_stream(sub{Net::Lyskom::Membership->new_from_stream(@_)},\@res);
    }
}

=item local_to_global(conf => $conf, first => $first, number => $no)

Given a local text number and an integer smaller than 256, returns a
L object detailing the mapping between the
local and global text numbers of up to that many texts. All arguments
are required.

=cut

sub local_to_global {
    my $self = shift;
    my %arg = @_;
    my @res;

    @res = $self->server_call(103, $arg{conf}, $arg{first}, $arg{number});
    if ($self->is_error(@res)) {
        return ();
    } else {
        shift @res;             # Remove return code
        return Net::Lyskom::TextMapping->new_from_stream(\@res);
    }
}

=item map_created_texts(pers_no => $pers, first => $first, number => $no)

Given a local text number and an integer smaller than 256, returns a
L object detailing the mapping between texts
written by C and global text numbers of up to that many
texts. All arguments are required.

=cut

sub map_created_texts {
    my $self = shift;
    my %arg = @_;
    my @res;

    @res = $self->server_call(104, $arg{pers_no}, $arg{first}, $arg{number});
    if ($self->is_error(@res)) {
        return ();
    } else {
        shift @res;             # Remove return code
        return Net::Lyskom::TextMapping->new_from_stream(\@res);
    }
}

=item set_membership_type(pers => $p, conf => $c, invitation => $i, passive => $pa, secret => $s)

Set the membership flags for user C in conference C.

=cut

sub set_membership_type {
    my $self = shift;
    my %arg = @_;
    my $str = sprintf "%s%s%s00000",
      ($arg{invitation}?"1":"0"),
        ($arg{passive}?"1":"0"),
          ($arg{secret}?"1":"0");

    return $self->gen_call_boolean(102, $arg{pers}, $arg{conf}, $str);
}

=item get_members(conf => $conf_no, first => $first_index, $count => $no_of_members)

=cut

sub get_members {
    my $self = shift;
    my %arg = @_;
    my @res;

    @res = $self->server_call(101, $arg{conf}, $arg{first}, $arg{count});
    if ($self->is_error(@res)) {
        return undef
    } else {
        shift @res;
        return parse_array_stream(sub{Net::Lyskom::Member->new_from_stream(@_)}, \@res)
    }
}

=item add_member(conf => $conf, pers => $pers_no, priority => $prio, where => $where, invitation => $invite, passive => $pass, secret => $secret)

Add person number C as a member of conference number C, at
priority C and at position C. C,
C and C specify the membership type.

=cut

sub add_member {
    my $self = shift;
    my %arg = @_;

    my $type = sprintf "%s%s%s00000",
      ($arg{invitation}?"1":"0"),
        ($arg{passive}?"1":"0"),
          ($arg{secret}?"1":"0");
    return $self->gen_call_boolean(100, $arg{conf}, $arg{pers},
                                   $arg{priority}, $arg{where}, $type);
}

=item query_read_texts($pers, $conf)

Return information on which texts person $pers has read in conference
$conf. Returns an C object.

=cut

sub query_read_texts {
    my $self = shift;
    my ($pers, $conf) = @_;

    my @res = $self->server_call(98,$pers,$conf);
    if ($self->is_error(@res)) {
        return undef
    } else {
        shift @res;
        return Net::Lyskom::Membership->new_from_stream(\@res)
    }
}

=item set_expire($conf, $expire)

Set the garb-nice value for conference C<$conf> to C<$expire>.

=cut

sub set_expire {
    my $self = shift;
    my ($conf, $expire) = @_;

    return $self->gen_call_boolean(97, $conf, $expire);
}

=item mark_text($text, $mark)

Sets a mark of (numerical) type C<$mark> on text number C<$text>.

=cut

sub mark_text {
    my $self = shift;
    my ($text, $mark) = @_;

    return $self->gen_call_boolean(72, $text, $mark);
}

=item get_marks

Returns an array of (text_no, mark_type) pairs, showing the texts the
current user has marked.

=cut

sub get_marks {
    my $self = shift;

    my @res = $self->server_call(23);
    if ($self->is_error(@res)) {
        return undef;
    } else {
        shift @res;
        return parse_array_stream(sub{[splice @{$_[0]},0,2]},\@res);
    }
}

=item unmark_text($text)

Remove any marks on the specified text.

=cut

sub unmark_text {
    my $self = shift;
    my $text = shift;

    return $self->gen_call_boolean(73, $text);
}

=item set_last_read($conf,$local_no)

Tell the server that the current user has read everything up to local
number C<$local_no> in conference number C<$conf>.

=cut

sub set_last_read {
    my $self = shift;
    my ($conf, $local_no) = @_;

    return $self->gen_call_boolean(77, $conf, $local_no)
}

=item set_conf_type(conf => $conf, rd_prot => $rp, original => $orig, secret => $sec, letterbox => $letter, allow_anonymous => $anon, forbid_secret => $nosecret)

Set the type of conference C. C is required, the rest
default to false if not specified.

=cut

sub set_conf_type {
    my $self = shift;
    my %arg = @_;

    die unless exists($arg{conf});
    $arg{rd_prot}         = 0 unless $arg{rd_prot};
    $arg{original}        = 0 unless $arg{original};
    $arg{secret}          = 0 unless $arg{secret};
    $arg{letterbox}       = 0 unless $arg{letterbox};
    $arg{allow_anonymous} = 0 unless $arg{allow_anonymous};
    $arg{forbid_secret}   = 0 unless $arg{forbid_secret};

    my $type = sprintf "%s%s%s%s%s%s000",
      ($arg{rd_prot}?"1":"0"),
        ($arg{original}?"1":"0"),
          ($arg{secret}?"1":"0"),
            ($arg{letterbox}?"1":"0"),
              ($arg{allow_anonymous}?"1":"0"),
                ($arg{forbid_secret}?"1":"0");
    return $self->gen_call_boolean(21, $arg{conf}, $type);

}

=item mark_as_read($conf, @texts)

Marks the texts specified by the local text numbers in C<@texts> as
read in the conference C<$conf>.

=cut

sub mark_as_read {
    my $self = shift;
    my $conf = shift;
    my @texts = @_;

    return $self->gen_call_boolean(27, $conf, scalar @texts, '{', @texts, '}');
}

=item sub_comment($text, $comment)

Removes C<$text> from C<$comment>s list of comments.

=cut

sub sub_comment {
    my $self = shift;
    my ($text, $comment) = @_;

    return $self->gen_call_boolean(33, $text, $comment);
}

=item add_footnote($text, $footnote_to)

Makes text number C<$text> be a footnote to text number C<$footnote_to>.

=cut

sub add_footnote {
    my $self = shift;
    my ($text, $footnote_to) = @_;

    return $self->gen_call_boolean(37, $text, $footnote_to);
}

=item sub_footnote($text, $footnote_to)

Makes text number C<$text> not be a footnote to text number C<$footnote_to>.

=cut

sub sub_footnote {
    my $self = shift;
    my ($text, $footnote_to) = @_;

    return $self->gen_call_boolean(38, $text, $footnote_to);
}

=item disconnect($session)

Make session number C<$session> lose its connection with the server,
given sufficient privilege. Session zero is always interpreted as the
current session.

=cut

sub disconnect {
    my $self = shift;
    my $session = shift;

    return $self->gen_call_boolean(55, $session);
}

=item set_user_area($pers_no, $text_no)

Make text number C<$text_no> be the user area for user number C<$pers_no>.

=cut

sub set_user_area {
    my $self = shift;
    my ($pers, $text) = @_;

    return $self->gen_call_boolean(57, $pers, $text);
}

=item get_uconf_stat($conf)

Get a subset of all information for conference number C<$conf>.
Returns a L object with only some fields
filled.

=cut

sub get_uconf_stat {
    my $self = shift;
    my @confno = @_;
    my @res;
    my @tmp;

    @tmp = $self->server_call([map {[78,$_]} @confno]);
    foreach (@tmp) {
        if ($self->is_error(@{$_})) {
            push @res,undef;
        } else {
            shift @{$_};                # Remove return code
            push @res, Net::Lyskom::Conference->new_from_ustream($_);
        }
    }

    if (wantarray) {
        return @res;
    } else {
        return $res[0];
    }
}

=item set_info(conf_pres_conf => $cpc, pers_pres_conf => $ppc, motd_conf => $mc, kom_news_conf => $knc, motd_of_lyskom => $mol)

Sets server information.

=cut

sub set_info {
    my $self = shift;
    my %arg = @_;

    $arg{conf_pres_conf} = 0 unless $arg{conf_pres_conf};
    $arg{pers_pres_conf} = 0 unless $arg{pers_pres_conf};
    $arg{motd_conf} = 0 unless $arg{motd_conf};
    $arg{kom_news_conf} = 0 unless $arg{kom_news_conf};
    $arg{motd_of_lyskom} = 0 unless $arg{motd_of_lyskom};

    return $self->gen_call_boolean(79, 0, # The zero must be there, see prot-a
                                   $arg{conf_pres_conf},
                                   $arg{pers_pres_conf},
                                   $arg{motd_conf},
                                   $arg{kom_news_conf},
                                   $arg{motd_of_lyskom}
                                  );
}

=item accept_async(@call_numbers)

Tell the server to send the asynchronous calls with the numbers
specified in C<@call_numbers>.

=cut

sub accept_async {
    my $self = shift;

    return $self->gen_call_boolean(80, scalar @_, '{', @_, '}');
}

=item query_async

Ask server which asynchronous calls are turned on for this session.
Returns a list of integers.

=cut

sub query_async {
    my $self = shift;

    my @res = $self->server_call(81);
    if ($self->is_error(@res)) {
        return undef
    } else {
        return parse_array_stream(sub{shift @{$_[0]}},\@res);
    }
}

=item get_collate_table

Get the active collate table from the server.

=cut

sub get_collate_table {
    my $self = shift;

    return $self->gen_call_scalar(85);
}

=item create_anonymous_text(...arguments...)

Exactly the same as C, except that it uses the call to
create the text anonymously.

=cut

sub create_anonymous_text {
    my $self = shift;
    my %arg = @_;
    my @misc;
    my $misc_count = 0;
    my @aux;
    my $aux_count = 0;
    my @call;

    push @call, holl($arg{subject}."\n".$arg{body});
    if ($arg{recpt}) {
        foreach (@{$arg{recpt}}) {
            push @misc, 0, $_;
            $misc_count++;
        }
    }
    if ($arg{cc_recpt}) {
        foreach (@{$arg{cc_recpt}}) {
            push @misc, 1, $_;
            $misc_count++;
        }
    }
    if ($arg{bcc_recpt}) {
        foreach (@{$arg{bcc_recpt}}) {
            push @misc, 15, $_;
            $misc_count++;
        }
    }
    if ($arg{comm_to}) {
        foreach (@{$arg{comm_to}}) {
            push @misc, 2, $_;
            $misc_count++;
        }
    }
    if ($arg{footn_to}) {
        foreach (@{$arg{footn_to}}) {
            push @misc, 4, $_;
            $misc_count++;
        }
    }
    push @call, $misc_count, '{', @misc, '}';

    if ($arg{aux}) {
        foreach (@{$arg{aux}}) {
            push @aux, $_->to_server;
            $aux_count++;
        }
    }
    push @call, $aux_count, '{', @aux, '}';

    return $self->gen_call_scalar(87, @call);
}

=item create_conf(name => $name, rd_prot => $rp, original => $orig, secret => $sec, letterbox => $letter, allow_anonymous => $anon, forbid_secret => $nosecret, aux => $aux_array_ref)

Create a conference.

=cut

sub create_conf {
    my $self = shift;
    my %arg = @_;

    croak "Tried to create conference with no name" unless $arg{name};
    $arg{rd_prot}         = 0 unless $arg{rd_prot};
    $arg{original}        = 0 unless $arg{original};
    $arg{secret}          = 0 unless $arg{secret};
    $arg{letterbox}       = 0 unless $arg{letterbox};
    $arg{allow_anonymous} = 0 unless $arg{allow_anonymous};
    $arg{forbid_secret}   = 0 unless $arg{forbid_secret};
    $arg{aux} = [] unless $arg{aux};

    my $type = sprintf "%s%s%s%s%s%s000",
      ($arg{rd_prot}?"1":"0"),
        ($arg{original}?"1":"0"),
          ($arg{secret}?"1":"0"),
            ($arg{letterbox}?"1":"0"),
              ($arg{allow_anonymous}?"1":"0"),
                ($arg{forbid_secret}?"1":"0");

    return $self->gen_call_scalar(88,
                                  holl($arg{name}),
                                  $type,
                                  scalar @{$arg{aux}},
                                  '{',
                                  map ({$_ and $_->to_server} @{$arg{aux}}),
                                  '}'
                                 );
}

=item create_person(name => $name, password => $pwd, unread_is_secret => $uis, aux => $aux_array_ref)

Create a person.

=cut

sub create_person {
    my $self = shift;
    my %arg = @_;

    croak "Tried to create person without name" unless $arg{name};
    croak "Tried to create person without password" unless $arg{password};
    $arg{unread_is_secret} = 0 unless $arg{unread_is_secret};
    $arg{aux} = [] unless $arg{aux};
    my $type = sprintf "%s0000000", ($arg{unread_is_secret}?"1":"0");

    return $self->gen_call_scalar(89,
                                  holl($arg{name}),
                                  holl($arg{password}),
                                  $type,
                                  scalar @{$arg{aux}},
                                  '{',
                                  map ({$_ and $_->to_server} @{$arg{aux}}),
                                  '}'
                                 );
}

=item modify_conf_info(conf => $conf, delete => $del_array_ref, add => $add_array_ref)

Delete and/or add aux items to a conference. C<$del_array_ref> is a
reference to an array of aux item numbers to delete. C<$add_array_ref>
is a reference to an array of aux items to add.

=cut

sub modify_conf_info {
    my $self = shift;
    my %arg = @_;

    $arg{delete} = [] unless $arg{delete};
    $arg{add} = [] unless $arg{add};

    return undef unless $arg{conf};
    return $self->gen_call_boolean(93, $arg{conf},
                                   scalar @{$arg{delete}},
                                   '{',@{$arg{delete}},'}',
                                   scalar @{$arg{add}},
                                   '{', map {$_->to_server} @{$arg{add}},'}'
                                   );
}

=item modify_system_info(delete => $del_array_ref, add => $add_array_ref)

Add and/or delete aux items for the server itself. Similar arguments
as above.

=cut

sub modify_system_info {
    my $self = shift;
    my %arg = @_;

    $arg{delete} = [] unless $arg{delete};
    $arg{add} = [] unless $arg{add};

    return $self->gen_call_boolean(95,
                                   scalar @{$arg{delete}},
                                   '{',@{$arg{delete}},'}',
                                   scalar @{$arg{add}},
                                   '{', map {$_->to_server} @{$arg{add}},'}'
                                   );

}

=item set_keep_commented($conf, $keep)

Set the C field for conference number C<$conf> to C<$keep>.

=cut

sub set_keep_commented {
    my $self = shift;
    my ($conf, $keep) = @_;

    return $self->gen_call_boolean(105, $conf, $keep);
}

=item set_pers_flags(person => $pers, unread_is_secret => $uis)

Set the personal flags for person number C. At the moment
there is only one such flag, but this method uses the many-args
calling convention for ease of future expansion.

=cut

sub set_pers_flags {
    my $self = shift;
    my %arg = @_;
    my $type = sprintf "%s0000000", ($arg{unread_is_secret}?"1":"0");

    return $self->gen_call_boolean(106, $arg{person}, $type);
}

=item get_info

Get the server info. Returns a C object.

=cut

sub get_info {
    my $self = shift;

    my @res = $self->server_call(94);
    if ($self->is_error(@res)) {
        return undef;
    } else {
        return Net::Lyskom::Info->new_from_stream(\@res);
    }
}

=back

=cut

# Return something true
1;

__END__