libnet-hotline-perl 0.83-2 / usr / share / perl5 / Net / Hotline / Client.pm

package Net::Hotline::Client;

## Copyright(c) 1998-2002 by John C. Siracusa.  All rights reserved.  This
## program is free software; you can redistribute it and/or modify it under
## the same terms as Perl itself.

use strict;

use vars qw(@ISA $VERSION $DEBUG);

use Carp;
use IO::File;
use IO::Socket;
use Net::Hotline::User;
use Net::Hotline::Task;
use Net::Hotline::PrivateChat;
use Net::Hotline::FileListItem;
use Net::Hotline::FileInfoItem;
use Net::Hotline::TrackerListItem;
use Net::Hotline::Protocol::Packet;
use Net::Hotline::Protocol::Header;
use Net::Hotline::Shared qw(:all);
use Net::Hotline::Constants qw(:all);

if($^O eq 'MacOS') # "#ifdef", where have you gone...
{
  require Mac::MoreFiles;
  require Mac::Files;
}

use AutoLoader 'AUTOLOAD';

#
# Class attributes
#

$VERSION = '0.83';
$DEBUG   = 0;

# CRC perl code lifted from Convert::BinHex by Eryq (eryq@enteract.com)
# An array useful for CRC calculations that use 0x1021 as the "seed":
my(@CRC_MAGIC) = (
    0x0000, 0x1021, 0x2042, 0x3063, 0x4084, 0x50A5, 0x60C6, 0x70E7,
    0x8108, 0x9129, 0xA14A, 0xB16B, 0xC18C, 0xD1AD, 0xE1CE, 0xF1EF,
    0x1231, 0x0210, 0x3273, 0x2252, 0x52B5, 0x4294, 0x72F7, 0x62D6,
    0x9339, 0x8318, 0xB37B, 0xA35A, 0xD3BD, 0xC39C, 0xF3FF, 0xE3DE,
    0x2462, 0x3443, 0x0420, 0x1401, 0x64E6, 0x74C7, 0x44A4, 0x5485,
    0xA56A, 0xB54B, 0x8528, 0x9509, 0xE5EE, 0xF5CF, 0xC5AC, 0xD58D,
    0x3653, 0x2672, 0x1611, 0x0630, 0x76D7, 0x66F6, 0x5695, 0x46B4,
    0xB75B, 0xA77A, 0x9719, 0x8738, 0xF7DF, 0xE7FE, 0xD79D, 0xC7BC,
    0x48C4, 0x58E5, 0x6886, 0x78A7, 0x0840, 0x1861, 0x2802, 0x3823,
    0xC9CC, 0xD9ED, 0xE98E, 0xF9AF, 0x8948, 0x9969, 0xA90A, 0xB92B,
    0x5AF5, 0x4AD4, 0x7AB7, 0x6A96, 0x1A71, 0x0A50, 0x3A33, 0x2A12,
    0xDBFD, 0xCBDC, 0xFBBF, 0xEB9E, 0x9B79, 0x8B58, 0xBB3B, 0xAB1A,
    0x6CA6, 0x7C87, 0x4CE4, 0x5CC5, 0x2C22, 0x3C03, 0x0C60, 0x1C41,
    0xEDAE, 0xFD8F, 0xCDEC, 0xDDCD, 0xAD2A, 0xBD0B, 0x8D68, 0x9D49,
    0x7E97, 0x6EB6, 0x5ED5, 0x4EF4, 0x3E13, 0x2E32, 0x1E51, 0x0E70,
    0xFF9F, 0xEFBE, 0xDFDD, 0xCFFC, 0xBF1B, 0xAF3A, 0x9F59, 0x8F78,
    0x9188, 0x81A9, 0xB1CA, 0xA1EB, 0xD10C, 0xC12D, 0xF14E, 0xE16F,
    0x1080, 0x00A1, 0x30C2, 0x20E3, 0x5004, 0x4025, 0x7046, 0x6067,
    0x83B9, 0x9398, 0xA3FB, 0xB3DA, 0xC33D, 0xD31C, 0xE37F, 0xF35E,
    0x02B1, 0x1290, 0x22F3, 0x32D2, 0x4235, 0x5214, 0x6277, 0x7256,
    0xB5EA, 0xA5CB, 0x95A8, 0x8589, 0xF56E, 0xE54F, 0xD52C, 0xC50D,
    0x34E2, 0x24C3, 0x14A0, 0x0481, 0x7466, 0x6447, 0x5424, 0x4405,
    0xA7DB, 0xB7FA, 0x8799, 0x97B8, 0xE75F, 0xF77E, 0xC71D, 0xD73C,
    0x26D3, 0x36F2, 0x0691, 0x16B0, 0x6657, 0x7676, 0x4615, 0x5634,
    0xD94C, 0xC96D, 0xF90E, 0xE92F, 0x99C8, 0x89E9, 0xB98A, 0xA9AB,
    0x5844, 0x4865, 0x7806, 0x6827, 0x18C0, 0x08E1, 0x3882, 0x28A3,
    0xCB7D, 0xDB5C, 0xEB3F, 0xFB1E, 0x8BF9, 0x9BD8, 0xABBB, 0xBB9A,
    0x4A75, 0x5A54, 0x6A37, 0x7A16, 0x0AF1, 0x1AD0, 0x2AB3, 0x3A92,
    0xFD2E, 0xED0F, 0xDD6C, 0xCD4D, 0xBDAA, 0xAD8B, 0x9DE8, 0x8DC9,
    0x7C26, 0x6C07, 0x5C64, 0x4C45, 0x3CA2, 0x2C83, 0x1CE0, 0x0CC1,
    0xEF1F, 0xFF3E, 0xCF5D, 0xDF7C, 0xAF9B, 0xBFBA, 0x8FD9, 0x9FF8,
    0x6E17, 0x7E36, 0x4E55, 0x5E74, 0x2E93, 0x3EB2, 0x0ED1, 0x1EF0
);

1;

#
# Non-autoloaded object methods
#

sub new
{
  my($class) = shift;

  my($self) =
  {
    'NICK'         => undef,
    'LOGIN'        => undef,
    'COLOR'        => undef,
    'SERVER_PORT'  => undef,
    'SERVER_ADDR'  => undef,
    'TRACKER_ADDR' => undef,

    'SOCKET'       => undef,
    'BLOCKING'     => 1,
    'SERVER'       => undef,
    'SEQNUM'       => 1,

    'USER_LIST'    => undef,
    'NEWS'         => undef,
    'FILES'        => undef,
    'AGREEMENT'    => undef,
    'PCHATS'       => undef,
    'TASKS'        => undef,

    'FILE_INFO'    => undef,

    'HANDLERS'  =>
    {
      'AGREEMENT'     => undef,
      'BAN'           => undef,
      'CHAT'          => undef,
      'CHAT_ACTION'   => undef,
      'COLOR'         => undef,
      'EVENT'         => undef,
      'FILE_DELETE'   => undef,
      'FILE_GET'      => undef,
      'FILE_GET_INFO' => undef,
      'FILE_LIST'     => undef,
      'FILE_MKDIR'    => undef,
      'FILE_MOVE'     => undef,
      'FILE_SET_INFO' => undef,
      'ICON'          => undef,
      'JOIN'          => undef,
      'KICK'          => undef,
      'LEAVE'         => undef,
      'LOGIN'         => undef,
      'MSG'           => undef,
      'NEWS'          => undef,
      'NEWS_POST'     => undef,
      'NEWS_POSTED'   => undef,
      'NICK'          => undef,
      'PCHAT_ACCEPT'  => undef,
      'PCHAT_CREATE'  => undef,
      'PCHAT_INVITE'  => undef,
      'PCHAT_JOIN'    => undef,
      'PCHAT_LEAVE'   => undef,
      'PCHAT_SUBJECT' => undef,
      'QUIT'          => undef,
      'SEND_MSG'      => undef,
      'SERVER_MSG'    => undef,
      'TASK_ERROR'    => undef,
      'USER_GETINFO'  => undef,
      'USER_LIST'     => undef
    },

    'BLOCKING_TASKS'         => undef,
    'DEFAULT_HANDLERS'       => undef,
    'HANDLERS_WHEN_BLOCKING' => undef,

    'LOGGED_IN'       => undef,

    'EVENT_TIMING'    => 1,
    'CONNECT_TIMEOUT' => 15,
    'PATH_SEPARATOR'  => HTLC_PATH_SEPARATOR,
    'HTXF_BUFSIZE'    => HTXF_BUFSIZE,

    'DOWNLOADS_DIR'   => undef,
    'DATA_FORK_EXT'   => '.data',
    'RSRC_FORK_EXT'   => '.rsrc',

    'LAST_ACTIVITY'   => time(),
    'LAST_ERROR'      => undef,
    'MACOS'           => ($^O eq 'MacOS') ? 1 : 0
  };

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

sub agreement { $_[0]->{'AGREEMENT'} }

sub blocking
{
  my($self, $blocking) = @_;

  return $self->{'BLOCKING'}  unless(@_ == 2);

  if(ref($self->{'SERVER'}) && $self->{'SERVER'}->opened())
  {
    _set_blocking($self->{'SERVER'}, $blocking);
  }

  $self->{'BLOCKING'} = (($blocking) ? 1 : 0);
  return $self->{'BLOCKING'};
}

sub blocking_tasks
{
  my($self, $arg) = @_;
  $self->{'BLOCKING_TASKS'} = ($arg) ? 1 : 0  if(@_ == 2);
  return $self->{'BLOCKING_TASKS'};
}

sub connect_timeout
{
  my($self, $secs) = @_;
  $self->{'CONNECT_TIMEOUT'} = $secs  if($secs =~ /^\d+$/);
  return $self->{'CONNECT_TIMEOUT'};
}

sub default_handlers
{
  my($self, $arg) = @_;
  $self->{'DEFAULT_HANDLERS'} = ($arg) ? 1 : 0  if(@_ == 2);
  return $self->{'DEFAULT_HANDLERS'};
}

sub downloads_dir
{
  my($self, $dir) = @_;
  $self->{'DOWNLOADS_DIR'} = $dir  if(-d $dir);
  return $self->{'DOWNLOADS_DIR'};
}

sub data_fork_extension
{
  my($self, $ext) = @_;
  croak("The data fork extension may not be the same as the resource fork extension!")
    if($ext eq $self->{'DATA_FORK_EXT'}); 
  $self->{'DATA_FORK_EXT'} = $ext  if(defined($ext));
  return $self->{'DATA_FORK_EXT'};
}

sub event_timing
{
  my($self, $secs) = @_;

  if(defined($secs))
  {
    croak qw(Bad argument to event_timing() - "$secs")  if($secs =~ /[^0-9.]/);
    $self->{'EVENT_TIMING'} = $secs;
  }

  return $self->{'EVENT_TIMING'};
}

sub files    { $_[0]->{'FILES'}    }
sub handlers { $_[0]->{'HANDLERS'} }

sub handlers_during_blocking_tasks
{
  my($self, $arg) = @_;
  $self->{'HANDLERS_WHEN_BLOCKING'} = ($arg) ? 1 : 0  if(@_ == 2);
  return $self->{'HANDLERS_WHEN_BLOCKING'};
}

sub last_error  { $_[0]->{'LAST_ERROR'} }
sub clear_error { $_[0]->{'LAST_ERROR'} = undef }

sub xfer_bufsize
{
  my($self, $size) = @_;
  $self->{'HTXF_BUFSIZE'} = $size  if($size =~ /^\d+$/);
  return $self->{'HTXF_BUFSIZE'};
}

sub last_activity
{
  my($self) = shift;
  return $self->{'LAST_ACTIVITY'};
}

sub news { $_[0]->{'NEWS'} }

sub path_separator
{
  my($self, $separator) = @_;
  $self->{'PATH_SEPARATOR'} = $separator  if($separator =~ /^.$/);
  return $self->{'PATH_SEPARATOR'};
}

sub rsrc_fork_extension
{
  my($self, $ext) = @_;
  croak("The resource fork extension may not be the same as the data fork extension!")
    if($ext eq $self->{'RSRC_FORK_EXT'}); 
  $self->{'RSRC_FORK_EXT'} = $ext  if(defined($ext));
  return $self->{'RSRC_FORK_EXT'};
}

sub pchats   { $_[0]->{'PCHATS'}      }
sub userlist { $_[0]->{'USER_LIST'}   }

sub server
{
  $_[0]->{'SERVER_ADDR'} .
    ($_[0]->{'SERVER_PORT'} ne HTLS_TCPPORT) ?
      ":$_[0]->{'SERVER_PORT'}" : '';
}

sub connect
{
  my($self, $server) = @_;

  my($address, $port);

  if(($address = $server) =~ s/^([^ :]+)(?:[: ](\d+))?$/$1/)
  {
    $port = $2 || HTLS_TCPPORT;
  }
  else
  {
    croak("Bad server address: $server");
  }

  eval
  {
    $SIG{'ALRM'} = sub { die "timeout" };
    alarm($self->{'CONNECT_TIMEOUT'});

    $self->{'SERVER'} = 
      IO::Socket::INET->new(PeerAddr =>$address,
                            PeerPort =>$port,
                            Proto    =>'tcp');

    alarm(0);
    $SIG{'ALRM'} = 'DEFAULT';
  };

  if($@ =~ /timeout/)
  {
    $self->{'LAST_ERROR'} = "Timed out after $self->{'CONNECT_TIMEOUT'} seconds";
    return;
  }

  if(!$self->{'SERVER'} || $@)
  {
    $self->{'LAST_ERROR'} = $@ || $! || 'Connection failed';
    return;
  }

  $self->{'SERVER'}->autoflush(1);

  $self->{'SERVER_ADDR'} = $address;
  $self->{'SERVER_PORT'} = $port;

  return(1);
}

sub disconnect
{
  my($self) = shift;

  if(ref($self->{'SERVER'}) && $self->{'SERVER'}->opened())
  {
    $self->{'SERVER'}->close();
    $self->{'LOGGED_IN'} = undef;
    $self->{'SERVER_ADDR'} = undef;
    return(1);
  }

  $self->{'LAST_ERROR'} = 'Not connected.';
  return;
}

sub login
{
  my($self, %args) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_login_now(%args); 
  }
  else
  {
    return $self->_login(%args); 
  }
}

sub _login_now
{
  my($self, %args) = @_;

  my($no_news, $no_userlist, $task_num, $task, $packet);

  $no_news     = $args{'NoNews'};
  $no_userlist = $args{'NoUserList'};

  $args{'NoNews'} = $args{'NoUserList'} = undef;

  $task_num = $self->_login(%args);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    $self->disconnect();
    return;
  }

  unless($no_news)
  {
    unless($self->get_news())
    {
      $self->{'LAST_ERROR'} = "Login succeeded, but could not get news.";
      return("0E-0");
    }
  }

  unless($no_userlist)
  {
    unless($self->get_userlist())
    {
      $self->{'LAST_ERROR'} = "Login succeeded, but could not get userlist";
      return("0E-0");
    }
  }

  return(1);
}

sub _login
{
  my($self, %args) = @_;

  my($nick, $login, $password, $icon, $enc_login, $enc_password,
     $proto_header, $data, $response, $task_num, $server);

  $server = $self->{'SERVER'} or croak "Not connected to a server";

  unless($server->opened())
  {
    $self->{'LAST_ERROR'} = "login() called before connect()";
    return;
  }

  $nick  = $args{'Nickname'} || HTLC_DEFAULT_NICK;
  $login = $args{'Login'}    || HTLC_DEFAULT_LOGIN;
  $icon  = $args{'Icon'}     || HTLC_DEFAULT_ICON;
  $password = $args{'Password'};

  $self->{'NICK'}  = $nick;
  $self->{'LOGIN'} = $login;
  $self->{'ICON'}  = $icon;

  _hlc_write($self, $server, \HTLC_MAGIC, HTLC_MAGIC_LEN) || return;
  _hlc_read($self, $server, \$response, HTLS_MAGIC_LEN) || return;

  if($response ne HTLS_MAGIC)
  {
    $self->{'LAST_ERROR'} = "Handshake failed.  Not a hotline server?";
    $self->disconnect();
    return;
  }

  $enc_login    = _encode($login);
  $enc_password = _encode($password);

  $proto_header = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_LOGIN);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(SIZEOF_HL_PROTO_HDR + 
                     length($enc_login) +
                     length($enc_password) +
                     length($nick));
  $proto_header->len2($proto_header->len);

  my($fmt) = 'nnna*nna*nna*nnn';

  $data = $proto_header->header() .
          pack($fmt, 0x0004,                  # Num atoms

                     HTLC_DATA_LOGIN,         # Atom type
                     length($enc_login),      # Atom length
                     $enc_login,              # Atom data

                     HTLC_DATA_PASSWORD,      # Atom type
                     length($enc_password),   # Atom length
                     $enc_password,           # Atom data

                     HTLC_DATA_NICKNAME,      # Atom type
                     length($nick),           # Atom length
                     $nick,                   # Atom data

                     HTLC_DATA_ICON,          # Atom type
                     0x0002,                  # Atom length
                     $icon);                  # Atom data

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: LOGIN - $task_num\n");
    $self->{'TASKS'}->{$task_num} =
      new Net::Hotline::Task($task_num, HTLC_TASK_LOGIN, time());
  }
  else { return }

  unless($args{'NoUserList'})
  {
    $self->req_userlist();
  }

  unless($args{'NoNews'})
  {
    $self->req_news();
  }

  _set_blocking($server, $self->{'BLOCKING'});

  return($task_num);
}

sub run
{
  my($self) = shift;

  my($server) = $self->{'SERVER'}  or croak "Not connected to a server";
  return  unless($server->opened());

  my($ret, $packet);

  $packet = new Net::Hotline::Protocol::Packet;

  while($ret = $packet->read_parse($server, $self->{'BLOCKING'}))
  {
    _process_packet($self, $packet, $ret) || return(1);
  }

  return(1);
}

sub _process_packet
{
  my($self, $packet, $ret, $blocking_task) = @_;

  my($data_ref, $type, $use_handlers);

  $use_handlers = !($blocking_task && !$self->{'HANDLERS_WHEN_BLOCKING'});

  $type = $packet->{'TYPE'};

  if($ret == HTLC_EWOULDBLOCK) # Idle event
  {
    if(defined($self->{'HANDLERS'}->{'EVENT'}))
    {
      &{$self->{'HANDLERS'}->{'EVENT'}}($self, 1);
    }

    select(undef, undef, undef, $self->{'EVENT_TIMING'});
    return(1);
  }

  $self->{'LAST_ACTIVITY'} = time();

  if(defined($self->{'HANDLERS'}->{'EVENT'})) # Non-idle event
  {
    &{$self->{'HANDLERS'}->{'EVENT'}}($self, 0);
  }

  _debug("Packet type = $type\n");

  if($type == HTLS_HDR_USER_LEAVE)
  {
    # Hotline server *BUG* - you may get a "disconnect" packet for a
    # socket _before_ you get the "connect" packet for that socket!
    # In fact, the "connect" packet will never arrive in this case.

    if(defined($packet->{'SOCKET'}) &&
       defined($self->{'USER_LIST'}->{$packet->{'SOCKET'}}))
    {
      my($user) = $self->{'USER_LIST'}->{$packet->{'SOCKET'}};

      delete $self->{'USER_LIST'}->{$packet->{'SOCKET'}};

      if($use_handlers)
      {
        if(defined($self->{'HANDLERS'}->{'LEAVE'}))
        {
          &{$self->{'HANDLERS'}->{'LEAVE'}}($self, $user);
        }
        elsif($self->{'DEFAULT_HANDLERS'})
        {       
          print "USER LEFT: ", $user->nick(), "\n";
        }
      }
    }
  }
  elsif($type == HTLS_HDR_TASK)
  {
    my($task) = $self->{'TASKS'}->{$packet->{'TASK_NUM'}};

    my($task_type) = $task->type();

    $task->finish(time());

    if(defined($packet->{'TASK_ERROR'}))
    {
      $task->error(1);
      $task->error_text($packet->{'TASK_ERROR'});

      if($use_handlers)
      {
        if(defined($self->{'HANDLERS'}->{'TASK_ERROR'}))
        {
          &{$self->{'HANDLERS'}->{'TASK_ERROR'}}($self, $task);
        }
        else
        {
          print "TASK ERROR(", $task->num(), ':', $task->type(), ") ",
                $task->error_text(), "\n";
        }
      }
    }
    else
    {
      $task->error(0);

      if($task_type == HTLC_TASK_USER_LIST && defined($packet->{'USER_LIST'}))
      {
        $self->{'USER_LIST'} = $packet->{'USER_LIST'};

        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'USER_LIST'}))
          {
            &{$self->{'HANDLERS'}->{'USER_LIST'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "GET USER LIST: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_FILE_LIST)
      {
        my($path);

        $task->path("")  unless(length($task->path()));
        $path = $task->path();

        if($packet->{'FILE_LIST'})
        {
          $self->{'FILES'}->{$path} = $packet->{'FILE_LIST'};
        }
        else
        {
          $self->{'FILES'}->{$path} = [];
        }

        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'FILE_LIST'}))
          {
            &{$self->{'HANDLERS'}->{'FILE_LIST'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "GET FILE LIST: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_NEWS && defined($packet->{'DATA'}))
      {
        my(@news) = split(/_{58}/, $packet->{'DATA'});

        $self->{'NEWS'} = \@news;

        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'NEWS'}))
          {
            &{$self->{'HANDLERS'}->{'NEWS'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "GET NEWS: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_USER_INFO && defined($packet->{'DATA'}))
      {
        my($user) = $self->{'USER_LIST'}->{$task->socket()};

        $user->info($packet->{'DATA'});

        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'USER_GETINFO'}))
          {
            &{$self->{'HANDLERS'}->{'USER_GETINFO'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "GET USER INFO: Task complete.\n";
          }
        }

        _debug("USER_GETINFO for: $packet->{'NICK'} (", $task->socket(), ")\n",
               $packet->{'DATA'}, "\n");
      }
      elsif($task_type == HTLC_TASK_FILE_INFO)
      {
        my($path, $file_info);

        $task->path("")  unless(length($task->path));
        $path = $task->path();

        $file_info = $self->{'FILE_INFO'} = new Net::Hotline::FileInfoItem();

        $file_info->icon($packet->{'FILE_ICON'});
        $file_info->type($packet->{'FILE_TYPE'});
        $file_info->creator($packet->{'FILE_CREATOR'});
        $file_info->size($packet->{'FILE_SIZE'});
        $file_info->name($packet->{'FILE_NAME'});
        $file_info->comment($packet->{'FILE_COMMENT'});
        $file_info->ctime($packet->{'FILE_CTIME'});
        $file_info->mtime($packet->{'FILE_MTIME'});

        if($use_handlers)
        {      
          if(defined($self->{'HANDLERS'}->{'FILE_GET_INFO'}))
          {
            &{$self->{'HANDLERS'}->{'FILE_GET_INFO'}}($self, $task, $file_info);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "FILE_GET_INFO: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_LOGIN)
      {
        $self->{'LOGGED_IN'} = 1;

        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'LOGIN'}))
          {
            &{$self->{'HANDLERS'}->{'LOGIN'}}($self);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "LOGIN: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_NEWS_POST)
      {
        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'NEWS_POST'}))
          {
            &{$self->{'HANDLERS'}->{'NEWS_POST'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "POST NEWS: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_SEND_MSG)
      {
        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'SEND_MSG'}))
          {
            &{$self->{'HANDLERS'}->{'SEND_MSG'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "SEND MSG: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_KICK)
      {
        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'KICK'}))
          {
            &{$self->{'HANDLERS'}->{'KICK'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "KICK: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_BAN)
      {
        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'BAN'}))
          {
            &{$self->{'HANDLERS'}->{'BAN'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "BAN: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_SET_INFO)
      {
        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'FILE_SET_INFO'}))
          {
            &{$self->{'HANDLERS'}->{'FILE_SET_INFO'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "SET INFO: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_FILE_DELETE)
      {
        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'FILE_DELETE'}))
          {
            &{$self->{'HANDLERS'}->{'FILE_DELETE'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "DELETE FILE: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_FILE_MKDIR)
      {
        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'FILE_MKDIR'}))
          {
            &{$self->{'HANDLERS'}->{'FILE_MKDIR'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "CREATE FOLDER: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_FILE_MOVE)
      {
        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'FILE_MOVE'}))
          {
            &{$self->{'HANDLERS'}->{'FILE_MOVE'}}($self, $task);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "MOVE FILE: Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_FILE_GET)
      {
        my($size) = $packet->{'HTXF_SIZE'};
        my($ref)  = $packet->{'HTXF_REF'};

        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'FILE_GET'}))
          {
            &{$self->{'HANDLERS'}->{'FILE_GET'}}($self, $task, $ref, $size);
          }
          else
          {
            print "GET FILE: Starting download (ref = $ref, size = $size)\n"
              if($self->{'DEFAULT_HANDLERS'});

            $self->recv_file($task, $ref, $size);
          }
        }
      }
      elsif($task_type == HTLC_TASK_FILE_PUT)
      {
        my($ref)    = $packet->{'HTXF_REF'};
        my($resume) = $packet->{'HTXF_RFLT'};
        my($size)   = ${$task->misc()}[0] + ${$task->misc()}[1];

        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'FILE_PUT'}))
          {
            &{$self->{'HANDLERS'}->{'FILE_PUT'}}($self, $task, $ref, $size, $resume);
          }
          else
          {
            print "GET PUT: Starting upload (ref = $ref)\n"
              if($self->{'DEFAULT_HANDLERS'});

            $self->send_file($task, $ref, $size, $resume);
          }
        }
      }
      elsif($task_type == HTLC_TASK_PCHAT_CREATE)
      {
        my($ref)    = $packet->{'PCHAT_REF'};
        my($user)   = $self->{'USER_LIST'}->{$packet->{'SOCKET'}};
        my($pchat)  = $self->{'PCHATS'}->{$ref} = new Net::Hotline::PrivateChat;

        $pchat->reference($ref);
        $pchat->userlist({ $packet->{'SOCKET'} => $user });

        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'PCHAT_CREATE'}))
          {
            &{$self->{'HANDLERS'}->{'PCHAT_CREATE'}}($self, $task, $pchat);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "CREATE PCHAT($ref): Task complete.\n";
          }
        }
      }
      elsif($task_type == HTLC_TASK_PCHAT_ACCEPT)
      {
        my($ref) = $task->misc();

        my($userlist);
        
        # Create userlist of references to the main userlist rather
        # than new user objects (as returned in the packet)
        foreach my $socket (keys(%{$packet->{'USER_LIST'}}))
        {
          $userlist->{$socket} = $self->{'USER_LIST'}->{$socket};
        }

        my($pchat)  = $self->{'PCHATS'}->{$ref} =
          new Net::Hotline::PrivateChat($ref, $userlist);
        
        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'PCHAT_ACCEPT'}))
          {
            &{$self->{'HANDLERS'}->{'PCHAT_ACCEPT'}}($self, $task, $pchat);
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "ACCEPT PCHAT INVITE($ref): Task complete.\n";
          }
        }
      }
    }
    # Reclaim memory
    delete $self->{'TASKS'}->{$packet->{'TASK_NUM'}};
  }
  elsif($type == HTLS_HDR_AGREEMENT)
  {
    $self->{'AGREEMENT'} = $packet->{'DATA'};

    if(defined($packet->{'DATA'}))
    {
      if($use_handlers)
      {
        if(defined($self->{'HANDLERS'}->{'AGREEMENT'}))
        {
          &{$self->{'HANDLERS'}->{'AGREEMENT'}}($self, \$packet->{'DATA'});
        }
        elsif($self->{'DEFAULT_HANDLERS'})
        {
          print "AGREEMENT:\n", $packet->{'DATA'}, "\n";
        }
      }
    }
  }
  elsif($type == HTLS_HDR_MSG)
  {
    my($user) = $self->{'USER_LIST'}->{$packet->{'SOCKET'}};

    # User-to-user message
    if(defined($user) && defined($packet->{'DATA'}))
    {
      if($use_handlers)
      {
        if(defined($self->{'HANDLERS'}->{'MSG'}))
        {
          &{$self->{'HANDLERS'}->{'MSG'}}($self, $user, \$packet->{'DATA'}, \$packet->{'REPLY_TO'});
        }
        elsif($self->{'DEFAULT_HANDLERS'})
        {
          print "MSG: ", $user->nick(), "(", 
                         $packet->{'SOCKET'}, ") ", 
                         $packet->{'DATA'};

          if($packet->{'IS_REPLY'})
          {
            print " (In reply to: $packet->{'REPLY_TO'}])";
          }

          print "\n";
        }
      }
    }
    elsif(defined($packet->{'DATA'})) # Server message
    {
      if($use_handlers)
      {
        if(defined($self->{'HANDLERS'}->{'SERVER_MSG'}))
        {
          &{$self->{'HANDLERS'}->{'SERVER_MSG'}}($self, \$packet->{'DATA'});
        }
        elsif($self->{'DEFAULT_HANDLERS'})
        {
          print "SERVER MSG: ", $packet->{'DATA'}, "\n";
        }
      }
    }
  }
  elsif($type == HTLS_HDR_USER_CHANGE)
  {
    if(defined($packet->{'NICK'}) && defined($packet->{'SOCKET'}) &&
       defined($packet->{'ICON'}) && defined($packet->{'COLOR'}))
    {
      if(defined($self->{'USER_LIST'}->{$packet->{'SOCKET'}}))
      {
        my($user) = $self->{'USER_LIST'}->{$packet->{'SOCKET'}};

        if($user->nick() ne $packet->{'NICK'})
        {
          my($old_nick) = $user->nick();

          $user->nick($packet->{'NICK'});

          if($use_handlers)
          {
            if(defined($self->{'HANDLERS'}->{'NICK'}))
            {
              &{$self->{'HANDLERS'}->{'NICK'}}($self, $user, $old_nick, $user->nick());
            }
            elsif($self->{'DEFAULT_HANDLERS'})
            {
              print "USER CHANGE: $old_nick is now known as ", $user->nick(), "\n";
            }
          }
        }
        elsif($user->icon() ne $packet->{'ICON'})
        {
          my($old_icon) = $user->icon();

          $user->icon($packet->{'ICON'});

          if($use_handlers)
          {
            if(defined($self->{'HANDLERS'}->{'ICON'}))
            {
              &{$self->{'HANDLERS'}->{'ICON'}}($self, $user, $old_icon, $user->icon());
            }
            elsif($self->{'DEFAULT_HANDLERS'})
            {
              print "USER CHANGE: ", $user->nick(),
                    " icon changed from $old_icon to ",
                    $user->icon(), "\n";
            }
          }
        }
        elsif($user->color() ne $packet->{'COLOR'})
        {
          my($old_color) = $user->color();

          $user->color($packet->{'COLOR'});

          if($use_handlers)
          {
            if(defined($self->{'HANDLERS'}->{'COLOR'}))
            {
              &{$self->{'HANDLERS'}->{'COLOR'}}($self, $user, $old_color, $user->color());
            }
            elsif($self->{'DEFAULT_HANDLERS'})
            {
              print "USER CHANGE: ", $user->nick(),
                    " color changed from $old_color to ",
                    $user->color(), "\n";
            }
          }
        }
      }
      else
      {
        $self->{'USER_LIST'}->{$packet->{'SOCKET'}} =
          new Net::Hotline::User($packet->{'SOCKET'},
                            $packet->{'NICK'},
                            undef,
                            $packet->{'ICON'},
                            $packet->{'COLOR'});

        if($use_handlers)
        {
          if(defined($self->{'HANDLERS'}->{'JOIN'}))
          {
            &{$self->{'HANDLERS'}->{'JOIN'}}($self, $self->{'USER_LIST'}->{$packet->{'SOCKET'}});
          }
          elsif($self->{'DEFAULT_HANDLERS'})
          {
            print "JOINED:\n",
                  "  Nick: $packet->{'NICK'}\n",
                  "  Icon: $packet->{'ICON'}\n",
                  "Socket: $packet->{'SOCKET'}\n",
                  " Color: $packet->{'COLOR'}\n";
          }
        }
      }
    }
  }
  elsif($type == HTLS_HDR_CHAT)
  {
    if(defined($packet->{'DATA'}))
    {
      $packet->{'DATA'} =~ s/^\n//s;

      my($ref) = $packet->{'PCHAT_REF'};

      if($ref) # Priate chat
      {
        # Private chat "action"
        if($packet->{'DATA'} =~ /^ \*\*\* /)
        {
          if($use_handlers)
          {
            if(defined($self->{'HANDLERS'}->{'PCHAT_ACTION'}))
            {
              &{$self->{'HANDLERS'}->{'PCHAT_ACTION'}}($self, $ref, \$packet->{'DATA'});
            }
            elsif($self->{'DEFAULT_HANDLERS'})
            {
              print "PCHAT($ref) ACTION: ", $packet->{'DATA'}, "\n";
            }
          }
        }
        else # Regular private chat
        {
          if($use_handlers)
          {
            if(defined($self->{'HANDLERS'}->{'PCHAT_CHAT'}))
            {
              &{$self->{'HANDLERS'}->{'PCHAT_CHAT'}}($self, $ref, \$packet->{'DATA'});
            }
            elsif($self->{'DEFAULT_HANDLERS'})
            {
              print "PCHAT($ref): ", $packet->{'DATA'}, "\n";
            }
          }
        }
      }
      else # Regular chat
      {
        # Chat "action"
        if($packet->{'DATA'} =~ /^ \*\*\* /)
        {
          if($use_handlers)
          {
            if(defined($self->{'HANDLERS'}->{'CHAT_ACTION'}))
            {
              &{$self->{'HANDLERS'}->{'CHAT_ACTION'}}($self, \$packet->{'DATA'});
            }
            elsif($self->{'DEFAULT_HANDLERS'})
            {
              print "CHAT ACTION: ", $packet->{'DATA'}, "\n";
            }
          }
        }
        else # Regular chat
        {
          if($use_handlers)
          {
            if(defined($self->{'HANDLERS'}->{'CHAT'}))
            {
              &{$self->{'HANDLERS'}->{'CHAT'}}($self, \$packet->{'DATA'});
            }
            elsif($self->{'DEFAULT_HANDLERS'})
            {
              print "CHAT: ", $packet->{'DATA'}, "\n";
            }
          }
        }
      }
    }
  }
  elsif($type == HTLS_HDR_NEWS_POST)
  {
    my($post) = $packet->{'DATA'};

    if(defined($post))
    {
      $post =~ s/@{[HTLC_NEWLINE]}/\n/osg;
      $post =~ s/_{58}//sg;

      if($use_handlers)
      {
        if(defined($self->{'HANDLERS'}->{'NEWS_POSTED'}))
        {
          &{$self->{'HANDLERS'}->{'NEWS_POSTED'}}($self, \$post);
        }
        elsif($self->{'DEFAULT_HANDLERS'})
        {
          print "NEWS: New post made.\n";
        }
      }
    }
  }
  elsif($type == HTLS_HDR_POLITE_QUIT ||
        $type eq 'DISCONNECTED')
  {
    if(defined($packet->{'DATA'}))
    {
      if($use_handlers)
      {
        if(defined($self->{'HANDLERS'}->{'QUIT'}))
        {
          &{$self->{'HANDLERS'}->{'QUIT'}}($self, \$packet->{'DATA'});
        }
        elsif($self->{'DEFAULT_HANDLERS'})
        {
          print "CONNECTION CLOSED: ", $packet->{'DATA'}, "\n";
        }
      }
    }
    elsif($self->{'DEFAULT_HANDLERS'})
    {
      if($use_handlers)
      {
        print "CONNECTION CLOSED\n";
      }
    }

    $self->disconnect();
    return(0);
  }
  elsif($type == HTLS_HDR_PCHAT_INVITE)
  {
    if($use_handlers)
    {
      if(defined($self->{'HANDLERS'}->{'PCHAT_INVITE'}))
      {
        &{$self->{'HANDLERS'}->{'PCHAT_INVITE'}}($self, $packet->{'PCHAT_REF'},
                                                 $packet->{'SOCKET'},
                                                 $packet->{'NICK'});
      }
      elsif($self->{'DEFAULT_HANDLERS'})
      {
        print "PCHAT INVITE($packet->{'PCHAT_REF'}) from $packet->{'NICK'}($packet->{'SOCKET'})",
              "($packet->{'SOCKET)'})\n";
      }
    }
  }
  elsif($type == HTLS_HDR_PCHAT_USER_JOIN)
  {
    my($ref)    = $packet->{'PCHAT_REF'};
    my($socket) = $packet->{'SOCKET'};
    my($pchat)  = $self->{'PCHATS'}->{$ref};

    $pchat->userlist()->{$socket} = $self->{'USER_LIST'}->{$socket};

    if($use_handlers)
    {
      if(defined($self->{'HANDLERS'}->{'PCHAT_JOIN'}))
      {
        &{$self->{'HANDLERS'}->{'PCHAT_JOIN'}}($self, $pchat, $socket);
      }
      elsif($self->{'DEFAULT_HANDLERS'})
      {
        print "PCHAT($ref)  JOIN($socket)\n";
      }
    }
  }
  elsif($type == HTLS_HDR_PCHAT_USER_LEAVE)
  {
    my($ref)    = $packet->{'PCHAT_REF'};
    my($socket) = $packet->{'SOCKET'};
    my($pchat)  = $self->{'PCHATS'}->{$ref};

    delete $pchat->userlist()->{$socket};

    if($use_handlers)
    {
      if(defined($self->{'HANDLERS'}->{'PCHAT_LEAVE'}))
      {
        &{$self->{'HANDLERS'}->{'PCHAT_LEAVE'}}($self, $pchat, $socket);
      }
      elsif($self->{'DEFAULT_HANDLERS'})
      {
        print "PCHAT($ref)  LEAVE($socket)\n";
      }
    }
  }
  elsif($type == HTLS_HDR_PCHAT_SUBJECT)
  {
    my($pchat) = $self->{'PCHATS'}->{$packet->{'PCHAT_REF'}};
    
    $pchat->subject($packet->{'DATA'});

    if($use_handlers)
    {
      if(defined($self->{'HANDLERS'}->{'PCHAT_SUBJECT'}))
      {
        &{$self->{'HANDLERS'}->{'PCHAT_SUBJECT'}}($self, $pchat, \$packet->{'DATA'});
      }
      elsif($self->{'DEFAULT_HANDLERS'})
      {
        print "PCHAT(", $pchat->reference(), ") Subject set to: $packet->{'DATA'}\n";
      }
    }
  }

  return(1);
}

sub _handler
{
  my($self, $code_ref, $type) = @_;

  if(defined($code_ref))
  {
    if(ref($code_ref) eq 'CODE')
    {
      $self->{'HANDLERS'}->{$type} = $code_ref;
    }
  }

  return $self->{'HANDLERS'}->{$type};
}

sub _next_seqnum
{
  my($self) = shift;

  return $self->{'SEQNUM'}++;
}

sub agreement_handler     { return _handler($_[0], $_[1], 'AGREEMENT')     }
sub ban_handler           { return _handler($_[0], $_[1], 'BAN')           }
sub chat_handler          { return _handler($_[0], $_[1], 'CHAT')          }
sub chat_action_handler   { return _handler($_[0], $_[1], 'CHAT_ACTION')   }
sub color_handler         { return _handler($_[0], $_[1], 'COLOR')         }
sub event_loop_handler    { return _handler($_[0], $_[1], 'EVENT')         }
sub delete_file_handler   { return _handler($_[0], $_[1], 'FILE_DELETE')   }
sub get_file_handler      { return _handler($_[0], $_[1], 'FILE_GET')      }
sub put_file_handler      { return _handler($_[0], $_[1], 'FILE_PUT')      }
sub file_info_handler     { return _handler($_[0], $_[1], 'FILE_GET_INFO') }
sub file_list_handler     { return _handler($_[0], $_[1], 'FILE_LIST')     }
sub new_folder_handler    { return _handler($_[0], $_[1], 'FILE_MKDIR')    }
sub move_file_handler     { return _handler($_[0], $_[1], 'FILE_MOVE')     }
sub set_file_info_handler { return _handler($_[0], $_[1], 'FILE_SET_INFO') }
sub icon_handler          { return _handler($_[0], $_[1], 'ICON')          }
sub join_handler          { return _handler($_[0], $_[1], 'JOIN')          }
sub kick_handler          { return _handler($_[0], $_[1], 'KICK')          }
sub leave_handler         { return _handler($_[0], $_[1], 'LEAVE')         }
sub login_handler         { return _handler($_[0], $_[1], 'LOGIN')         }
sub msg_handler           { return _handler($_[0], $_[1], 'MSG')           }
sub news_handler          { return _handler($_[0], $_[1], 'NEWS')          }
sub post_news_handler     { return _handler($_[0], $_[1], 'NEWS_POST')     }
sub news_posted_handler   { return _handler($_[0], $_[1], 'NEWS_POSTED')   }
sub nick_handler          { return _handler($_[0], $_[1], 'NICK')          }
sub pchat_accept_handler  { return _handler($_[0], $_[1], 'PCHAT_ACCEPT')  }
sub pchat_action_handler  { return _handler($_[0], $_[1], 'PCHAT_ACTION')  }
sub pchat_chat_handler    { return _handler($_[0], $_[1], 'PCHAT_CHAT')    }
sub pchat_create_handler  { return _handler($_[0], $_[1], 'PCHAT_CREATE')  }
sub pchat_invite_handler  { return _handler($_[0], $_[1], 'PCHAT_INVITE')  }
sub pchat_join_handler    { return _handler($_[0], $_[1], 'PCHAT_JOIN')    }
sub pchat_leave_handler   { return _handler($_[0], $_[1], 'PCHAT_LEAVE')   }
sub pchat_subject_handler { return _handler($_[0], $_[1], 'PCHAT_SUBJECT') }
sub quit_handler          { return _handler($_[0], $_[1], 'QUIT')          }
sub send_msg_handler      { return _handler($_[0], $_[1], 'SEND_MSG')      }
sub server_msg_handler    { return _handler($_[0], $_[1], 'SERVER_MSG')    }
sub task_error_handler    { return _handler($_[0], $_[1], 'TASK_ERROR')    }
sub user_info_handler     { return _handler($_[0], $_[1], 'USER_GETINFO')  }
sub user_list_handler     { return _handler($_[0], $_[1], 'USER_LIST')     }

#
# Package subroutines
#

sub version { $Net::Hotline::Client::VERSION }

sub debug
{ 
  if(@_ == 1 && !ref($_[0]))
  {
    $Net::Hotline::Client::DEBUG = ($_[0]) ? 1 : 0;
  }
  elsif(@_ == 2 && ref($_[0]) eq 'Net::Hotline::Client')
  {
    $Net::Hotline::Client::DEBUG = ($_[1]) ? 1 : 0;
  }

  return $Net::Hotline::Client::DEBUG;
}

sub _hlc_write
{
  my($self, $fh, $data_ref, $len) = @_;

  return("0-E0")  if($len == 0 || !defined($len));
  
  unless(_write($fh, $data_ref, $len) == $len)
  {
    $self->{'LAST_ERROR'} = "Write error: $!";
    return;
  }

  return($len);
}

sub _hlc_read
{
  my($self, $fh, $data_ref, $len) = @_;

  return("0-E0")  if($len == 0 || !defined($len));

  unless(_read($fh, $data_ref, $len) == $len)
  {
    $self->{'LAST_ERROR'} = "Read error: $!";
    return;
  }

  return($len);
}

sub _hlc_buffered_read
{
  my($self, $fh, $data_ref, $len) = @_;

  return("0-E0")  if($len == 0 || !defined($len));

  unless(read($fh, $$data_ref, $len) == $len)
  {
    $self->{'LAST_ERROR'} = "Read error: $!";
    return;
  }

  return($len);
}

# Macbinary CRC perl code from Convert::BinHex by Eryq (eryq@enteract.com)
# (It needs access to the lexical @CRC_MAGIC, so it can't be auto-loaded)
sub macbin_crc
{
  shift if(ref($_[0]));

  my($len) = length($_[0]);
  my($crc) = $_[1];

  for(my $i = 0; $i < $len; $i++)
  {
    ($crc ^= (vec($_[0], $i, 8) << 8)) &= 0xFFFF;
    $crc = ($crc << 8) ^ $CRC_MAGIC[$crc >> 8];
  }
  return $crc;
}

#
# Satisfy autoloader's ridiculous *8-character* unique name limit :-/
#

sub get_filelist { al01_get_filelist(@_) }
sub get_fileinfo { al02_get_fileinfo(@_) }
sub get_userinfo { al03_get_userinfo(@_) }
sub user_by_nick { al04_user_by_nick(@_) }
sub req_userlist { al05_req_userlist(@_) }
sub req_filelist { al06_req_filelist(@_) }
sub pchat_action { al07_pchat_action(@_) }
sub get_file     { al08_get_file(@_)     }
sub put_file     { al09_put_file(@_)     }

# Internal functions that were also munged up:

# _al01_put_file_resume_now
# _al02_get_file_resume_now
# _al03_delete_file_now
# _al04_new_folder_now
# _al05_put_file_now
# _al06_put_file_resume
# _al07_get_file_now
# _al08_get_file_resume
# _al09_file_action_stub
# _al10_post_news_now
# _al11_pchat_invite_now
# _al12_pchat_accept_now
# _al13_comment_now

__END__

#
# Auto-loaded methods and subroutines
#

sub logged_in { $_[0]->{'LOGGED_IN'} }

sub connected
{
  (ref($_[0]->{'SERVER'}) && $_[0]->{'SERVER'}->opened()) ? 1 : 0;
}

sub _blocking_task
{
  my($self, $task_num) = @_;

  my($packet, $ret);

  $packet = new Net::Hotline::Protocol::Packet;

  while($ret = $packet->read_parse($self->{'SERVER'}, $self->{'BLOCKING'}))
  {
    _process_packet($self, $packet, $ret, 'blocking task');

    if($packet->{'TYPE'} == HTLS_HDR_TASK &&
       $packet->{'TASK_NUM'} == $task_num)
    {
      return($packet);
    }
  }
}

sub al01_get_filelist
{
  my($self, $path) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->req_filelist($path);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return(0);
  }

  $path = $task->path();
  $path = ""  unless(length($path));

  if(wantarray)
  {
    return @{$self->{'FILES'}->{$path}};
  }
  else
  {
    return $self->{'FILES'}->{$path};
  }
}

sub al06_req_filelist
{
  my($self, $path) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($data, $task_num, @path_parts, $path_part, $data_length, $length,
     $save_path);

  $path =~ s/^$self->{'PATH_SEPARATOR'}//;
  $path =~ s/$self->{'PATH_SEPARATOR'}$//;

  if(length($path))
  {
    $save_path = $path;
    @path_parts = split($self->{'PATH_SEPARATOR'}, $path);
    $path =~ s/$self->{'PATH_SEPARATOR'}//g;

    if(length($path) > HTLC_MAX_PATHLEN)
    {
      croak("Maximum path length exceeded");
    }

    # 2 null bytes, the 1 byte for length, and the length of the path part
    $data_length = (3 * scalar(@path_parts)) + length($path);
    $length = SIZEOF_HL_LONG_HDR + $data_length;
  }
  else
  {
    $length = 2; # Two null bytes
  }

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_FILE_LIST);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len($length);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header();

  if(length($path))
  {
    $data .= pack("n4", 0x0001,               # Number of atoms
                        HTLC_DATA_DIRECTORY,  # Atom type
                        $data_length + 2,     # Atom length

                        scalar(@path_parts)); # Number of path parts

    foreach $path_part (@path_parts)          # Path parts data
    {
      if(length($path_part) > HTLC_MAX_PATHLEN)
      {
        croak("Maximum path part length exceeded");
      }

      $data .= pack("nCa*", 0x0000,           # 2 null bytes
                            length $path_part,# Length
                            $path_part);      # Path part
    }
  }
  else
  {
    $data .= pack("n", 0x0000);
  }

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: FILE_LIST - $task_num\n");
    $self->{'TASKS'}->{$task_num} = 
      new Net::Hotline::Task($task_num, HTLC_TASK_FILE_LIST, time(), undef, $save_path);
    return($task_num);
  }
  else { return }
}

sub al03_get_userinfo
{
  my($self, $socket) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->req_userinfo($socket);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return $self->{'USER_LIST'}->{$task->socket()}->info();
}

sub req_userinfo
{
  my($self, $socket) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($data, $task_num);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_USER_GETINFO);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(SIZEOF_HL_LONG_HDR);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n4", 0x0001,                  # Number of atoms

                     HTLC_DATA_SOCKET,        # Atom type
                     0x0002,                  # Atom length
                     $socket);                # Atom data

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: USER_GETINFO - $task_num\n");
    $self->{'TASKS'}->{$task_num} = 
      new Net::Hotline::Task($task_num, HTLC_TASK_USER_INFO, time(), $socket);
    return($task_num);
  }
  else { return }
}

sub al02_get_fileinfo
{
  my($self, $path) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->req_fileinfo($path);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return $self->{'FILE_INFO'};
}

sub req_fileinfo
{
  return _file_action_simple($_[0], $_[1], HTLC_HDR_FILE_GETINFO, HTLC_TASK_FILE_INFO, 'GET FILE INFO');
}

sub delete_file
{
  my($self, $path) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al03_delete_file_now($path); 
  }
  else
  {
    return $self->_delete_file($path); 
  }
}

sub _al03_delete_file_now
{
  my($self, $path) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_delete_file($path);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _delete_file
{
  return _file_action_simple($_[0], $_[1], HTLC_HDR_FILE_DELETE, HTLC_TASK_FILE_DELETE, 'DELETE FILE');
}

sub new_folder
{
  my($self, $path) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al04_new_folder_now($path); 
  }
  else
  {
    return $self->_new_folder($path); 
  }
}

sub _al04_new_folder_now
{
  my($self, $path) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_new_folder($path);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _new_folder
{
  return _file_action_simple($_[0], $_[1], HTLC_HDR_FILE_MKDIR, HTLC_TASK_FILE_MKDIR, 'NEW FOLDER');
}

sub al09_put_file
{
  my($self, $src_path, $dest_path, $comments) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al05_put_file_now($src_path, $dest_path, $comments); 
  }
  else
  {
    return $self->_put_file($src_path, $dest_path, $comments);
  }
}

sub _al05_put_file_now
{
  my($self, $src_path, $dest_path, $comments) = @_;

  my($task, $task_num, $packet, $size);

  $task_num = $self->_put_file($src_path, $dest_path);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  $size = ${$task->misc()}[0] + ${$task->misc()}[1];

  if(wantarray)
  {
    return($task, $packet->{'HTXF_REF'}, $size);
  }
  else
  {
    return [ $task, $packet->{'HTXF_REF'}, $size ];
  }
}

sub _put_file
{
  my($self, $src_path, $dest_path, $comments) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  croak("Not connected.")  unless($server->opened());

  unless(-e $src_path)
  {
    $self->{'LAST_ERROR'} = "File does not exist: $src_path";
    return;
  }

  my($local_sep, $remote_sep, $src_file, $data, $task_num, $length,
     $num_atoms, $data_len, $rsrc_len, $finder_flags, $type, $creator);

  $local_sep = PATH_SEPARATOR;
  $remote_sep = $self->{'PATH_SEPARATOR'};

  ($src_file = $src_path) =~ s/.*?$local_sep([^$local_sep]+)$/$1/o;
  $dest_path = "$dest_path$remote_sep$src_file";

  ($data, $task_num) = _al09_file_action_stub($self, $dest_path, HTLC_HDR_FILE_PUT);

  # Set new length: old length plus 8 bytes for the size atom
  $length    = (unpack("N", substr($data, 16, 4)) + 8);
  substr($data, 16, 4) = pack("N", $length);
  substr($data, 12, 4) = pack("N", $length);

  # Set new num atoms: old num atoms + 1
  $num_atoms = (unpack("n", substr($data, 20, 2)) + 1);
  substr($data, 20, 2) = pack("n", $num_atoms);

  # Fork lengths
  $data_len = (stat($src_path))[7];
  $rsrc_len = 0;

  # Mac OS specific information: resource fork length and finder comments
  if($self->{'MACOS'})
  {
    my($fsspec, $finder_comments, $res_fd, $rsrc_fh, $cat, $finfo);

    $fsspec = MacPerl::MakeFSSpec($src_path);

    # Get finder comments
    unless(defined($comments))
    {
      $finder_comments = Mac::MoreFiles::FSpDTGetComment($fsspec);
      $comments = $finder_comments  if(length($finder_comments));
    }

    $cat   = Mac::Files::FSpGetCatInfo($fsspec);
    $finfo = $cat->ioFlFndrInfo();

    # Get finder flags, type, and creator
    $finder_flags = $finfo->fdFlags();
    $type         = $finfo->fdType();
    $creator      = $finfo->fdCreator();

    # Protect from compile-time errors on non-Mac OS systems that don't
    # define O_RSRC in Fcntl
    eval '$res_fd = POSIX::open($src_path, O_RDONLY | O_RSRC)';

    $rsrc_fh = new IO::File;

    unless($rsrc_fh->fdopen($res_fd, "r"))
    {
      $self->{'LAST_ERROR'} = "Couldn't open Mac resource fork: $@";
      return;    
    }

    $rsrc_fh->seek(0, SEEK_END);    # Fast forward to end
    $rsrc_len = $rsrc_fh->tell();   # Get size
    $rsrc_fh->seek(0, SEEK_SET);    # Rewind
  }
  else
  {
    ($type, $creator) = ("BINA", "????");
  }

  # Total length of the upload to come: 111 bytes for type/creator/etc.
  # + 1 byte for the file name length + the file name + 2 bytes for the
  # comments length + the comments + 2 fork headers + the size of the
  # file to be uploaded (size of data fork plus size of resource fork).
  $length = (SIZEOF_HL_FILE_UPLOAD_HDR + 1 + length($src_file) + 2 +
             length($comments) + (2 * SIZEOF_HL_FILE_FORK_HDR) +
             $data_len + $rsrc_len);

  # 00 00 00 CB  00 00 00 06  00 00 00 00  00 00 00 21  ...............!
  # 00 00 00 21  00 03 00 C9  00 05 74 65  78 74 32 00  ...!......text2.
  # CA 00 0C 00  01 00 00 07  55 70 6C 6F  61 64 73 00  ........Uploads.
  # 6C 00 02 03  94                                     l....

  # Add size argument
  $data .= pack("nnN", HTLC_DATA_HTXF_SIZE,   # Atom type
                       0x0004,                # Atom length
                       $length);              # Atom data

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: PUT FILE - $task_num\n");
    $self->{'TASKS'}->{$task_num} = 
      new Net::Hotline::Task($task_num, HTLC_TASK_FILE_PUT, time(), undef,
                             [ $src_path, $dest_path ],
                             [ $data_len, $rsrc_len, $comments, $finder_flags,
                               $type, $creator, $length ]);
    return($task_num);
  }
  else { return }
}

sub put_file_resume
{
  my($self, $src_path, $dest_path, $comments) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al01_put_file_resume_now($src_path, $dest_path, $comments); 
  }
  else
  {
    return $self->_al06_put_file_resume($src_path, $dest_path, $comments); 
  }
}

sub _al01_put_file_resume_now
{
  my($self, $src_path, $dest_path, $comments) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_al06_put_file_resume($src_path, $dest_path, $comments);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  if(wantarray)
  {
    return($task, $packet->{'HTXF_REF'}, ${$task->misc()}[6], $packet->{'HTXF_RFLT'});
  }
  else
  {
    return [ $task, $packet->{'HTXF_REF'}, ${$task->misc()}[6], $packet->{'HTXF_RFLT'} ];
  }
}

sub _al06_put_file_resume
{
  my($self, $src_path, $dest_path, $comments) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  croak("Not connected.")  unless($server->opened());

  unless(-e $src_path)
  {
    $self->{'LAST_ERROR'} = "File does not exist: $src_path";
    return;
  }

  my($local_sep, $remote_sep, $src_file, $data, $task_num, $length,
     $num_atoms, $data_len, $rsrc_len, $finder_flags, $type, $creator);

  $local_sep = PATH_SEPARATOR;
  $remote_sep = $self->{'PATH_SEPARATOR'};

  ($src_file = $src_path) =~ s/.*?$local_sep([^$local_sep]+)$/$1/o;
  $dest_path = "$dest_path$remote_sep$src_file";

  ($data, $task_num) = _al09_file_action_stub($self, $dest_path, HTLC_HDR_FILE_PUT);

  # Add upload resume magic
  $data .= HTXF_RESUME_MAGIC;

  # Set new length: old length plus the length of HTXF_RESUME_MAGIC
  $length    = (unpack("N", substr($data, 16, 4)) + length(HTXF_RESUME_MAGIC));
  substr($data, 16, 4) = pack("N", $length);
  substr($data, 12, 4) = pack("N", $length);

  # Set new num atoms: old num atoms + 1
  $num_atoms = (unpack("n", substr($data, 20, 2)) + 1);
  substr($data, 20, 2) = pack("n", $num_atoms);

  # Fork lengths
  $data_len = (stat($src_path))[7];
  $rsrc_len = 0;

  # Mac OS specific information: resource fork length and finder comments
  if($self->{'MACOS'})
  {
    my($fsspec, $finder_comments, $res_fd, $rsrc_fh, $cat, $finfo);

    $fsspec = MacPerl::MakeFSSpec($src_path);

    # Get finder comments
    unless(defined($comments))
    {
      $finder_comments = Mac::MoreFiles::FSpDTGetComment($fsspec);
      $comments = $finder_comments  if(length($finder_comments));
    }

    $cat   = Mac::Files::FSpGetCatInfo($fsspec);
    $finfo = $cat->ioFlFndrInfo();

    # Get finder flags, type, and creator
    $finder_flags = $finfo->fdFlags();
    $type         = $finfo->fdType();
    $creator      = $finfo->fdCreator();

    # Protect from compile-time errors on non-Mac OS systems that don't
    # define O_RSRC in Fcntl
    eval '$res_fd = POSIX::open($src_path, O_RDONLY | O_RSRC)';

    $rsrc_fh = new IO::File;

    unless($rsrc_fh->fdopen($res_fd, "r"))
    {
      $self->{'LAST_ERROR'} = "Couldn't open Mac resource fork: $@";
      return;    
    }

    $rsrc_fh->seek(0, SEEK_END);    # Fast forward to end
    $rsrc_len = $rsrc_fh->tell();   # Get size
    $rsrc_fh->seek(0, SEEK_SET);    # Rewind
  }
  else
  {
    ($type, $creator) = ("BINA", "????");
  }

  # Total length of the upload to come: 111 bytes for type/creator/etc.
  # + 1 byte for the file name length + the file name + 2 bytes for the
  # comments length + the comments + 2 fork headers + the size of the
  # file to be uploaded (size of data fork plus size of resource fork).
  $length = (SIZEOF_HL_FILE_UPLOAD_HDR + 1 + length($src_file) + 2 +
             length($comments) + (2 * SIZEOF_HL_FILE_FORK_HDR) +
             $data_len + $rsrc_len);

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: PUT FILE - $task_num\n");
    $self->{'TASKS'}->{$task_num} = 
      new Net::Hotline::Task($task_num, HTLC_TASK_FILE_PUT, time(), undef,
                             [ $src_path, $dest_path ],
                             [ $data_len, $rsrc_len, $comments, $finder_flags,
                               $type, $creator, $length ]);
    return($task_num);
  }
  else { return }
}

sub al08_get_file
{
  my($self, $path) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al07_get_file_now($path); 
  }
  else
  {
    return $self->_get_file($path); 
  }
}

sub _al07_get_file_now
{
  my($self, $path) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_get_file($path);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  if(wantarray)
  {
    return(($task, $packet->{'HTXF_REF'},  $packet->{'HTXF_SIZE'}));
  }
  else
  {
    return [ $task, $packet->{'HTXF_REF'},  $packet->{'HTXF_SIZE'} ];
  }
}

sub _get_file
{
  my($self, $path) = @_;

  my($local_sep, $remote_sep, $dest_dir, $task_num, $data_file, $rsrc_file);

  $local_sep  = PATH_SEPARATOR;
  $remote_sep = $self->{'PATH_SEPARATOR'};

  $dest_dir = $self->{'DOWNLOADS_DIR'};
  $dest_dir .= $local_sep  if($dest_dir =~ /\S/ && $dest_dir !~ /$local_sep$/o);

  ($data_file = $path) =~ s/.*?$remote_sep([^$remote_sep]+)$/$1/;

  if($self->{'MACOS'})
  {
    $rsrc_file = undef;
  }
  else
  {
    $rsrc_file = "$data_file$self->{'RSRC_FORK_EXT'}";
    $data_file = "$data_file$self->{'DATA_FORK_EXT'}";
  }

  $task_num = _file_action_simple($self, $path, HTLC_HDR_FILE_GET, HTLC_TASK_FILE_GET, 'GET FILE');

  return  unless(defined($task_num));

  $self->{'TASKS'}->{$task_num}->path([ $path, $data_file, $rsrc_file ]);

  return($task_num);
}

sub get_file_resume
{
  my($self, $path) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al02_get_file_resume_now($path); 
  }
  else
  {
    return $self->_al08_get_file_resume($path); 
  }
}

sub _al02_get_file_resume_now
{
  my($self, $path) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_al08_get_file_resume($path);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  if(wantarray)
  {
    return(($task, $packet->{'HTXF_REF'},  $packet->{'HTXF_SIZE'}));
  }
  else
  {
    return [ $task, $packet->{'HTXF_REF'},  $packet->{'HTXF_SIZE'} ];
  }
}

sub _al08_get_file_resume
{
  my($self, $path) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  croak("Not connected.")  unless($server->opened());

  my($local_sep, $remote_sep, $dest_dir, $data, $more_data, $task_num,
     $length, $data_file, $data_pos, $rsrc_file, $rsrc_pos);

  $local_sep  = PATH_SEPARATOR;
  $remote_sep = $self->{'PATH_SEPARATOR'};

  $dest_dir = $self->{'DOWNLOADS_DIR'};
  $dest_dir .= $local_sep  if($dest_dir =~ /\S/ && $dest_dir !~ /$local_sep$/o);

  ($data, $task_num) = _al09_file_action_stub($self, $path, HTLC_HDR_FILE_GET);

  $data_file = $path;
  
  if($data_file =~ /$remote_sep([^$remote_sep]+)$/)
  {
    $data_file = "$dest_dir$1";
  }
  else
  {
    $data_file = "$dest_dir$data_file";
  }

  if($self->{'MACOS'})
  {
    $rsrc_file = undef;
  }
  else
  {
    $rsrc_file = "$data_file$self->{'RSRC_FORK_EXT'}";
    $data_file = "$data_file$self->{'DATA_FORK_EXT'}";
  }

  unless(-e $data_file || -e $rsrc_file)
  {
    $self->{'LAST_ERROR'} = "Can't resume download: partial download does not exist.";
    return;
  }

  # Get data fork position
  $data_pos = (stat($data_file))[7];

  # Get resource fork position
  if($self->{'MACOS'})
  {
    my($res_fd, $rsrc_fh);

    # Protect from compile-time errors on non-Mac OS systems that don't
    # define O_RSRC in Fcntl
    eval '$res_fd = POSIX::open($data_file, O_RDONLY | O_RSRC)';

    $rsrc_fh = new IO::File;

    unless($rsrc_fh->fdopen($res_fd, "r"))
    {
      $self->{'LAST_ERROR'} = "Couldn't open Mac resource fork: $@";
      return;    
    }

    $rsrc_fh->seek(0, SEEK_END);    # Fast forward to end
    $rsrc_pos = $rsrc_fh->tell();   # Get size
    $rsrc_fh->seek(0, SEEK_SET);    # Rewind
  }
  else
  {
    $rsrc_pos = (stat($rsrc_file))[7];
  }

  $length = unpack("N", substr($data, 16, 4));
  $length += 78;

  # Set new length
  substr($data, 12, 4)  = pack("N", $length);
  substr($data, 16, 4) = pack("N", $length);

  # Set new num atoms
  my($num_atoms) = unpack("n", substr($data, 20, 2));
  substr($data, 20, 2) = pack("n", $num_atoms + 1);

  # 00 CB 00 4A  52 46 4C 54  00 01 00 00  00 00 00 00  ...JRFLT........
  # 00 00 00 00  00 00 00 00  00 00 00 00  00 00 00 00  ................
  # 00 00 00 00  00 00 00 00  00 00 00 00  00 02 44 41  ..............DA
  # 54 41 00 00  1B EA 00 00  00 00 00 00  00 00 4D 41  TA............MA
  # 43 52 00 00  00 00 00 00  00 00 00 00  00 00        CR............
  $more_data = pack("x78");

  substr($more_data, 0, 2) = pack("n", HTLC_DATA_RFLT);
  substr($more_data, 2, 2) = pack("n", 0x004A);
  substr($more_data, 4, 4) = HTXF_RFLT_MAGIC;
  substr($more_data, 8, 2) = pack("n", 0x0001);

  substr($more_data, 45, 1) = pack("C", 0x02);
  substr($more_data, 46, 4) = 'DATA';
  substr($more_data, 50, 4) = pack("N", $data_pos);

  substr($more_data, 62, 4) = 'MACR';
  substr($more_data, 66, 4) = pack("N", $rsrc_pos);

  $data .= $more_data;

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: GET FILE - $task_num\n");
    $self->{'TASKS'}->{$task_num} = 
      new Net::Hotline::Task($task_num, HTLC_TASK_FILE_GET, time(), undef, 
                             [ $path, $data_file, $rsrc_file ]);
    return($task_num);
  }
  else { return }
}

sub _al09_file_action_stub
{
  my($self, $path, $type) = @_;

  my($data, @path_parts, $length, $file, $dir_len);

  $path =~ s/^$self->{'PATH_SEPARATOR'}//;
  $path =~ s/$self->{'PATH_SEPARATOR'}$//;
  @path_parts = split($self->{'PATH_SEPARATOR'}, $path);
  $path =~ s/$self->{'PATH_SEPARATOR'}//g;

  if(length($path) > HTLC_MAX_PATHLEN)
  {
    croak("Maximum path length exceeded");
  }

  $file = pop(@path_parts);

  # File part: 2 bytes num atoms, 2 bytes for atom len,
  # 2 bytes for file name length
  $length = (2 + 2 + 2 + length($file));

  if(@path_parts)
  {
    $dir_len = length(join('', @path_parts));
    # Path part: 2 bytes for atom type, 2 bytes for atom len
    # 2 bytes for num path components, and 2 null bytes and
    # 1 byte path part length for each path part
    $length += (2 + 2 + 2 + (3 * @path_parts));
    $length += $dir_len;
  }

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type($type);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len($length);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header();

  $data .= pack("n3a*", @path_parts ? 2 : 1,  # Number of atoms
                        HTLC_DATA_FILE,       # Atom type
                        length($file),        # Atom length
                        $file);               # Atom data

  if(@path_parts)
  {
    $data .= pack("n3", HTLC_DATA_DIRECTORY,  # Atom type
                        $dir_len + 2 + (3 * scalar(@path_parts)),
                                              # Atom length
                        scalar(@path_parts)); # Num path parts

    my($path_part);

    foreach $path_part (@path_parts)          # Path parts data
    {
      if(length($path_part) > HTLC_MAX_PATHLEN)
      {
        croak("Maximum path part length exceeded");
      }

      $data .= pack("nCa*", 0x0000,            # 2 null bytes
                            length($path_part),# Length
                            $path_part);       # Path part
    }
  }

  return($data, $proto_header->seq());
}

sub _file_action_simple
{
  my($self, $path, $type, $task_type, $task_name) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened() && length($path));

  my($data, $task_num) = _al09_file_action_stub($self, $path, $type);

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: $task_name - $task_num\n");
    $self->{'TASKS'}->{$task_num} = 
      new Net::Hotline::Task($task_num, $task_type, time(), undef, $path);
    return($task_num);
  }
  else { return }
}

sub move
{
  my($self, $src_path, $dest_path) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_move_now($src_path, $dest_path); 
  }
  else
  {
    return $self->_move($src_path, $dest_path);
  }
}

sub _move_now
{
  my($self, $src_path, $dest_path) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_move($src_path, $dest_path);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _move
{
  my($self, $src_path, $dest_path) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened() && length($src_path)  && length($dest_path));

  my($data, $task_num, $length, $num_atoms);
  my(@src_path_parts, $save_src_path, $src_file, $src_dir_len);
  my(@dest_path_parts, $save_dest_path, $dest_dir_len);

  # Source:

  $src_path =~ s/^$self->{'PATH_SEPARATOR'}//;
  $src_path =~ s/$self->{'PATH_SEPARATOR'}$//;
  $save_src_path = $src_path;
  @src_path_parts = split($self->{'PATH_SEPARATOR'}, $src_path);
  $src_path =~ s/$self->{'PATH_SEPARATOR'}//g;

  if(length($src_path) > HTLC_MAX_PATHLEN)
  {
    croak("Maximum path length exceeded");
  }

  $src_file = pop(@src_path_parts);

  # Source part: 2 bytes num atoms, 2 bytes for atom type,
  # 2 bytes for file name length
  $length = (2 + 2 + 2 + length($src_file));

  if(@src_path_parts)
  {
    $src_dir_len = length(join('', @src_path_parts));
    # Path part: 2 bytes for atom type, 2 bytes for atom len
    # 2 bytes for num path components, and 2 null bytes and
    # 1 byte path part length for each path part
    $length += (2 + 2 + 2 + (3 * @src_path_parts));
    $length += $src_dir_len;
  }

  # Destination:

  $dest_path =~ s/^$self->{'PATH_SEPARATOR'}//;
  $dest_path =~ s/$self->{'PATH_SEPARATOR'}$//;
  $save_dest_path = $dest_path;
  @dest_path_parts = split($self->{'PATH_SEPARATOR'}, $dest_path);
  $dest_path =~ s/$self->{'PATH_SEPARATOR'}//g;

  if(length($dest_path) > HTLC_MAX_PATHLEN)
  {
    croak("Maximum path length exceeded");
  }

  if(@dest_path_parts)
  {
    $dest_dir_len = length(join('', @dest_path_parts));
    # Path part: 2 bytes for atom type, 2 bytes for atom len
    # 2 bytes for num path components, and 2 null bytes and
    # 1 byte path part length for each path part
    $length += (2 + 2 + 2 + (3 * @dest_path_parts));
    $length += $dest_dir_len;
  }

  # Build packet

  if(@src_path_parts && @dest_path_parts) { $num_atoms = 3 }
  else                                    { $num_atoms = 2 }

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_FILE_MOVE);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len($length);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header();

  $data .= pack("n3a*", $num_atoms,           # Number of atoms
                        HTLC_DATA_FILE,       # Atom type
                        length($src_file),    # Atom length
                        $src_file);           # Atom data

  if(@src_path_parts)
  {
    $data .= pack("n3", HTLC_DATA_DIRECTORY,  # Atom type
                        $src_dir_len + 2 + (3 * scalar(@src_path_parts)),
                                              # Atom length
                        scalar(@src_path_parts));
                                              # Num path parts

    my($path_part);

    foreach $path_part (@src_path_parts)      # Path parts data
    {
      if(length($path_part) > HTLC_MAX_PATHLEN)
      {
        croak("Maximum path part length exceeded");
      }

      $data .= pack("nCa*", 0x0000,           # 2 null bytes
                            length $path_part,# Length
                            $path_part);      # Path part
    }
  }

  if(@dest_path_parts)
  {
    $data .= pack("n3", HTLC_DATA_DESTDIR,    # Atom type
                        $dest_dir_len + 2 + (3 * scalar(@dest_path_parts)),
                                              # Atom length
                        scalar(@dest_path_parts));
                                              # Num path parts

    my($path_part);

    foreach $path_part (@dest_path_parts)     # Path parts data
    {
      if(length($path_part) > HTLC_MAX_PATHLEN)
      {
        croak("Maximum path part length exceeded");
      }

      $data .= pack("nCa*", 0x0000,           # 2 null bytes
                            length $path_part,# Length
                            $path_part);      # Path part
    }
  }

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: MOVE FILE - $task_num\n");
    $self->{'TASKS'}->{$task_num} = 
      new Net::Hotline::Task($task_num, HTLC_TASK_FILE_MOVE, time(),
                         undef, [ $save_src_path, $save_dest_path ]);
    return($task_num);
  }
  else { return }
}

sub rename
{
  my($self, $path, $new_name) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_rename_now($path, $new_name); 
  }
  else
  {
    return $self->_rename($path, $new_name); 
  }
}

sub _rename_now
{
  my($self, $path, $new_name) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->rename($path, $new_name);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _rename
{
  my($self, $path, $new_name) = @_;

  return undef  unless(length($path) && length($new_name));
  return _change_file_info($self, $path, $new_name, undef);
}

sub comment
{
  my($self, $path, $comments) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al13_comment_now($path, $comments); 
  }
  else
  {
    return $self->_comment($path, $comments); 
  }
}

sub _al13_comment_now
{
  my($self, $path, $comments) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->comment($path, $comments);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _comment
{
  my($self, $path, $comments) = @_;

  return undef  unless(length($path));
  $comments = ""  unless(defined($comments));
  return _change_file_info($self, $path, undef, $comments);
}

sub _change_file_info
{
  my($self, $path, $name, $comments) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($data, $task_num, @path_parts, $length, $save_path, $file,
     $dir_len, $num_atoms);

  $path =~ s/^$self->{'PATH_SEPARATOR'}//;
  $path =~ s/$self->{'PATH_SEPARATOR'}$//;
  $save_path = $path;
  @path_parts = split($self->{'PATH_SEPARATOR'}, $path);
  $path =~ s/$self->{'PATH_SEPARATOR'}//g;

  if(length($path) > HTLC_MAX_PATHLEN)
  {
    croak("Maximum path length exceeded");
  }

  $file = pop(@path_parts);

  # File part: 2 bytes for num atoms, 2 bytes for atom type,
  # 2 bytes for file name length
  $length = (2 + 2 + 2 + length($file));

  if(@path_parts)
  {
    $dir_len = length(join('', @path_parts));
    # Path part: 2 bytes for atom type, 2 bytes for atom len
    # 2 bytes for num path components, and 2 null bytes and
    # 1 byte path part length for each path part
    $length += (2 + 2 + 2 + (3 * @path_parts));
    $length += $dir_len;
  }

  if(length($name))
  {
    # Name part: 2 bytes for atom type, 2 bytes for
    # atom len, and the new name
    $length += (2 + 2 + length($name));
  }

  if(defined($comments))
  {
    # Comments part: 2 bytes for atom type, 2 bytes for
    # atom len, length of the new comments, else 1 null
    # byte if removing comments.
    $length += 2 + 2;
    if(length($comments)) { $length += length($comments) }
    else                  { $length += 1                 }
  }

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_FILE_SETINFO);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len($length);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header();

  $num_atoms = (@path_parts) ? 2 : 1;
  $num_atoms++  if(length($name));
  $num_atoms++  if(defined($comments));

  $data .= pack("n3a*", $num_atoms,           # Number of atoms
                        HTLC_DATA_FILE,       # Atom type
                        length($file),        # Atom length
                        $file);               # Atom data

  if(@path_parts)
  {
    $data .= pack("n3", HTLC_DATA_DIRECTORY,  # Atom type
                        $dir_len + 2 + (3 * scalar(@path_parts)),
                                              # Atom length
                        scalar(@path_parts)); # Num path parts

    my($path_part);

    foreach $path_part (@path_parts)          # Path parts data
    {
      if(length($path_part) > HTLC_MAX_PATHLEN)
      {
        croak("Maximum path part length exceeded");
      }

      $data .= pack("nCa*", 0x0000,           # 2 null bytes
                            length $path_part,# Length
                            $path_part);      # Path part
    }
  }

  if(length($name))
  {
    $data .= pack("nna*", HTLC_DATA_FILE_RENAME,# Atom type
                          length($name),      # Length
                          $name);             # Name
  }

  if(defined($comments))
  {
    $data .= pack("n", HTLS_DATA_FILE_COMMENT);# Atom type

    if(length($comments))
    {
      $data .= pack("na*", length($comments), # Length
                           $comments);        # Comments
    }
    else # Remove comments
    {
      $data .=  pack("nx", 0x0001);           # Length + null byte
    }
  }

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: SET INFO - $task_num\n");
    $self->{'TASKS'}->{$task_num} = 
      new Net::Hotline::Task($task_num, HTLC_TASK_SET_INFO, time(), undef, $save_path);
    return($task_num);
  }
  else { return }
}

sub post_news
{
  my($self, @post) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al10_post_news_now(@post); 
  }
  else
  {
    return $self->_post_news(@post); 
  }
}

sub _al10_post_news_now
{
  my($self, @post) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->post_news(@post);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _post_news
{
  my($self, @post) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($post) = join('', @post);

  my($data, $task_num);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_NEWS_POST);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(SIZEOF_HL_SHORT_HDR + length($post));
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n3a*", 0x0001,                # Number of atoms
                       HTLS_DATA_NEWS_POST,   # Atom type
                       length($post),         # Atom length
                       $post);                # Atom data

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: POST NEWS - $task_num\n");
    $self->{'TASKS'}->{$task_num} =
      new Net::Hotline::Task($task_num, HTLC_TASK_NEWS_POST, time());
  }
  else { return }

  return($task_num);
}

sub get_news
{
  my($self) = shift;

  my($task, $task_num, $packet);

  $task_num = $self->req_news();
  $task = $self->{'TASKS'}->{$task_num};

  return(undef)  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return(undef);
  }

  if(wantarray)
  {
    return @{$self->{'NEWS'}};
  }
  else
  {
    return (@{$self->{'NEWS'}}) ? join('_' x 58, @{$self->{'NEWS'}}) : "";
  }
}

sub req_news
{
  my($self) = shift;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($data, $task_num);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_NEWS_GETFILE);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(SIZEOF_HL_TASK_FILLER);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n", 0x0000);

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: NEWS - $task_num\n");
    $self->{'TASKS'}->{$task_num} = 
      new Net::Hotline::Task($task_num, HTLC_TASK_NEWS, time());
    return($task_num);
  }
  else { return }
}

sub al04_user_by_nick
{
  my($self, $nick_match) = @_;

  my($socket, @users);

  eval { m/$nick_match/ };

  return undef  if($@ || !$self->{'USER_LIST'} || length($nick_match) == 0);

  foreach $socket (sort { $a <=> $b } keys(%{$self->{'USER_LIST'}}))
  {
    if($self->{'USER_LIST'}->{$socket}->nick() =~ /^$nick_match$/)
    {
      if(wantarray())
      {
        push(@users, $self->{'USER_LIST'}->{$socket});
      }
      else
      {
        return $self->{'USER_LIST'}->{$socket};
      }
    }
  }

  if(@users) { return @users }
  else       { return }
}

sub user_by_socket
{
  my($self, $socket) = @_;
  return $self->{'USER_LIST'}->{$socket};
}

sub icon
{
  my($self, $icon) = @_;

  return $self->{'ICON'}  unless($icon =~ /^-?\d+$/);

  return _update_user($self, $icon, $self->{'NICK'});
}

sub nick
{
  my($self, $nick) = @_;

  return $self->{'NICK'}  unless(defined($nick));

  return _update_user($self, $self->{'ICON'}, $nick);
}

sub _update_user
{
  my($self, $icon, $nick) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($data);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_USER_CHANGE);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len((SIZEOF_HL_SHORT_HDR * 2) + length($nick));
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n6a*", 0x0002,                # Num atoms

                       HTLC_DATA_ICON,        # Atom type
                       0x0002,                # Atom length
                       $icon,                 # Atom data

                       HTLC_DATA_NICKNAME,    # Atom type
                       length($nick),         # Atom length
                       $nick);                # Atom data

  $self->{'NICK'} = $nick;
  $self->{'ICON'} = $icon;

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    return(1);
  }
  else { return }
}

sub get_userlist
{
  my($self) = shift;

  my($task, $task_num, $packet);

  $task_num = $self->req_userlist();
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return $self->{'USER_LIST'};
}

sub al05_req_userlist
{
  my($self) = shift;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($data, $task_num);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_USER_GETLIST);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(SIZEOF_HL_TASK_FILLER);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n", 0x0000);

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: GET USER LIST - $task_num\n");
    $self->{'TASKS'}->{$task_num} =
      new Net::Hotline::Task($task_num, HTLC_TASK_USER_LIST, time());
    return($task_num);
  }
  else { return }
}

sub kick
{
  my($self, $user_or_socket) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_kick_now($user_or_socket); 
  }
  else
  {
    return $self->_kick($user_or_socket); 
  }
}

sub _kick_now
{
  my($self, $user_or_socket) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_kick($user_or_socket);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _kick
{
  my($self, $user_or_socket) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($socket, $task_num);

  if(ref($user_or_socket)) { $socket = $user_or_socket->socket() }
  else                     { $socket = $user_or_socket           }

  my($data);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_USER_KICK);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(SIZEOF_HL_LONG_HDR);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n4", 0x0001,                  # Num atoms

                     HTLC_DATA_SOCKET,        # Atom type
                     0x0002,                  # Atom length
                     $socket);                # Atom data

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: KICK($socket) - $task_num\n");
    $self->{'TASKS'}->{$task_num} =
      new Net::Hotline::Task($task_num, HTLC_TASK_KICK, time());
  }
  else { return }

  return ($task_num);
}

sub ban
{
  my($self, $user_or_socket) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_ban_now($user_or_socket); 
  }
  else
  {
    return $self->_ban($user_or_socket); 
  }
}

sub _ban_now
{
  my($self, $user_or_socket) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_ban($user_or_socket);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _ban
{
  my($self, $user_or_socket) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($socket, $task_num);

  if(ref($user_or_socket)) { $socket = $user_or_socket->socket() }
  else                     { $socket = $user_or_socket           }

  my($data);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_USER_KICK);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(SIZEOF_HL_LONG_HDR + 6);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n7", 0x0002,                  # Num atoms

                     HTLC_DATA_SOCKET,        # Atom type
                     0x0002,                  # Atom length
                     $socket,                 # Atom data

                     HTLC_DATA_BAN,           # Atom type
                     0x0002,                  # Atom length
                     0x0001);                 # Atom data (always 1???)

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: BAN($socket) - $task_num\n");
    $self->{'TASKS'}->{$task_num} =
      new Net::Hotline::Task($task_num, HTLC_TASK_BAN, time());
  }
  else { return }
  
  return ($task_num);
}

sub msg
{
  my($self, $user_or_socket, @message) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_msg_now($user_or_socket, @message); 
  }
  else
  {
    return $self->_msg($user_or_socket, @message); 
  }
}

sub _msg_now
{
  my($self, $user_or_socket, @message) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_msg($user_or_socket, @message);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _msg
{
  my($self, $user_or_socket, @message) = @_;

  my($message) = join('', @message);

  $message =~ s/\n/@{[HTLC_NEWLINE]}/osg;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($socket);

  if(ref($user_or_socket)) { $socket = $user_or_socket->socket() }
  else                     { $socket = $user_or_socket           }

  my($data, $task_num);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_MSG);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len((SIZEOF_HL_SHORT_HDR * 2) +
                     length($message));
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n6", 0x0002,                  # Num atoms

                     HTLC_DATA_SOCKET,        # Atom type
                     0x0002,                  # Atom length
                     $socket,                 # Atom data

                     HTLC_DATA_MSG,           # Atom type
                     length($message)) .      # Atom length
          $message;                           # Atom data

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: MSG - $task_num\n");
    $self->{'TASKS'}->{$task_num} =
      new Net::Hotline::Task($task_num, HTLC_TASK_SEND_MSG, time());
  }
  else { return }

  return($task_num);
}

sub chat_action
{
  my($self, @message) = @_;

  my($message) = join('', @message);

  $message =~ s/\n/@{[HTLC_NEWLINE]}/osg;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($data);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_CHAT);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len((SIZEOF_HL_SHORT_HDR  * 2) +
                     length($message));
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n6", 0x0002,                  # Num atoms

                     HTLC_DATA_OPTION,        # Atom type
                     0x0002,                  # Atom length
                     0x0001,                  # Atom data

                     HTLC_DATA_CHAT,          # Atom type
                     length($message)) .      # Atom length
          $message;                           # Atom data

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    return(1);
  }
  else { return }
}

sub chat
{
  my($self, @message) = @_;

  my($message) = join('', @message);

  $message =~ s/\n/@{[HTLC_NEWLINE]}/osg;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  my($data);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_CHAT);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(SIZEOF_HL_SHORT_HDR +
                     length($message));
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header() .
          pack("n3", 0x0001,                  # Num atoms

                     HTLC_DATA_CHAT,          # Atom type
                     length($message)) .      # Atom length
          $message;                           # Atom data

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    return(1);
  }
  else { return }
}

sub send_file
{
  my($self, $task, $ref, $size, $resume) = @_;

  my($server, $port, $data, $xfer, $length, $buf_size);
  my($local_sep, $remote_sep, $filename, $src_path, $dest_path);
  my($type, $creator, $created, $modified, $finder_flags,  $comments,
     $data_fh, $rsrc_fh, $data_len, $rsrc_len, $data_pos, $rsrc_pos,
     $res_fd);

  $task->finish(undef);

  $local_sep = PATH_SEPARATOR;

  $buf_size = $self->{'HTXF_BUFSIZE'};

  if($resume)
  {
    # 52 46 4c 54  00 01 00 00  00 00 00 00  00 00 00 00  RFLT............
    # 00 00 00 00  00 00 00 00  00 00 00 00  00 00 00 00  ................
    # 00 00 00 00  00 00 00 00  00 02 44 41  54 41 00 06  ..........DATA..
    # 9a cf 00 00  00 00 00 00  00 00 4d 41  43 52 00 00  ..........MACR..
    # 00 00 00 00  00 00 00 00  00 00                     ..........

    unless(substr($resume, 0, 4) eq 'RFLT')
    {
      $task->error(1);
      $task->finish(time());
      $task->error_text("Bad data from server!");
      $self->{'LAST_ERROR'} = $task->error_text();
      return;
    }

    $data_pos = unpack("N", substr($resume, 46, 4));
    $rsrc_pos = unpack("N", substr($resume, 62, 4));
  }

  $data_fh = new IO::File;
  $rsrc_fh = new IO::File;

  ($src_path, $dest_path) = @{$task->path()};

  ($filename = $src_path) =~ s/^.*?$local_sep([^$local_sep]+)$/$1/;

  ($data_len, $rsrc_len, $comments, $finder_flags, $type, $creator, $length)
    = @{$task->misc()};

  unless($data_fh->open($src_path))
  {
    $task->error(1);
    $task->finish(time());
    $task->error_text("Could not open to $src_path: $!");
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  if($self->{'MACOS'})
  {
    # Protect from compile-time errors on non-Mac OS systems that don't
    # define O_RSRC in Fcntl
    eval '$res_fd = POSIX::open($src_path, O_RDONLY | O_RSRC)';

    unless($rsrc_fh->fdopen($res_fd, "r"))
    {
      $task->error(1);
      $task->finish(time());
      $task->error_text("Could not read to resource fork from $src_path: $!");
      $self->{'LAST_ERROR'} = $task->error_text();
      return;
    }
  }
  elsif($rsrc_len > 0 || ($resume && $rsrc_pos > 0))
  {
    $task->error(1);
    $task->finish(time());
    $task->error_text("Server is expecting resource fork data from a non-Mac OS client!\n" .
                      "Are you sure you're uploading the right file?");
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  if($resume)
  {
    if($rsrc_pos > 0)
    {
      unless($rsrc_fh->seek($rsrc_pos, 0))
      {
        $task->error(1);
        $task->finish(time());
        $task->error_text("Could not seek to position $rsrc_pos in resource fork of $src_path: $!");
        $self->{'LAST_ERROR'} = $task->error_text();
        return;
      }
    }

    if($data_pos > 0)
    {
      unless($data_fh->seek($data_pos, 0))
      {
        $task->error(1);
        $task->finish(time());
        $task->error_text("Could not seek to position $data_pos in $src_path: $!");
        $self->{'LAST_ERROR'} = $task->error_text();
        return;
      }
    }
  }

  ($created, $modified) = (stat($src_path))[9,10];

  unless($self->{'MACOS'})
  {
    $created  += HTLC_UNIX_TO_MACOS_TIME;
    $modified += HTLC_UNIX_TO_MACOS_TIME;
  }

  $data = HTXF_MAGIC . pack("NNx4", $ref, ($length - $rsrc_pos - $data_pos));

  $server = $self->{'SERVER_ADDR'};

  # HTXF_TCPPORT only if server port is 5500
  $port = $self->{'SERVER_PORT'} + 1; 

  unless($xfer = IO::Socket::INET->new(PeerAddr =>$server,
                                       PeerPort =>$port,
                                       Timeout  =>$self->{'CONNECT_TIMEOUT'},
                                       Proto    =>'tcp'))
  {
    $task->finish(time());
    $task->error_text("Could not open file transfer connection: $@");
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  _debug(_hexdump($data));

  unless(_hlc_write($self, $xfer, \$data, length($data)))
  {
    $xfer->close();
    $task->error(1);
    $task->finish(time());
    $task->error_text($self->{'LAST_ERROR'});
    return;
  }

  # 46 49 4c 50  00 01 00 00  00 00 00 00  00 00 00 00  FILP............
  # 00 00 00 00  00 00 00 03  49 4e 46 4f  00 00 00 00  ........INFO....
  # 00 00 00 00  00 00 00 5c  41 4d 41 43  53 49 54 44  .......\AMACSITD
  # 53 49 54 21  00 00 00 00  00 00 21 00  00 00 00 00  SIT!......!.....
  # 00 00 00 00  00 00 00 00  00 00 00 00  00 00 00 00  ................
  # 00 00 00 00  00 00 00 00  00 00 00 00  00 07 70 00  ..............p.
  # 00 b1 ce 81  92 07 70 00  00 02 df 7d  3d 00 00 00  ......p....}=...

  # 12 53 77 6f  6f 70 20 46  41 51 2e 74  65 78 74 2e  .Swoop FAQ.text.
  # 73 69 74 00  00 44 41 54  41 00 00 00  00 00 00 00  sit..DATA.......
  # 00 00 00 59  5c                                     ...Y\
  $data = pack("a4nx16na4x8Na4a4a4x6nx32nx2Nnx2NN",
               "FILP", 0x0001, 0x0003, "INFO",
               length($comments) + length($filename) + 74,
               "AMAC", $type, $creator, $finder_flags, 0x0770,
               $created, 0x0770, $modified, length($filename));

  $data .= $filename .
           pack("n", length($comments)) .
           $comments .
           pack("a4x8N", "DATA", ($data_len - $data_pos));

  _debug(_hexdump($data));

  unless(_hlc_write($self, $xfer, \$data, length($data)))
  {
    $xfer->close();
    $task->error(1);
    $task->finish(time());
    $task->error_text($self->{'LAST_ERROR'});
    return;
  }

  # Upload data fork
  unless($self->_upload($xfer, $data_fh, $data_len, $buf_size))
  {
    $xfer->close();
    $task->error(1);
    $task->finish(time());
    $task->error_text("Upload did not complete.");
  }

  # 4D 41 43 52  00 00 00 00  00 00 00 00  00 00 01 EC  MACR............
  $data = pack("a4x8N", "MACR", ($rsrc_len - $rsrc_pos));

  _debug(_hexdump($data));

  unless(_hlc_write($self, $xfer, \$data, length($data)))
  {
    $xfer->close();
    $task->error(1);
    $task->finish(time());
    $task->error_text($self->{'LAST_ERROR'});
    return;
  }

  if($rsrc_len > 0)
  {
    # Upload resource fork
    unless($self->_upload($xfer, $rsrc_fh, $rsrc_len, $buf_size))
    {
      $xfer->close();
      $task->error(1);
      $task->finish(time());
      $task->error_text("Upload did not complete.");
      return;
    }
  }

  return(1);
}

sub recv_file
{
  my($self, $task, $ref, $size) = @_;

  my($server, $data, $xfer, $tot_length, $length, $buf_size, @ret);
  my($data_file, $rsrc_file, $type, $creator, $created, $modified,
     $finder_flags,  $comments, $comments_len, $data_fh, $data_len,
     $rsrc_fh, $rsrc_len, $name_len, $real_mac_res_fork, $res_fd,
     $finished_file, $port);

  $tot_length = $size;

  $buf_size = $self->{'HTXF_BUFSIZE'};

  $data_fh = new IO::File;
  $rsrc_fh = new IO::File;

  ($data_file, $rsrc_file) = @{$task->path()}[1, 2];

  if($self->{'MACOS'})
  {
    if(length($data_file) > MACOS_MAX_FILENAME)
    {
      for($data_file)
      {
        my($len) = MACOS_MAX_FILENAME - 6;
        
        # Try to preserve filename extension, if any
        # ("\xC9" is "..." in Mac OS)
        # Otherwise, just truncate
        s/^(.{$len}).*?\.(\w{1,4})/$1\xC9.$2/o ||
        s/^(.@{[MACOS_MAX_FILENAME]}).*/$1/;
      }
    }
  }

  unless($data_fh->open(">>$data_file"))
  {
    $task->error(1);
    $task->finish(time());
    $task->error_text("Could not write to $data_file: $!");
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  if($self->{'MACOS'})
  {
    # Protect from compile-time errors on non-Mac OS systems that don't
    # define O_RSRC in Fcntl
    eval '$res_fd = POSIX::open($data_file, O_WRONLY | O_CREAT | O_RSRC)';
  }

  # If we're on Mac OS and we can write directly to the resource fork
  if(defined($res_fd) && $rsrc_fh->fdopen($res_fd, "w"))
  {
    $real_mac_res_fork = 1;
    # Temporarily set file type and creator to Hotline's "partial download"
    MacPerl::SetFileInfo(HTXF_PARTIAL_CREATOR, HTXF_PARTIAL_TYPE, $data_file);
  }
  else
  {
    unless($rsrc_fh->open(">>$rsrc_file"))
    {
      $task->error(1);
      $task->finish(time());
      $task->error_text("Could not write to $rsrc_file: $!");
      $self->{'LAST_ERROR'} = $task->error_text();
      return;
    }
  }

  $task->finish(undef);

  $server = $self->{'SERVER_ADDR'};

  $data = HTXF_MAGIC . pack("Nx8", $ref);

  # HTXF_TCPPORT only if server port is 5500
  $port = $self->{'SERVER_PORT'} + 1; 

  unless($xfer = IO::Socket::INET->new(PeerAddr =>$server,
                                       PeerPort =>$port,
                                       Timeout  =>$self->{'CONNECT_TIMEOUT'},
                                       Proto    =>'tcp'))
  {
    $task->finish(time());
    $task->error_text("Could not open file transfer connection: $@");
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  unless(_hlc_write($self, $xfer, \$data, length($data)))
  {
    $xfer->close();
    $task->error(1);
    $task->finish(time());
    $task->error_text($self->{'LAST_ERROR'});
    return;
  }

  # 46 49 4C 50  00 01 00 00  00 00 00 00  00 00 00 00  FILP............
  # 00 00 00 00  00 00 00 03  49 4E 46 4F  00 00 00 00  ........INFO....
  # 00 00 00 00  00 00 00 60                            .......`
  unless(_hlc_buffered_read($self, $xfer, \$data, SIZEOF_HL_FILE_XFER_HDR))
  {
    $xfer->close();
    $task->error(1);
    $task->finish(time());
    $task->error_text($self->{'LAST_ERROR'});
    return;
  }

  $tot_length -= SIZEOF_HL_FILE_XFER_HDR;
  $length = (unpack("N", substr($data, 36, 4)) + SIZEOF_HL_FILE_FORK_HDR);

  unless(substr($data, 0, 4) eq 'FILP')
  {
    $xfer->close();
    $task->error(1);
    $task->finish(time());
    $task->error_text("Bad data from server!");
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  #                           41 4D 41 43  54 45 58 54          AMACTEXT
  # 74 74 78 74  00 00 00 00  00 00 01 00  00 00 00 00  ttxt............
  # 00 00 00 00  00 00 00 00  00 00 00 00  00 00 00 00  ................
  # 00 00 00 00  00 00 00 00  00 00 00 00  07 70 00 00  .............p..
  # AE A3 8A 18  07 70 00 00  AE A3 8C 1D  00 00 00 05  .....p..........
  # 74 65 78 74  32 00 11 66  74 70 2E 6D  69 63 72 6F  text2..ftp.micro
  # 73 6F 66 74  2E 63 6F 6D  44 41 54 41  00 00 00 00  soft.comDATA....
  # 00 00 00 00  00 00 01 00                            ........

  unless(_hlc_buffered_read($self, $xfer, \$data, $length))
  {
    $xfer->close();
    $task->error(1);
    $task->finish(time());
    $task->error_text($self->{'LAST_ERROR'});
    return;
  }

  $tot_length -= $length;

  $type     = substr($data, 4, 4);
  $creator  = substr($data, 8, 4);

  $created      = unpack("N", substr($data, 56, 4));
  $finder_flags = substr($data, 18, 2);
  $modified     = unpack("N", substr($data, 64, 4));
  $name_len     = unpack("C", substr($data, 71, 1));
  $comments_len = unpack("n", substr($data, 72 + $name_len, 2)); # 72
  $comments = substr($data, 72 + $name_len + 2, $comments_len);

  $data_len = unpack("N", substr($data, -4));
  $length = $self->_download($xfer, $data_fh, $data_len, $buf_size);
  $tot_length -= $length;
  $data_fh->close();

  unless($length == $data_len)
  {
    $xfer->close();
    $task->error(1);
    $task->finish(time());
    $task->error_text("Download incomplete.");
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  # Yet another server bug: it'll tell you it's going to send a resource
  # fork header even when the file has no resource fork (i.e. $size will
  # be SIZEOF_HL_FILE_FORK_HDR bytes larger than the data the server will
  # actually send).  So we only try to read if we have more than
  # SIZEOF_HL_FILE_FORK_HDR left.
  if($tot_length > SIZEOF_HL_FILE_FORK_HDR)
  {
    # 4D 41 43 52  00 00 00 00  00 00 00 00  00 00 01 EC  MACR............
    $length = _hlc_buffered_read($self, $xfer, \$data, SIZEOF_HL_FILE_FORK_HDR);

    return  unless($length);
    $tot_length -= $length;

    $rsrc_len = unpack("N", substr($data, -4));
    $length = $self->_download($xfer, $rsrc_fh, $rsrc_len, $buf_size);
    $tot_length -= $length;
    $rsrc_fh->close();

    unless($length == $rsrc_len)
    {
      $xfer->close();
      $task->error(1);
      $task->finish(time());
      $task->error_text("Download incomplete.");
      $self->{'LAST_ERROR'} = $task->error_text();
      return;
    }
  }
  else
  {
    $tot_length = 0;
    $rsrc_len = 0;
  }

  $xfer->close();

  unless($tot_length == 0)
  {
    $task->error(1);
    $task->finish(time());
    $task->error_text("Tried to download $size bytes, got " .
                      $size - $tot_length . " bytes instead.");
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  $data_len = (stat($data_file))[7];
  $rsrc_len = (stat($rsrc_file))[7];

  unless($rsrc_len)
  {
    unlink($rsrc_file)  if(-e $rsrc_file);
    undef $rsrc_file;
    $rsrc_len = 0;
  }

  unless($data_len || $real_mac_res_fork)
  {
    unlink($data_file)  if(-e $data_file);
    undef $data_file;
    $data_len = 0;
  }

  $task->finish(time());

  # Set the rest of the Mac OS information if we're doing that sort of thing
  if(($real_mac_res_fork && -e $data_file))
  {
    utime($created, $modified, $data_file);

    my($fsspec) = MacPerl::MakeFSSpec($data_file);

    if(length($comments))
    {
      Mac::MoreFiles::FSpDTSetComment($fsspec, $comments);
    }

    my($cat)   = Mac::Files::FSpGetCatInfo($fsspec);
    my($finfo) = $cat->ioFlFndrInfo();

    $finfo->fdFlags(unpack("n", $finder_flags) & 0xFEFF);
    $finfo->fdType($type);
    $finfo->fdCreator($creator);
    $cat->ioFlFndrInfo($finfo);
    Mac::Files::FSpSetCatInfo($fsspec, $cat);

    # Rename data file to remove the .data part
    ($finished_file = $data_file) =~ s/$self->{'DATA_FORK_EXT'}$//;
    unless(CORE::rename($data_file, $finished_file))
    {
      $task->error_text(qq(Could not rename "$data_file" to "$finished_file": $!));
      $self->{'LAST_ERROR'} = $task->error_text();
      return;
    }

    # Return a sigle true value rather than an array of parameters
    # to indicate that you can't call macbinary() if we've already
    # made a Mac file.
    return(1);
  }
  elsif(! -e $rsrc_file)
  {
    ($finished_file = $data_file) =~ s/$self->{'DATA_FORK_EXT'}$//;
    CORE::rename($data_file, $finished_file);
    $data_file = $finished_file;
  }

  return [ $data_file, $data_len,
           $rsrc_file, $rsrc_len,
           $buf_size, $type, $creator, $comments,
           $created, $modified, $finder_flags ];
}

sub _download
{
  my($self, $src_fh, $dest_fh, $len, $buf_size) = @_;

  my($data, $tot_read, $read);

  $tot_read = 0;

  if($len <= $buf_size)
  {
    $read = read($src_fh, $data, $len);
    return  unless(defined($read));
    print $dest_fh $data || return;
    $tot_read += $read;
  }
  else
  {
    my($loop)     = int($len/$buf_size);
    my($leftover) = $len % $buf_size;

    for(; $loop > 0; $loop--)
    {
      $read = read($src_fh, $data, $buf_size);
      return  unless(defined($read));
      print $dest_fh $data || return;
      $tot_read += $read;
    }

    if($leftover > 0)
    {
      $read = read($src_fh, $data, $leftover);
      return  unless(defined($read));
      print $dest_fh $data || return;
      $tot_read += $read;
    }
  }

  unless($tot_read == $len)
  {
    croak("Tried to read $len bytes, actually read $tot_read.  Download may be corrupted!");
  }

  return($tot_read);
}

sub _upload
{
  my($self, $dest_fh, $src_fh, $len, $buf_size) = @_;

  my($data);

  if($len <= $buf_size)
  {
    unless(defined(read($src_fh, $data, $len))) { return }
    _hlc_write($self, $dest_fh, \$data, length($data)) || return;
  }
  else
  {
    my($loop)     = int($len/$buf_size);
    my($leftover) = $len % $buf_size;

    for(; $loop > 0; $loop--)
    {
      unless(defined(read($src_fh, $data, $buf_size))) { return }
      _hlc_write($self, $dest_fh, \$data, length($data)) || return;
    }

    if($leftover > 0)
    {
      unless(defined(read($src_fh, $data, $leftover))) { return }
      _hlc_write($self, $dest_fh, \$data, length($data)) || return;
    }
  }

  return(1);
}

sub macbinary
{
  my($self) = shift  if(ref($_[0]));

  my($macbin_file, $params) = @_;

  unless(ref($params) =~ /^ARRAY/ && @{$params} == 11)
  {
    croak("Incorrect arguments to macbinary()");
  }

  my($data_file, $data_len,
     $rsrc_file, $rsrc_len,
     $buf_size, $type, $creator, $comments,
     $created, $modified, $finder_flags) = @{$params};

  my($finished_file, $filename, $macbin_fh, $data_fh, $rsrc_fh,
     $macbin_hdr, $buf, $len, $pad);

  unless($rsrc_len > 0 || $data_len > 0)
  {
    $self->{'LAST_ERROR'} = "No resource or data fork length."  if($self);
    $! = "No resource or data fork length.";
    return;
  }

  if(defined($data_file))
  {
    ($finished_file = $data_file) =~ s/$self->{'DATA_FORK_EXT'}$//;
  }
  elsif(defined($rsrc_file))
  {
    ($finished_file = $rsrc_file) =~ s/$self->{'RSRC_FORK_EXT'}$//;
  }
  else
  {
    croak "Bad arguments to macbinary() - No rsrc or data file arguments.";
  }

  $finished_file =~ /([^@{[PATH_SEPARATOR]}]+)$/o;
  $filename = $1;

  unless(length($macbin_file))
  {
    $macbin_file .= "$finished_file.bin";
  }

  if(-e $macbin_file)
  {
    $self->{'LAST_ERROR'} = "$macbin_file: file already exists."  if($self);
    $! = "$macbin_file: file already exists.";
    return;
  }

  $buf_size = 4096  unless($buf_size =~ /^\d+$/);

  $macbin_fh = new IO::File;
  $data_fh   = new IO::File;
  $rsrc_fh   = new IO::File;

  unless($macbin_fh->open(">$macbin_file"))
  {
    $self->{'LAST_ERROR'} = $!  if($self);
    return;
  }

  $macbin_hdr = pack("x128"); # Start with empty 128 byte header

  # Offset 000-Byte, old version number, must be kept at zero for compatibility

  # Offset 001-Byte, Length of filename (must be in the range 1-63)
  substr($macbin_hdr, 1, 1) = pack("C", length($filename));

  # Offset 002-1 to 63 chars, filename (only "length" bytes are significant).
  substr($macbin_hdr, 2, length($filename)) = $filename;

  # Offset 065-Long Word, file type (normally expressed as four characters)
  substr($macbin_hdr, 65, 4) = $type;

  # Offset 069-Long Word, file creator (normally expressed as four characters)
  substr($macbin_hdr, 69, 4) = $creator;

  # Offset 073-Byte, original Finder flags
  #     Bit 7 - Locked.
  #     Bit 6 - Invisible.
  #     Bit 5 - Bundle.
  #     Bit 4 - System.
  #     Bit 3 - Bozo.
  #     Bit 2 - Busy.
  #     Bit 1 - Changed.
  #     Bit 0 - Inited.
  substr($macbin_hdr, 73, 1) =             # Clear inited bit
    pack("C", unpack("C", substr($finder_flags, 0, 1)) & 0xFE);

  # Offset 074-Byte, zero fill, must be zero for compatibility

  # Offset 075-Word, file's vertical position within its window.
  substr($macbin_hdr, 75, 2) = pack("n", 0xFFFF);

  # Offset 077-Word, file's horizontal position within its window.
  substr($macbin_hdr, 77, 2) = pack("n", 0xFFFF);

  # Offset 079-Word, file's window or folder ID.
  # Offset 081-Byte, "Protected" flag (in low order bit).
  # Offset 082-Byte, zero fill, must be zero for compatibility

  # Offset 083-Long Word, Data Fork length (bytes, zero if no Data Fork).
  substr($macbin_hdr, 83, 4) = pack("N", $data_len);

  # Offset 087-Long Word, Resource Fork length (bytes, zero if no R.F.).
  substr($macbin_hdr, 87, 4) = pack("N", $rsrc_len);

  # Offset 091-Long Word, File's creation date
  substr($macbin_hdr, 91, 4) = pack("N", $created);

  # Offset 095-Long Word, File's "last modified" date.
  substr($macbin_hdr, 95, 4) = pack("N", $modified);

  # Offset 099-Word, length of Get Info comment to be sent after the resource fork
  #            (if implemented, see below).
  # Offset 101-Byte, Finder Flags, bits 0-7. (Bits 8-15 are already in byte 73)
  # Offset 116-Long Word, Length of total files when packed files are unpacked.
  #            This is only used by programs that pack and unpack on the fly,
  #            mimicing a standalone utility such as PackIt. A program that is
  #            uploading a single file must zero this location when sending a
  #            file. Programs that do not unpack/uncompress files when
  #            downloading may ignore this value.
  substr($macbin_hdr, 116, 4) = pack("N", $data_len + $rsrc_len);

  # Offset 120-Word, Length of a secondary header. If this is non-zero,
  #            Skip this many bytes (rounded up to the next multiple of 128)
  #            This is for future expansion only, when sending files with
  #            MacBinary, this word should be zero.

  # Offset 122-Byte, Version number of Macbinary II that the uploading program
  # is written for (the version begins at 129)
  substr($macbin_hdr, 122, 1) = pack("C", 129);

  # Offset 123-Byte, Minimum MacBinary II version needed to read this file
  # (start this value at 129 129)
  substr($macbin_hdr, 123, 1) = pack("C", 129);

  # Offset 124-Word, CRC of previous 124 bytes
  substr($macbin_hdr, 124, 2) = pack("n", macbin_crc(substr($macbin_hdr, 0, 124), 0));

  # Macbinary II header
  print $macbin_fh $macbin_hdr;

  # Data fork, null padded to a multiple of 128 bytes
  if($data_len)
  {
    unless($data_fh->open($data_file))
    {
      $self->{'LAST_ERROR'} = $!  if($self);
      return;
    }

    while($len = read($data_fh, $buf, $buf_size))
    {
      croak("read() error: $!")  unless(defined($len));
      print $macbin_fh $buf;
    }
    $data_fh->close();

    if($data_len % 128)
    {
      $pad = "x" . (128 - ($data_len % 128));
      print $macbin_fh pack($pad);
    }
  }

  # Resource fork, null padded to a multiple of 128 bytes
  if($rsrc_len)
  {
    unless($rsrc_fh->open($rsrc_file))
    {
      $self->{'LAST_ERROR'} = $!  if($self);
      return;
    }

    while($len = read($rsrc_fh, $buf, $buf_size))
    {
      croak("read() error: $!")  unless(defined($len));
      print $macbin_fh $buf;      
    }
    $rsrc_fh->close();

    if($rsrc_len % 128)
    {
      $pad = "x" . (128 - ($rsrc_len % 128));
      print $macbin_fh pack($pad);
    }
  }

  $macbin_fh->close();

  return(1);
}

sub tracker
{
  $_[0]->{'TRACKER_ADDR'} = $_[1]  if(@_ == 2);
  return $_[0]->{'TRACKER_ADDR'};
}

sub tracker_list
{
  my($self, $timeout) = @_;

  my($tracker, $tracker_address, $server, $port, @servers, $data,
     $num_servers, $length, $tli_ip, $tli_port, $tli_num_users,
     $tli_name, $tli_desc, $byte1);

  $tracker_address = $self->{'TRACKER_ADDR'};

  unless($tracker_address =~ /\S/)
  {
    croak("Tracker address not set!");
  }

  if(($server = $tracker_address) =~ s/^([^ :]+)(?:[: ](\d+))?$/$1/)
  {
    $port = $2 || HTRK_TCPPORT;
  }
  else
  {
    croak("Bad server address: $tracker_address");
  }

  $timeout = $self->{'CONNECT_TIMEOUT'}  unless(defined($timeout));

  eval
  {
    $SIG{'ALRM'} = sub { die "timeout" };
    alarm($timeout);
  
    $tracker = IO::Socket::INET->new(PeerAddr =>$server,
                                     PeerPort =>$port,
                                     Timeout  =>$timeout,
                                     Proto    =>'tcp');
    alarm(0);
    $SIG{'ALRM'} = 'DEFAULT';
  };

  if($@ =~ /timeout/)
  {
    $self->{'LAST_ERROR'} = "Timed out after $timeout seconds.";
    return;
  }

  if(!$tracker || $@)
  {
    $self->{'LAST_ERROR'} = $@ || $! || 'Connection failed';
    return;
  }

  # 48 54 52 4B  00 01                                  HTRK..
  _hlc_write($self, $tracker, \HTRK_MAGIC, HTRK_MAGIC_LEN) || return;

  # 48 54 52 4B  00 01                                  HTRK..
  _hlc_buffered_read($self, $tracker, \$data, HTRK_MAGIC_LEN) || return;

  unless($data eq HTRK_MAGIC)
  {
    $self->{'LAST_ERROR'} = "Bad data from tracker.  Not a hotline tracker?";
    return;
  }

  # 00 01 1F F5  00 53 00 4A  | D1 9C 4B 86  15 7C 00 04  .....S.J..K..|..
  # ^^^^^^^^^^^  ^^^^^ ^^^^^  | ^^^^^^^^^^^  ^^^^^ ^^^^^
  # ???????????    |   ?????  | IP Address   Port  num users ...
  #              num servers  |
  _hlc_buffered_read($self, $tracker, \$data, 8) || return;

  $num_servers = unpack("n", substr($data, 4, 2));

  # Bug fixes here thanks to Les Brown <Les@hotlinecentral.com>
  while(@servers < $num_servers)
  {
    # 4 bytes for IP, 2 bytes for port, 2 bytes for num users
    unless(_hlc_buffered_read($self, $tracker, \$data, 4 + 2 + 2))
    {
      $tracker->close()  if($tracker->opened());
      return  unless(@servers);
      return (wantarray) ? @servers : \@servers;
    }

    # Skip these 8 bytes if the first byte was zero
    $byte1 = unpack("C", substr($data, 0, 1));
    next  if($byte1 == 0);

    $tli_ip        = join('.', map { unpack("C", $_) } split('', substr($data, 0, 4)));
    $tli_port      = unpack("n", substr($data, 4, 2));
    $tli_num_users = unpack("n", substr($data, 6, 2));

    # 2 null bytes, 1 byte for name len
    unless(_hlc_buffered_read($self, $tracker, \$data, 2 + 1))
    {
      $tracker->close()  if($tracker->opened());
      return  unless(@servers);
      return (wantarray) ? @servers : \@servers;
    }

    $length = unpack("C", substr($data, 2, 1));

    # $length bytes for name, 1 byte for description length
    unless(_hlc_buffered_read($self, $tracker, \$data, $length + 1))
    {
      $tracker->close()  if($tracker->opened());
      return  unless(@servers);
      return (wantarray) ? @servers : \@servers;
    }

    $length = unpack("C", chop($tli_name = $data));

    # $length bytes for description
    unless(_hlc_buffered_read($self, $tracker, \$tli_desc, $length))
    {
      $tracker->close()  if($tracker->opened());
      return  unless(@servers);
      return (wantarray) ? @servers : \@servers;
    }

    push(@servers, new Net::Hotline::TrackerListItem($tli_ip,
                                                     $tli_port,
                                                     $tli_num_users,
                                                     $tli_name,
                                                     $tli_desc));
  }

  $tracker->close()  if($tracker->opened());

  return (wantarray) ? @servers : \@servers;
}

sub pchat_invite
{
  my($self, $socket, $ref) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al11_pchat_invite_now($socket, $ref);
  }
  else
  {
    return $self->_pchat_invite($socket, $ref);
  }
}

sub _al11_pchat_invite_now
{
  my($self, $socket, $ref) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_pchat_invite($socket, $ref);
  $task = $self->{'TASKS'}->{$task_num};

  return(1)  if(defined($ref));

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _pchat_invite
{
  my($self, $socket, $ref) = @_;

  my($data, $proto_header, $length, $task_num, $create);

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened());

  $create = defined($ref);

  # 8 bytes for socket atom + 6 or 8 bytes for pchat ref atom (optional)
  $length = 8 + (defined($ref)) ? (($ref > 0xFFFF) ? 8 : 6) : 0;

  $proto_header = new Net::Hotline::Protocol::Header;

  $proto_header->type(($create) ? HTLC_HDR_PCHAT_CREATE :
                                  HTLC_HDR_PCHAT_INVITE);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len($length);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header();

  # Socket of the user we're inviting
  $data .= pack("nnnn", ($create) ? 2 : 1,    # Num atoms
                        HTLC_DATA_SOCKET,     # Atom type
                        0x0002,               # Atom length
                        $socket);             # Atom value

  unless($create)
  {
    my($fmt) = ($ref > 0xFFFF) ? "nnN" : "nnn";

    # Private chat reference number
    $data .= pack($fmt, HTLC_DATA_PCHAT_REF,  # Atom type
                       ($ref > 0xFFFF) ? 4 :2,# Atom length
                       $ref);                 # Atom value
  }

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if($create)
  {
    if(_hlc_write($self, $server, \$data, length($data)))
    {
      _debug("NEW TASK: PCHAT INVITE/CREATE - $task_num\n");
      $self->{'TASKS'}->{$task_num} =
        new Net::Hotline::Task($task_num,HTLC_TASK_PCHAT_CREATE, time());
    }
    else { return }

    return($task_num);
  }
  else
  {
    if(_hlc_write($self, $server, \$data, length($data)))
    {
      _debug("PCHAT INVITE SOCKET($socket) TO PCHAT($ref)\n");
      return(1);
    }
    else { return }
  }
}

sub pchat_accept
{
  my($self, $ref) = @_;

  if($self->{'BLOCKING_TASKS'})
  {
    return $self->_al12_pchat_accept_now($ref);
  }
  else
  {
    return $self->_pchat_accept($ref);
  }
}

sub _al12_pchat_accept_now
{
  my($self, $ref) = @_;

  my($task, $task_num, $packet);

  $task_num = $self->_pchat_accept($ref);
  $task = $self->{'TASKS'}->{$task_num};

  return  unless($task_num);

  $packet = _blocking_task($self, $task_num);

  if($task->error())
  {
    $self->{'LAST_ERROR'} = $task->error_text();
    return;
  }

  return(1);
}

sub _pchat_accept
{
  my($self, $ref) = @_;

  my($data, $proto_header, $task_num);

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened() && defined($ref));

  $proto_header = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_PCHAT_ACCEPT);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(($ref > 0xFFFF) ? 10 : 8);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header();

  my($fmt) = ($ref > 0xFFFF) ? "nnnN" : "nnnn";

  # Pchat ref number atom
  $data .= pack($fmt, 0x0001,                 # Num atoms
                      HTLC_DATA_PCHAT_REF,    # Atom type
                      ($ref > 0xFFFF) ? 4 : 2,# Atom length
                      $ref);                  # Atom value

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    _debug("NEW TASK: PCHAT ACCEPT($ref) - $task_num\n");
    $self->{'TASKS'}->{$task_num} =
      new Net::Hotline::Task($task_num, HTLC_TASK_PCHAT_ACCEPT, time(), undef, undef, $ref);
  }
  else { return }

  return($task_num);
}

sub pchat_decline
{
  my($self, $ref) = @_;

  my($data, $proto_header, $task_num, $length);

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened() && defined($ref));

  $proto_header = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_PCHAT_DECLINE);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(($ref > 0xFFFF) ? 10 : 8);
  $proto_header->len2($proto_header->len);

  $data = $proto_header->header();

  my($fmt) = ($ref > 0xFFFF) ? "nnnN" : "nnnn";

  # Pchat ref number atom
  $data .= pack($fmt, 0x0001,                 # Num atoms
                      HTLC_DATA_PCHAT_REF,    # Atom type
                      ($ref > 0xFFFF) ? 4 : 2,# Atom length
                      $ref);                  # Atom value

  _debug(_hexdump($data));

  $task_num = $proto_header->seq();

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    return(1);
  }
  else { return }
}

sub al07_pchat_action
{
  my($self, $ref, @message) = @_;

  my($message) = join('', @message);

  $message =~ s/\n/@{[HTLC_NEWLINE]}/osg;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened() && defined($ref));

  my($data);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_CHAT);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len((($ref > 0xFFFF) ? 20 : 18) + length($message));
  $proto_header->len2($proto_header->len);

  my($fmt) = ($ref > 0xFFFF) ? "n6Nnn" : "n9";

  $data = $proto_header->header() .
          pack($fmt, 0x0003,                  # Num atoms

                     HTLC_DATA_OPTION,        # Atom type
                     0x0002,                  # Atom length
                     0x0001,                  # Atom data

                     HTLC_DATA_PCHAT_REF,     # Atom type
                     ($ref > 0xFFFF) ? 4 : 2, # Atom length
                     $ref,                    # Atom value

                     HTLC_DATA_CHAT,          # Atom type
                     length($message)) .      # Atom length
          $message;                           # Atom data

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    return(1);
  }
  else { return }
}

sub pchat
{
  my($self, $ref, @message) = @_;

  my($message) = join('', @message);

  $message =~ s/\n/@{[HTLC_NEWLINE]}/osg;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened() && defined($ref));

  my($data);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_CHAT);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len((($ref > 0xFFFF) ? 14 : 12) + length($message));
  $proto_header->len2($proto_header->len);

  my($fmt) = ($ref > 0xFFFF) ? "n3Nnn" : "n6";

  $data = $proto_header->header() .
          pack($fmt, 0x0002,                  # Num atoms

                     HTLC_DATA_PCHAT_REF,     # Atom type
                     ($ref > 0xFFFF) ? 4 : 2, # Atom length
                     $ref,                    # Atom value

                     HTLC_DATA_CHAT,          # Atom type
                     length($message)) .      # Atom length
          $message;                           # Atom data

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    return(1);
  }
  else { return }
}

sub pchat_leave
{
  my($self, $ref) = @_;

  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened() && defined($ref));

  my($data);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_PCHAT_CLOSE);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len(($ref > 0xFFFF) ? 10 : 8);
  $proto_header->len2($proto_header->len);

  my($fmt) = ($ref > 0xFFFF) ? "n3N" : "n4";

  $data = $proto_header->header() .
          pack($fmt, 0x0001,                  # Num atoms

                     HTLC_DATA_PCHAT_REF,     # Atom type
                     ($ref > 0xFFFF) ? 4 : 2, # Atom length
                     $ref);                   # Atom value

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    delete $self->{'PCHATS'}->{$ref};
    return(1);
  }
  else { return }
}

sub pchat_subject
{
  my($self, $ref, @subject) = @_;
  
  my($server) = $self->{'SERVER'} or croak "Not connected to a server";
  return  unless($server->opened() && defined($ref));

  my($subject) = join('', @subject);

  my($data);

  my($proto_header) = new Net::Hotline::Protocol::Header;

  $proto_header->type(HTLC_HDR_PCHAT_SUBJECT);
  $proto_header->seq($self->_next_seqnum());
  $proto_header->task(0x00000000);
  $proto_header->len((($ref > 0xFFFF) ? 14 : 12) + length($subject));
  $proto_header->len2($proto_header->len);

  my($fmt) = ($ref > 0xFFFF) ? "n3Nnn" : "n6";

  $data = $proto_header->header() .
          pack($fmt, 0x0002,                  # Num atoms

                     HTLC_DATA_PCHAT_REF,     # Atom type
                     ($ref > 0xFFFF) ? 4 : 2, # Atom length
                     $ref,                    # Atom value

                     HTLC_DATA_PCHAT_SUBJECT, # Atom type
                     length($subject)) .      # Atom length
          $subject;                           # Atom value

  _debug(_hexdump($data));

  if(_hlc_write($self, $server, \$data, length($data)))
  {
    return(1);
  }
  else { return }
}

1;