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;