The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Net::LPR;

use 5.00500;
use strict;

use Carp;
use Socket;
use IO::Socket;
use IO::Socket::INET;
use Sys::Hostname;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION = '1.007';

my %valid_options = (
    StrictRFCPorts => 1,
    RemoteServer => 1,
    RemotePort => 1,
    PrintErrors => 1,
    RaiseErrors => 1,
);

# Modes:
#   1 == ROOT command
#   2 == JOB command
#   3 == DATA command

sub new {

    my $class = shift;
    
    my $k;
    
    for $k (keys %{{ @_ }}) {
        croak "Invalid argument to Net::LPR->new: '$k'" unless exists($valid_options{$k});
    }
    
    my $self = {
        StrictRFCPorts => 1,
        RemoteServer => "localhost",
        RemotePort => 515,
        PrintErrors => 0,
        RaiseErrors => 0,

        Socket => undef,
        Jobs => {},        
        LastError => "",
        Mode => 0,

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

sub _report {

    my $self = shift;
    my $prob = shift;
    my @cinfo = caller(1);
    my $func = reverse $cinfo[3];
    
    $func =~ s/::.*//g;
    $func = reverse $func;
    my $err = "$func: $prob";
    
    $self->{LastError} = $err;
    print STDERR ($err) if ($self->{PrintErrors});
    croak ($err) if ($self->{RaiseErrors});
}

sub error {

    croak 'Usage: $lp->error()' if (@_ != 1);

    my $self = shift;

    return $self->{LastError};
}

sub disconnect {

    croak 'Usage: $lp->disconnect()' if (@_ != 1);

    my $self = shift;
    
    undef $self->{Socket};
    
    $self->{Jobs} = {};
    
    return 1;
}

sub connect {

    croak 'Usage: $lp->connect()' if (@_ != 1);

    my $self = shift;

    if ($self->connected()) {
        return 1;
    }

    my $sock;

    if ($self->{StrictRFCPorts}) {
        my $port;
        for $port (721..731) {
            $sock = new IO::Socket::INET (
                PeerAddr => $self->{RemoteServer},
                PeerPort => $self->{RemotePort},
                LocalPort => $port,
                Proto => 'tcp',
                ReuseAddr => 1,
            );
            last if (defined($sock));
            last unless ($! =~ /in use|bad file number/i);
        }
        unless (defined($sock)) {
            if ($!) {
                $self->_report("Can't establish connection to remote printer ($!)");
            } else {
                $self->_report("Can't establish connection to remote printer (No local ports available)");
            }
            return undef;
        }
    } else {
        $sock = new IO::Socket::INET (
            PeerAddr => $self->{RemoteServer},
            PeerPort => $self->{RemotePort},
            Proto => 'tcp',
            ReuseAddr => 1,
        );
        unless (defined($sock)) {
            $self->_report("Can't establish connection to remote printer ($!)");
            return undef;
        }
    }
    
    $sock->autoflush(0);
    
    $self->{Socket} = $sock;
    $self->{Mode} = 1;
    
    return 1;
}

sub connected {

    croak 'Usage: $lp->connected()' if (@_ != 1);

    my $self = shift;

    undef $self->{Socket} if (defined($self->{Socket}) && ! $self->{Socket}->opened());

    return defined($self->{Socket});
}

# Daemon commands

sub print_waiting_jobs {

    croak 'Usage: $lp->print_waiting_jobs($queue)' if (@_ != 2);

    my $self = shift;

    unless ($self->connected()) {
        $self->_report("Not connected");
        return undef;
    }

    unless ($self->{Mode} == 1) {
        $self->_report("Not in ROOT command mode");
        return undef;
    }

    my $queue = shift;
    
    $queue =~ s/[\000-\040\200-\377]//g;
    
    $self->{Socket}->print("\001$queue\n") or do {
        $self->_report("Error sending command ($!)");
        return undef;
    };
    $self->{Socket}->flush() or do {
        $self->_report("Error flushing buffer ($!)");
        return undef;
    };
    
    return $self->disconnect();
}

sub send_jobs {

    croak 'Usage: $lp->send_jobs($queue)' if (@_ != 2);
    my $self = shift;

    unless ($self->connected()) {
        $self->_report("Not connected");
        return undef;
    }

    unless ($self->{Mode} == 1) {
        $self->_report("Not in ROOT command mode");
        return undef;
    }

    my $queue = shift;
    
    $queue =~ s/[\000-\040\200-\377]//g;
    
    $self->{Socket}->print("\002$queue\n") or do {
        $self->_report("Error sending command ($!)");
        return undef;
    };
    
    $self->{Socket}->flush() or do {
        $self->_report("Error flushing buffer ($!)");
        return undef;
    };
    
    my $result;
    
    $result = $self->{Socket}->getc();
    
    if (length($result)) {
        $result = unpack("C", $result);
    } else {
        $self->_report("Error getting result ($!)");
        return undef;
    };
    
    if ($result != 0) {
        $self->_report("Printer reported an error ($result)");
        return undef;
    }
    
    $self->{Mode} = 2;
    
    return 1;
}

sub get_queue_state {

    croak 'Usage: $lp->get_queue_state($queue [, $longflag [, @items]])' if (@_ < 2);
    
    my $self = shift;
    
    unless ($self->connected()) {
        $self->_report("Not connected");
        return undef;
    }

    unless ($self->{Mode} == 1) {
        $self->_report("Not in ROOT command mode");
        return undef;
    }

    my $queue = shift;
    
    $queue =~ s/[\000-\040\200-\377]//g;

    my $longflag = shift || 0;
    
    my $cmd = $longflag ? "\004" : "\003";

    $self->{Socket}->print("$cmd$queue ") or do {
        $self->_report("Error sending command ($!)");
        return undef;
    };

    my $item;
    
    while (defined($item = shift)) {

        $item =~ s/[\000-\040\200-\377]//g;

        $self->{Socket}->print("$item ") or do {
            $self->_report("Error sending item ($!)");
            return undef;
        };
    }
    
    $self->{Socket}->print("\n") or do {
        $self->_report("Error sending command ($!)");
        return undef;
    };

    $self->{Socket}->flush() or do {
        $self->_report("Error flushing buffer ($!)");
        return undef;
    };
    
    my $response = "";
    my $line;
    
    while (defined($line = $self->{Socket}->getline())) {
        $response .= $line;
    }
    
    return ( $self->disconnect() || undef ) && $response;
}

sub remove_jobs {

    croak 'Usage: $lp->remove_jobs($queue, $username [, @items])' if (@_ < 3);
    
    my $self = shift;
    
    unless ($self->connected()) {
        $self->_report("Not connected");
        return undef;
    }

    unless ($self->{Mode} == 1) {
        $self->_report("Not in ROOT command mode");
        return undef;
    }

    my $queue = shift;
    $queue =~ s/[\000-\040\200-\377]//g;
    
    my $username = shift;
    $username =~ s/[\000-\040\200-\377]//g;

    $self->{Socket}->print("\005$queue $username") or do {
        $self->_report("Error sending command ($!)");
        return undef;
    };

    my $item;
    
    while (defined($item = shift)) {

        $item =~ s/[\000-\040\200-\377]//g;

        $self->{Socket}->print(" $item") or do {
            $self->_report("Error sending item ($!)");
            return undef;
        };
    }
    
    $self->{Socket}->print("\n") or do {
        $self->_report("Error sending command ($!)");
        return undef;
    };
    
    $self->{Socket}->flush() or do {
        $self->_report("Error flushing buffer ($!)");
        return undef;
    };

    return $self->disconnect();
}

#
# Job subcommands
#

sub job_abort {

    croak 'Usage: $lp->job_abort()' if (@_ != 1);
    
    my $self = shift;
    
    unless ($self->connected()) {
        $self->_report("Not connected");
        return undef;
    }

    unless ($self->{Mode} == 2) {
        $self->_report("Not in JOB command mode");
        return undef;
    }

    $self->{Jobs} = {};

    $self->{Socket}->print("\001\n") or do {
        $self->_report("Error sending command ($!)");
        return undef;
    };
    
    $self->{Socket}->flush() or do {
        $self->_report("Error flushing buffer ($!)");
        return undef;
    };
    
    my $result;
    
    $result = $self->{Socket}->getc();
    
    if (length($result)) {
        $result = unpack("C", $result);
    } else {
        $self->_report("Error getting result ($!)");
        return undef;
    };
    
    if ($result != 0) {
        $self->_report("Printer reported an error ($result)");
        return undef;
    }

    return 1;
}

my $g_job_id = 0;

sub new_job {

    croak 'Usage: $jobkey = $lp->new_job([$jobid [, $jobhostname]])' if (@_ < 1 || @_ > 3);

    my $self = shift;
    my $jobid = shift;
    
    $jobid = $g_job_id unless (defined($jobid));
    
    if ($jobid !~ /^\d+$/ || $jobid > 999) {
        $self->_report("Invalid Job ID specified");
        return undef;
    }
    
    $g_job_id = ($jobid + 1) % 1000;

    my $jobname = shift;
    
    $jobname = hostname() unless (defined($jobname));
    
    $jobname =~ s/[\000-\040\200-\377]//g;
    
    my $jobkey = sprintf('%03d%s', $jobid, $jobname);
    
    if (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Duplicate Job ID specified");
        return undef;
    }
    
    my $user;
    
    if ($^O eq 'MSWin32') {
    	$user = getlogin();
    } else {
    	$user = scalar(getpwuid($>));
    }
    
    $self->{Jobs}->{$jobkey} = {
        JobID => $jobid,
        Jobname => $jobname,
        SentControl => 0,
        SentData => 0,
        UsedDataFileName => 0,
        ControlFileName => "cfA$jobkey",
        DataFileName => "dfA$jobkey",
        PrintingMode => '',
        DataSize => 0,
        DataSent => 0,
        CE => {
            H => hostname(),
            P => $user,
        },
    };
    
    return $jobkey;
}

sub job_get_data_filename {

    croak 'Usage: $lp->job_get_data_filename($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    return $self->{Jobs}->{$jobkey}->{DataFileName};
}

sub job_set_data_filename {

    croak 'Usage: $lp->job_set_data_filename($jobkey, $filename)' unless (@_ == 3);
    
    my $self = shift;
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentData}) {
        $self->_report("Already sent data file for '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{UsedDataFileName}) {
        $self->_report("Already referenced existing data file name for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    if (length($text) < 1) {
        $self->_report("File name must be at least one character");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{DataFileName} = $text;

    return 1;
}

sub job_get_control_filename {

    croak 'Usage: $lp->job_get_control_filename($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    return $self->{Jobs}->{$jobkey}->{ControlFileName};
}

sub job_set_control_filename {

    croak 'Usage: $lp->job_set_control_filename($jobkey, $filename)' unless (@_ == 3);
    
    my $self = shift;
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{UsedDataFileName}) {
        $self->_report("Already referenced existing data file name for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    if (length($text) < 1) {
        $self->_report("File name must be at least one character");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{ControlFileName} = $text;

    return 1;
}

sub job_set_banner_class {

    croak 'Usage: $lp->job_set_banner_class($jobkey, $text)' unless (@_ == 3);
    
    my $self = shift;
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 32) {
        $self->_report("Banner Class is too long (31 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("Banner Class is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{C} = $text;

    return 1;
}

sub job_set_hostname {

    croak 'Usage: $lp->job_set_hostname($jobkey, $hostname)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 32) {
        $self->_report("Hostname is too long (31 octet limit)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{H} = $text;

    return 1;
}

sub job_set_banner_name {

    croak 'Usage: $lp->job_set_banner_name($jobkey, $name)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 100) {
        $self->_report("Banner Name is too long (99 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("Banner Name is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{J} = $text;

    return 1;
}

sub job_enable_banner_page {

    croak 'Usage: $lp->job_enable_banner_page($jobkey, $username)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 32) {
        $self->_report("Banner User Name is too long (31 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("Banner User Name is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{L} = $text;

    return 1;
}

sub job_mail_when_printed {

    croak 'Usage: $lp->job_mail_when_printed($jobkey, $username)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 32) {
        $self->_report("Mail User Name is too long (31 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("Mail User Name is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{M} = $text;

    return 1;
}

sub job_set_source_filename {

    croak 'Usage: $lp->job_set_source_filename($jobkey, $filename)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 132) {
        $self->_report("Filename is too long (131 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("Filename is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{N} = $text;

    return 1;
}

sub job_set_user_id {

    croak 'Usage: $lp->job_set_user_id($jobkey, $username)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 32) {
        $self->_report("User Name is too long (31 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("User Name is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{P} = $text;

    return 1;
}

sub job_set_symlink_data {

    croak 'Usage: $lp->job_set_symlink_data($jobkey, $dev, $inode)' unless (@_ == 4);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $dev = shift;
    my $inode = shift;
    
    unless ($dev =~ /^\d+$/ && $inode =~ /^\d+$/) {
        $self->_report("Expected numeric arguments");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{S} = "$dev $inode";

    return 1;
}

sub job_unlink {

    croak 'Usage: $lp->job_unlink($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    $self->{Jobs}->{$jobkey}->{UsedDataFileName} = 1;
    
    $self->{Jobs}->{$jobkey}->{CE}->{P} = $self->{Jobs}->{$jobkey}->{DataFileName};

    return 1;
}

sub job_set_troff_r_font {

    croak 'Usage: $lp->job_set_troff_r_font($jobkey, $filename)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 256) {
        $self->_report("File Name is too long (255 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("File Name is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{1} = $text;

    return 1;
}

sub job_set_troff_i_font {

    croak 'Usage: $lp->job_set_troff_i_font($jobkey, $filename)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 256) {
        $self->_report("File Name is too long (255 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("File Name is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{2} = $text;

    return 1;
}

sub job_set_troff_b_font {

    croak 'Usage: $lp->job_set_troff_b_font($jobkey, $filename)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 256) {
        $self->_report("File Name is too long (255 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("File Name is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{3} = $text;

    return 1;
}

sub job_set_troff_s_font {

    croak 'Usage: $lp->job_set_troff_s_font($jobkey, $filename)' unless (@_ == 3);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $text = shift;

    $text =~ s/[\000-\040\200-\377]//g;
    
    unless (length($text) < 256) {
        $self->_report("File Name is too long (255 octet limit)");
        return undef;
    }
    
    unless (length($text) > 0) {
        $self->_report("File Name is too short (1 octet minimum)");
        return undef;
    }
    
    $self->{Jobs}->{$jobkey}->{CE}->{4} = $text;

    return 1;
}

sub job_mode_cif {

    croak 'Usage: $lp->job_mode_cif($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
        delete $job->{CE}->{$f};
    }
    
    $job->{PrintFormat} = 'c';
     
    $job->{CE}->{c} = $job->{DataFileName};

    return 1;    
}

sub job_mode_dvi {

    croak 'Usage: $lp->job_mode_dvi($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
        delete $job->{CE}->{$f};
    }
    
    $job->{PrintFormat} = 'd';
     
    $job->{CE}->{d} = $job->{DataFileName};

    return 1;    
}

sub job_mode_text {

    croak 'Usage: $lp->job_mode_text($jobkey [, $width [, $indentation [, $nofilter]]])' unless (@_ >= 2 && @_ <= 5);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $width = shift;
    
    if (defined($width) && $width !~ /^\d+$/) {
        $self->_report("Width argument must be numeric");
        return undef;
    }
    
    my $indentation = shift;

    if (defined($indentation) && $indentation !~ /^\d+$/) {
        $self->_report("Indentation argument must be numeric");
        return undef;
    }
    
    my $nofilter = shift;
    
    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
        delete $job->{CE}->{$f};
    }
    
    if (defined($nofilter) && $nofilter) {
        $f = 'l';
    } else {
        $f = 'f';
    }
    
    $job->{PrintFormat} = $f;
     
    $job->{CE}->{$f} = $job->{DataFileName};
    $job->{CE}->{W} = $width if (defined($width));
    $job->{CE}->{I} = $indentation if (defined($indentation));

    return 1;    
}

sub job_mode_plot {

    croak 'Usage: $lp->job_mode_plot($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f');
        delete $job->{CE}->{$f};
    }
    
    $job->{PrintFormat} = 'g';
     
    $job->{CE}->{g} = $job->{DataFileName};

    return 1;    
}

sub job_mode_ditroff {

    croak 'Usage: $lp->job_mode_ditroff($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
        delete $job->{CE}->{$f};
    }
    
    $job->{PrintFormat} = 'n';
     
    $job->{CE}->{n} = $job->{DataFileName};

    return 1;    
}

sub job_mode_postscript {

    croak 'Usage: $lp->job_mode_postscript($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
        delete $job->{CE}->{$f};
    }
    
    $job->{PrintFormat} = 'o';
     
    $job->{CE}->{o} = $job->{DataFileName};

    return 1;    
}

sub job_mode_pr {

    croak 'Usage: $lp->job_mode_pr($jobkey [, $title [, $width]])' unless (@_ >= 2 && @_ <= 4);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $title = shift;
    
    if (defined($title)) {
        $title =~ s/[\000-\040\200-\377]//g;
        if (length($title) < 0) {
            $self->_report("Title too short (1 octet minimum)");
            return undef;
        } 
        if (length($title) > 79) {
            $self->_report("Title too long (79 octet maximum)");
        }
    }
    
    my $width = shift;
    
    if (defined($width) && $width !~ /^\d+$/) {
        $self->_report("Width argument must be numeric");
        return undef;
    }

    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
        delete $job->{CE}->{$f};
    }
    
    $job->{PrintFormat} = 'p';
     
    $job->{CE}->{p} = $job->{DataFileName};
    $job->{CE}->{T} = $title if (defined($title));
    $job->{CE}->{W} = $width if (defined($width));

    return 1;    
}

sub job_mode_fortran {

    croak 'Usage: $lp->job_mode_fortran($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
        delete $job->{CE}->{$f};
    }
    
    $job->{PrintFormat} = 't';
     
    $job->{CE}->{t} = $job->{DataFileName};

    return 1;    
}

sub job_mode_troff {

    croak 'Usage: $lp->job_mode_troff($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
        delete $job->{CE}->{$f};
    }
    
    $job->{PrintFormat} = 't';
     
    $job->{CE}->{t} = $job->{DataFileName};

    return 1;    
}

sub job_mode_raster {

    croak 'Usage: $lp->job_mode_raster($jobkey)' unless (@_ == 2);
    
    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    my $job = $self->{Jobs}->{$jobkey};

    my $f = $job->{PrintFormat};

    $job->{UsedDataFileName} = 1;
    
    if (defined($f) && length($f)) {
        delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
        delete $job->{CE}->{T} if ($f eq 'p');
        delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
        delete $job->{CE}->{$f};
    }
    
    $job->{PrintFormat} = 'v';
     
    $job->{CE}->{v} = $job->{DataFileName};

    return 1;    
}

sub job_send_control_file {

    croak 'Usage: $lp->job_send_control_file($jobkey)' unless (@_ == 2);

    my $self = shift;
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentControl}) {
        $self->_report("Already sent control file for '$jobkey'");
        return undef;
    }

    unless ($self->{Mode} == 2) {
        $self->_report("Not in JOB command mode");
        return undef;
    }

    my $cf = "";
    
    my $k;

    my $result;
    
    for $k (qw(C H I J M N P S T U W L 1 2 3 4 c d f g k l n o p r t v z)) {
        next unless (exists($self->{Jobs}->{$jobkey}->{CE}->{$k}));
        $cf .= $k . $self->{Jobs}->{$jobkey}->{CE}->{$k} . "\n";
    }

    $self->{Socket}->print("\002".length($cf)." ".$self->{Jobs}->{$jobkey}->{ControlFileName}."\n") or do {
        $self->_report("Error sending command ($!)");
        return undef;
    };
    
    $self->{Socket}->flush() or do {
        $self->_report("Error flushing buffer ($!)");
        return undef;
    };

    $result = $self->{Socket}->getc();
    
    if (length($result)) {
        $result = unpack("C", $result);
    } else {
        $self->_report("Error getting result ($!)");
        return undef;
    };
    
    if ($result != 0) {
        $self->_report("Printer reported an error ($result)");
        return undef;
    }

    $self->{Socket}->print("$cf\000") or do {
        $self->_report("Error sending control file ($!)");
        return undef;
    };
    
    $self->{Socket}->flush() or do {
        $self->_report("Error flushing buffer ($!)");
        return undef;
    };

    $result = $self->{Socket}->getc();
    
    if (length($result)) {
        $result = unpack("C", $result);
    } else {
        $self->_report("Error getting result ($!)");
        return undef;
    };
    
    if ($result != 0) {
        $self->_report("Printer reported an error ($result)");
        return undef;
    }

    $self->{Jobs}->{$jobkey}->{SentControl} = 1;
}

sub job_send_data {

    croak 'Usage: $lp->job_send_data($jobkey, $data [, $totalsize])' unless (@_ >= 1);
    
    my $self = shift;
    
    if ($self->{Mode} == 2) {
        croak 'JOB Mode Usage: $lp->job_send_data($jobkey, $data [, $totalsize])' unless (@_ >= 2 && @_ <= 3);
    } elsif ($self->{Mode} == 3) {
        croak 'DATA Mode Usage: $lp->job_send_data($jobkey, $data)' unless (@_ == 2);
    } else {
        $self->_report("Not in JOB or DATA command mode");
    }
    
    my $jobkey = shift;
    
    unless (exists($self->{Jobs}->{$jobkey})) {
        $self->_report("Nonexistant Job Key '$jobkey'");
        return undef;
    }

    if ($self->{Jobs}->{$jobkey}->{SentData}) {
        $self->_report("Already sent data file for '$jobkey'");
        return undef;
    }
    
    my $data = shift;

    my $totalsize = shift;

    if (defined($totalsize) && $totalsize !~ /^\d+$/) {
        $self->_report("Size argument must be numeric");
        return undef;
    }

    if ($self->{Mode} == 2) {

	if (defined($totalsize)) {
            $self->{Socket}->print("\003$totalsize ".$self->{Jobs}->{$jobkey}->{DataFileName}."\n") or do {
        	$self->_report("Error sending command ($!)");
        	return undef;
            };
	} else {
            $self->{Socket}->print("\003 ".$self->{Jobs}->{$jobkey}->{DataFileName}."\n") or do {
        	$self->_report("Error sending command ($!)");
        	return undef;
            };
        }

        $self->{Socket}->flush() or do {
            $self->_report("Error flushing buffer ($!)");
            return undef;
        };

        my $result;

        $result = $self->{Socket}->getc();

        if (defined($result) && length($result)) {
            $result = unpack("C", $result);
        } else {
            $self->_report("Error getting result ($!)");
            return undef;
        };

        if ($result != 0) {
            $self->_report("Printer reported an error ($result)");
            return undef;
        }

        $self->{Jobs}->{$jobkey}->{DataSize} = $totalsize if (defined($totalsize));
        $self->{Mode} = 3;        
        $self->{Jobs}->{$jobkey}->{UsedDataFileName} = 1;
    }
    
    if ($self->{Mode} != 3) {
        $self->_report("Can't send data in this mode");
        return undef;
    }
    
    my $job = $self->{Jobs}->{$jobkey};

    my $dsize = length($data);

    if ($job->{DataSize} > 0 && $dsize + $job->{DataSent} > $job->{DataSize}) {
        $data = substr($data, 0, $job->{DataSize} - $job->{DataSent});
    }
    
    if (length($data) > 0) {
        $self->{Socket}->print($data) or do {
            $self->_report("Error sending data ($!)");
            return undef;
        };
    }
    
    $job->{DataSent} += length($data);
    
    if ($job->{DataSent} >= $job->{DataSize}) {

        $job->{SentData} = 1;

        if ($job->{SentControl}) {
            delete $self->{Jobs}->{$jobkey};
        }
        
        $self->{Socket}->print("\000") or do {
            $self->_report("Error sending data ($!)");
            return undef;
        };
        
        $self->{Socket}->flush() or do {
            $self->_report("Error flushing buffer ($!)");
            return undef;
        };

        my $result;

        $result = $self->{Socket}->getc();

        if (length($result)) {
            $result = unpack("C", $result);
        } else {
            $self->_report("Error getting result ($!)");
            return undef;
        };

        if ($result != 0) {
            $self->_report("Printer reported an error ($result)");
            return undef;
        }
    }
    
    if ($dsize != length($data)) {
        $self->_report("Data overflow error");
        return undef;
    }
    
    return 1;
}

1;