File Coverage

blib/lib/Net/LPR.pm
Criterion Covered Total %
statement 24 867 2.7
branch 0 504 0.0
condition 0 164 0.0
subroutine 8 49 16.3
pod 25 40 62.5
total 57 1624 3.5


line stmt bran cond sub pod time code
1             package Net::LPR;
2              
3 1     1   5876 use 5.00500;
  1         4  
  1         38  
4 1     1   7 use strict;
  1         1  
  1         29  
5              
6 1     1   4 use Carp;
  1         19  
  1         57  
7 1     1   832 use Socket;
  1         3986  
  1         471  
8 1     1   829 use IO::Socket;
  1         24290  
  1         5  
9 1     1   1188 use IO::Socket::INET;
  1         3  
  1         11  
10 1     1   1969 use Sys::Hostname;
  1         1427  
  1         64  
11              
12 1     1   7 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         2  
  1         10340  
13              
14             $VERSION = '1.007';
15              
16             my %valid_options = (
17             StrictRFCPorts => 1,
18             RemoteServer => 1,
19             RemotePort => 1,
20             PrintErrors => 1,
21             RaiseErrors => 1,
22             );
23              
24             # Modes:
25             # 1 == ROOT command
26             # 2 == JOB command
27             # 3 == DATA command
28              
29             sub new {
30              
31 0     0 1   my $class = shift;
32            
33 0           my $k;
34            
35 0           for $k (keys %{{ @_ }}) {
  0            
36 0 0         croak "Invalid argument to Net::LPR->new: '$k'" unless exists($valid_options{$k});
37             }
38            
39 0           my $self = {
40             StrictRFCPorts => 1,
41             RemoteServer => "localhost",
42             RemotePort => 515,
43             PrintErrors => 0,
44             RaiseErrors => 0,
45              
46             Socket => undef,
47             Jobs => {},
48             LastError => "",
49             Mode => 0,
50              
51             @_
52             };
53            
54 0           bless $self, $class;
55            
56 0           return $self;
57             }
58              
59             sub _report {
60              
61 0     0     my $self = shift;
62 0           my $prob = shift;
63 0           my @cinfo = caller(1);
64 0           my $func = reverse $cinfo[3];
65            
66 0           $func =~ s/::.*//g;
67 0           $func = reverse $func;
68 0           my $err = "$func: $prob";
69            
70 0           $self->{LastError} = $err;
71 0 0         print STDERR ($err) if ($self->{PrintErrors});
72 0 0         croak ($err) if ($self->{RaiseErrors});
73             }
74              
75             sub error {
76              
77 0 0   0 1   croak 'Usage: $lp->error()' if (@_ != 1);
78              
79 0           my $self = shift;
80              
81 0           return $self->{LastError};
82             }
83              
84             sub disconnect {
85              
86 0 0   0 1   croak 'Usage: $lp->disconnect()' if (@_ != 1);
87              
88 0           my $self = shift;
89            
90 0           undef $self->{Socket};
91            
92 0           $self->{Jobs} = {};
93            
94 0           return 1;
95             }
96              
97             sub connect {
98              
99 0 0   0 1   croak 'Usage: $lp->connect()' if (@_ != 1);
100              
101 0           my $self = shift;
102              
103 0 0         if ($self->connected()) {
104 0           return 1;
105             }
106              
107 0           my $sock;
108              
109 0 0         if ($self->{StrictRFCPorts}) {
110 0           my $port;
111 0           for $port (721..731) {
112 0           $sock = new IO::Socket::INET (
113             PeerAddr => $self->{RemoteServer},
114             PeerPort => $self->{RemotePort},
115             LocalPort => $port,
116             Proto => 'tcp',
117             ReuseAddr => 1,
118             );
119 0 0         last if (defined($sock));
120 0 0         last unless ($! =~ /in use|bad file number/i);
121             }
122 0 0         unless (defined($sock)) {
123 0 0         if ($!) {
124 0           $self->_report("Can't establish connection to remote printer ($!)");
125             } else {
126 0           $self->_report("Can't establish connection to remote printer (No local ports available)");
127             }
128 0           return undef;
129             }
130             } else {
131 0           $sock = new IO::Socket::INET (
132             PeerAddr => $self->{RemoteServer},
133             PeerPort => $self->{RemotePort},
134             Proto => 'tcp',
135             ReuseAddr => 1,
136             );
137 0 0         unless (defined($sock)) {
138 0           $self->_report("Can't establish connection to remote printer ($!)");
139 0           return undef;
140             }
141             }
142            
143 0           $sock->autoflush(0);
144            
145 0           $self->{Socket} = $sock;
146 0           $self->{Mode} = 1;
147            
148 0           return 1;
149             }
150              
151             sub connected {
152              
153 0 0   0 1   croak 'Usage: $lp->connected()' if (@_ != 1);
154              
155 0           my $self = shift;
156              
157 0 0 0       undef $self->{Socket} if (defined($self->{Socket}) && ! $self->{Socket}->opened());
158              
159 0           return defined($self->{Socket});
160             }
161              
162             # Daemon commands
163              
164             sub print_waiting_jobs {
165              
166 0 0   0 1   croak 'Usage: $lp->print_waiting_jobs($queue)' if (@_ != 2);
167              
168 0           my $self = shift;
169              
170 0 0         unless ($self->connected()) {
171 0           $self->_report("Not connected");
172 0           return undef;
173             }
174              
175 0 0         unless ($self->{Mode} == 1) {
176 0           $self->_report("Not in ROOT command mode");
177 0           return undef;
178             }
179              
180 0           my $queue = shift;
181            
182 0           $queue =~ s/[\000-\040\200-\377]//g;
183            
184 0 0         $self->{Socket}->print("\001$queue\n") or do {
185 0           $self->_report("Error sending command ($!)");
186 0           return undef;
187             };
188 0 0         $self->{Socket}->flush() or do {
189 0           $self->_report("Error flushing buffer ($!)");
190 0           return undef;
191             };
192            
193 0           return $self->disconnect();
194             }
195              
196             sub send_jobs {
197              
198 0 0   0 1   croak 'Usage: $lp->send_jobs($queue)' if (@_ != 2);
199 0           my $self = shift;
200              
201 0 0         unless ($self->connected()) {
202 0           $self->_report("Not connected");
203 0           return undef;
204             }
205              
206 0 0         unless ($self->{Mode} == 1) {
207 0           $self->_report("Not in ROOT command mode");
208 0           return undef;
209             }
210              
211 0           my $queue = shift;
212            
213 0           $queue =~ s/[\000-\040\200-\377]//g;
214            
215 0 0         $self->{Socket}->print("\002$queue\n") or do {
216 0           $self->_report("Error sending command ($!)");
217 0           return undef;
218             };
219            
220 0 0         $self->{Socket}->flush() or do {
221 0           $self->_report("Error flushing buffer ($!)");
222 0           return undef;
223             };
224            
225 0           my $result;
226            
227 0           $result = $self->{Socket}->getc();
228            
229 0 0         if (length($result)) {
230 0           $result = unpack("C", $result);
231             } else {
232 0           $self->_report("Error getting result ($!)");
233 0           return undef;
234             };
235            
236 0 0         if ($result != 0) {
237 0           $self->_report("Printer reported an error ($result)");
238 0           return undef;
239             }
240            
241 0           $self->{Mode} = 2;
242            
243 0           return 1;
244             }
245              
246             sub get_queue_state {
247              
248 0 0   0 1   croak 'Usage: $lp->get_queue_state($queue [, $longflag [, @items]])' if (@_ < 2);
249            
250 0           my $self = shift;
251            
252 0 0         unless ($self->connected()) {
253 0           $self->_report("Not connected");
254 0           return undef;
255             }
256              
257 0 0         unless ($self->{Mode} == 1) {
258 0           $self->_report("Not in ROOT command mode");
259 0           return undef;
260             }
261              
262 0           my $queue = shift;
263            
264 0           $queue =~ s/[\000-\040\200-\377]//g;
265              
266 0   0       my $longflag = shift || 0;
267            
268 0 0         my $cmd = $longflag ? "\004" : "\003";
269              
270 0 0         $self->{Socket}->print("$cmd$queue ") or do {
271 0           $self->_report("Error sending command ($!)");
272 0           return undef;
273             };
274              
275 0           my $item;
276            
277 0           while (defined($item = shift)) {
278              
279 0           $item =~ s/[\000-\040\200-\377]//g;
280              
281 0 0         $self->{Socket}->print("$item ") or do {
282 0           $self->_report("Error sending item ($!)");
283 0           return undef;
284             };
285             }
286            
287 0 0         $self->{Socket}->print("\n") or do {
288 0           $self->_report("Error sending command ($!)");
289 0           return undef;
290             };
291              
292 0 0         $self->{Socket}->flush() or do {
293 0           $self->_report("Error flushing buffer ($!)");
294 0           return undef;
295             };
296            
297 0           my $response = "";
298 0           my $line;
299            
300 0           while (defined($line = $self->{Socket}->getline())) {
301 0           $response .= $line;
302             }
303            
304 0   0       return ( $self->disconnect() || undef ) && $response;
305             }
306              
307             sub remove_jobs {
308              
309 0 0   0 1   croak 'Usage: $lp->remove_jobs($queue, $username [, @items])' if (@_ < 3);
310            
311 0           my $self = shift;
312            
313 0 0         unless ($self->connected()) {
314 0           $self->_report("Not connected");
315 0           return undef;
316             }
317              
318 0 0         unless ($self->{Mode} == 1) {
319 0           $self->_report("Not in ROOT command mode");
320 0           return undef;
321             }
322              
323 0           my $queue = shift;
324 0           $queue =~ s/[\000-\040\200-\377]//g;
325            
326 0           my $username = shift;
327 0           $username =~ s/[\000-\040\200-\377]//g;
328              
329 0 0         $self->{Socket}->print("\005$queue $username") or do {
330 0           $self->_report("Error sending command ($!)");
331 0           return undef;
332             };
333              
334 0           my $item;
335            
336 0           while (defined($item = shift)) {
337              
338 0           $item =~ s/[\000-\040\200-\377]//g;
339              
340 0 0         $self->{Socket}->print(" $item") or do {
341 0           $self->_report("Error sending item ($!)");
342 0           return undef;
343             };
344             }
345            
346 0 0         $self->{Socket}->print("\n") or do {
347 0           $self->_report("Error sending command ($!)");
348 0           return undef;
349             };
350            
351 0 0         $self->{Socket}->flush() or do {
352 0           $self->_report("Error flushing buffer ($!)");
353 0           return undef;
354             };
355              
356 0           return $self->disconnect();
357             }
358              
359             #
360             # Job subcommands
361             #
362              
363             sub job_abort {
364              
365 0 0   0 0   croak 'Usage: $lp->job_abort()' if (@_ != 1);
366            
367 0           my $self = shift;
368            
369 0 0         unless ($self->connected()) {
370 0           $self->_report("Not connected");
371 0           return undef;
372             }
373              
374 0 0         unless ($self->{Mode} == 2) {
375 0           $self->_report("Not in JOB command mode");
376 0           return undef;
377             }
378              
379 0           $self->{Jobs} = {};
380              
381 0 0         $self->{Socket}->print("\001\n") or do {
382 0           $self->_report("Error sending command ($!)");
383 0           return undef;
384             };
385            
386 0 0         $self->{Socket}->flush() or do {
387 0           $self->_report("Error flushing buffer ($!)");
388 0           return undef;
389             };
390            
391 0           my $result;
392            
393 0           $result = $self->{Socket}->getc();
394            
395 0 0         if (length($result)) {
396 0           $result = unpack("C", $result);
397             } else {
398 0           $self->_report("Error getting result ($!)");
399 0           return undef;
400             };
401            
402 0 0         if ($result != 0) {
403 0           $self->_report("Printer reported an error ($result)");
404 0           return undef;
405             }
406              
407 0           return 1;
408             }
409              
410             my $g_job_id = 0;
411              
412             sub new_job {
413              
414 0 0 0 0 1   croak 'Usage: $jobkey = $lp->new_job([$jobid [, $jobhostname]])' if (@_ < 1 || @_ > 3);
415              
416 0           my $self = shift;
417 0           my $jobid = shift;
418            
419 0 0         $jobid = $g_job_id unless (defined($jobid));
420            
421 0 0 0       if ($jobid !~ /^\d+$/ || $jobid > 999) {
422 0           $self->_report("Invalid Job ID specified");
423 0           return undef;
424             }
425            
426 0           $g_job_id = ($jobid + 1) % 1000;
427              
428 0           my $jobname = shift;
429            
430 0 0         $jobname = hostname() unless (defined($jobname));
431            
432 0           $jobname =~ s/[\000-\040\200-\377]//g;
433            
434 0           my $jobkey = sprintf('%03d%s', $jobid, $jobname);
435            
436 0 0         if (exists($self->{Jobs}->{$jobkey})) {
437 0           $self->_report("Duplicate Job ID specified");
438 0           return undef;
439             }
440            
441 0           my $user;
442            
443 0 0         if ($^O eq 'MSWin32') {
444 0           $user = getlogin();
445             } else {
446 0           $user = scalar(getpwuid($>));
447             }
448            
449 0           $self->{Jobs}->{$jobkey} = {
450             JobID => $jobid,
451             Jobname => $jobname,
452             SentControl => 0,
453             SentData => 0,
454             UsedDataFileName => 0,
455             ControlFileName => "cfA$jobkey",
456             DataFileName => "dfA$jobkey",
457             PrintingMode => '',
458             DataSize => 0,
459             DataSent => 0,
460             CE => {
461             H => hostname(),
462             P => $user,
463             },
464             };
465            
466 0           return $jobkey;
467             }
468              
469             sub job_get_data_filename {
470              
471 0 0   0 1   croak 'Usage: $lp->job_get_data_filename($jobkey)' unless (@_ == 2);
472            
473 0           my $self = shift;
474 0           my $jobkey = shift;
475            
476 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
477 0           $self->_report("Nonexistant Job Key '$jobkey'");
478 0           return undef;
479             }
480              
481 0           return $self->{Jobs}->{$jobkey}->{DataFileName};
482             }
483              
484             sub job_set_data_filename {
485              
486 0 0   0 1   croak 'Usage: $lp->job_set_data_filename($jobkey, $filename)' unless (@_ == 3);
487            
488 0           my $self = shift;
489 0           my $jobkey = shift;
490            
491 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
492 0           $self->_report("Nonexistant Job Key '$jobkey'");
493 0           return undef;
494             }
495              
496 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
497 0           $self->_report("Already sent control file for '$jobkey'");
498 0           return undef;
499             }
500              
501 0 0         if ($self->{Jobs}->{$jobkey}->{SentData}) {
502 0           $self->_report("Already sent data file for '$jobkey'");
503 0           return undef;
504             }
505              
506 0 0         if ($self->{Jobs}->{$jobkey}->{UsedDataFileName}) {
507 0           $self->_report("Already referenced existing data file name for '$jobkey'");
508 0           return undef;
509             }
510              
511 0           my $text = shift;
512              
513 0           $text =~ s/[\000-\040\200-\377]//g;
514            
515 0 0         if (length($text) < 1) {
516 0           $self->_report("File name must be at least one character");
517 0           return undef;
518             }
519            
520 0           $self->{Jobs}->{$jobkey}->{DataFileName} = $text;
521              
522 0           return 1;
523             }
524              
525             sub job_get_control_filename {
526              
527 0 0   0 1   croak 'Usage: $lp->job_get_control_filename($jobkey)' unless (@_ == 2);
528            
529 0           my $self = shift;
530 0           my $jobkey = shift;
531            
532 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
533 0           $self->_report("Nonexistant Job Key '$jobkey'");
534 0           return undef;
535             }
536              
537 0           return $self->{Jobs}->{$jobkey}->{ControlFileName};
538             }
539              
540             sub job_set_control_filename {
541              
542 0 0   0 1   croak 'Usage: $lp->job_set_control_filename($jobkey, $filename)' unless (@_ == 3);
543            
544 0           my $self = shift;
545 0           my $jobkey = shift;
546            
547 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
548 0           $self->_report("Nonexistant Job Key '$jobkey'");
549 0           return undef;
550             }
551              
552 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
553 0           $self->_report("Already sent control file for '$jobkey'");
554 0           return undef;
555             }
556              
557 0 0         if ($self->{Jobs}->{$jobkey}->{UsedDataFileName}) {
558 0           $self->_report("Already referenced existing data file name for '$jobkey'");
559 0           return undef;
560             }
561              
562 0           my $text = shift;
563              
564 0           $text =~ s/[\000-\040\200-\377]//g;
565            
566 0 0         if (length($text) < 1) {
567 0           $self->_report("File name must be at least one character");
568 0           return undef;
569             }
570            
571 0           $self->{Jobs}->{$jobkey}->{ControlFileName} = $text;
572              
573 0           return 1;
574             }
575              
576             sub job_set_banner_class {
577              
578 0 0   0 1   croak 'Usage: $lp->job_set_banner_class($jobkey, $text)' unless (@_ == 3);
579            
580 0           my $self = shift;
581 0           my $jobkey = shift;
582            
583 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
584 0           $self->_report("Nonexistant Job Key '$jobkey'");
585 0           return undef;
586             }
587              
588 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
589 0           $self->_report("Already sent control file for '$jobkey'");
590 0           return undef;
591             }
592              
593 0           my $text = shift;
594              
595 0           $text =~ s/[\000-\040\200-\377]//g;
596            
597 0 0         unless (length($text) < 32) {
598 0           $self->_report("Banner Class is too long (31 octet limit)");
599 0           return undef;
600             }
601            
602 0 0         unless (length($text) > 0) {
603 0           $self->_report("Banner Class is too short (1 octet minimum)");
604 0           return undef;
605             }
606            
607 0           $self->{Jobs}->{$jobkey}->{CE}->{C} = $text;
608              
609 0           return 1;
610             }
611              
612             sub job_set_hostname {
613              
614 0 0   0 1   croak 'Usage: $lp->job_set_hostname($jobkey, $hostname)' unless (@_ == 3);
615            
616 0           my $self = shift;
617            
618 0           my $jobkey = shift;
619            
620 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
621 0           $self->_report("Nonexistant Job Key '$jobkey'");
622 0           return undef;
623             }
624              
625 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
626 0           $self->_report("Already sent control file for '$jobkey'");
627 0           return undef;
628             }
629              
630 0           my $text = shift;
631              
632 0           $text =~ s/[\000-\040\200-\377]//g;
633            
634 0 0         unless (length($text) < 32) {
635 0           $self->_report("Hostname is too long (31 octet limit)");
636 0           return undef;
637             }
638            
639 0           $self->{Jobs}->{$jobkey}->{CE}->{H} = $text;
640              
641 0           return 1;
642             }
643              
644             sub job_set_banner_name {
645              
646 0 0   0 1   croak 'Usage: $lp->job_set_banner_name($jobkey, $name)' unless (@_ == 3);
647            
648 0           my $self = shift;
649            
650 0           my $jobkey = shift;
651            
652 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
653 0           $self->_report("Nonexistant Job Key '$jobkey'");
654 0           return undef;
655             }
656              
657 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
658 0           $self->_report("Already sent control file for '$jobkey'");
659 0           return undef;
660             }
661              
662 0           my $text = shift;
663              
664 0           $text =~ s/[\000-\040\200-\377]//g;
665            
666 0 0         unless (length($text) < 100) {
667 0           $self->_report("Banner Name is too long (99 octet limit)");
668 0           return undef;
669             }
670            
671 0 0         unless (length($text) > 0) {
672 0           $self->_report("Banner Name is too short (1 octet minimum)");
673 0           return undef;
674             }
675            
676 0           $self->{Jobs}->{$jobkey}->{CE}->{J} = $text;
677              
678 0           return 1;
679             }
680              
681             sub job_enable_banner_page {
682              
683 0 0   0 1   croak 'Usage: $lp->job_enable_banner_page($jobkey, $username)' unless (@_ == 3);
684            
685 0           my $self = shift;
686            
687 0           my $jobkey = shift;
688            
689 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
690 0           $self->_report("Nonexistant Job Key '$jobkey'");
691 0           return undef;
692             }
693              
694 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
695 0           $self->_report("Already sent control file for '$jobkey'");
696 0           return undef;
697             }
698              
699 0           my $text = shift;
700              
701 0           $text =~ s/[\000-\040\200-\377]//g;
702            
703 0 0         unless (length($text) < 32) {
704 0           $self->_report("Banner User Name is too long (31 octet limit)");
705 0           return undef;
706             }
707            
708 0 0         unless (length($text) > 0) {
709 0           $self->_report("Banner User Name is too short (1 octet minimum)");
710 0           return undef;
711             }
712            
713 0           $self->{Jobs}->{$jobkey}->{CE}->{L} = $text;
714              
715 0           return 1;
716             }
717              
718             sub job_mail_when_printed {
719              
720 0 0   0 1   croak 'Usage: $lp->job_mail_when_printed($jobkey, $username)' unless (@_ == 3);
721            
722 0           my $self = shift;
723            
724 0           my $jobkey = shift;
725            
726 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
727 0           $self->_report("Nonexistant Job Key '$jobkey'");
728 0           return undef;
729             }
730              
731 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
732 0           $self->_report("Already sent control file for '$jobkey'");
733 0           return undef;
734             }
735              
736 0           my $text = shift;
737              
738 0           $text =~ s/[\000-\040\200-\377]//g;
739            
740 0 0         unless (length($text) < 32) {
741 0           $self->_report("Mail User Name is too long (31 octet limit)");
742 0           return undef;
743             }
744            
745 0 0         unless (length($text) > 0) {
746 0           $self->_report("Mail User Name is too short (1 octet minimum)");
747 0           return undef;
748             }
749            
750 0           $self->{Jobs}->{$jobkey}->{CE}->{M} = $text;
751              
752 0           return 1;
753             }
754              
755             sub job_set_source_filename {
756              
757 0 0   0 1   croak 'Usage: $lp->job_set_source_filename($jobkey, $filename)' unless (@_ == 3);
758            
759 0           my $self = shift;
760            
761 0           my $jobkey = shift;
762            
763 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
764 0           $self->_report("Nonexistant Job Key '$jobkey'");
765 0           return undef;
766             }
767              
768 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
769 0           $self->_report("Already sent control file for '$jobkey'");
770 0           return undef;
771             }
772              
773 0           my $text = shift;
774              
775 0           $text =~ s/[\000-\040\200-\377]//g;
776            
777 0 0         unless (length($text) < 132) {
778 0           $self->_report("Filename is too long (131 octet limit)");
779 0           return undef;
780             }
781            
782 0 0         unless (length($text) > 0) {
783 0           $self->_report("Filename is too short (1 octet minimum)");
784 0           return undef;
785             }
786            
787 0           $self->{Jobs}->{$jobkey}->{CE}->{N} = $text;
788              
789 0           return 1;
790             }
791              
792             sub job_set_user_id {
793              
794 0 0   0 1   croak 'Usage: $lp->job_set_user_id($jobkey, $username)' unless (@_ == 3);
795            
796 0           my $self = shift;
797            
798 0           my $jobkey = shift;
799            
800 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
801 0           $self->_report("Nonexistant Job Key '$jobkey'");
802 0           return undef;
803             }
804              
805 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
806 0           $self->_report("Already sent control file for '$jobkey'");
807 0           return undef;
808             }
809              
810 0           my $text = shift;
811              
812 0           $text =~ s/[\000-\040\200-\377]//g;
813            
814 0 0         unless (length($text) < 32) {
815 0           $self->_report("User Name is too long (31 octet limit)");
816 0           return undef;
817             }
818            
819 0 0         unless (length($text) > 0) {
820 0           $self->_report("User Name is too short (1 octet minimum)");
821 0           return undef;
822             }
823            
824 0           $self->{Jobs}->{$jobkey}->{CE}->{P} = $text;
825              
826 0           return 1;
827             }
828              
829             sub job_set_symlink_data {
830              
831 0 0   0 1   croak 'Usage: $lp->job_set_symlink_data($jobkey, $dev, $inode)' unless (@_ == 4);
832            
833 0           my $self = shift;
834            
835 0           my $jobkey = shift;
836            
837 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
838 0           $self->_report("Nonexistant Job Key '$jobkey'");
839 0           return undef;
840             }
841              
842 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
843 0           $self->_report("Already sent control file for '$jobkey'");
844 0           return undef;
845             }
846              
847 0           my $dev = shift;
848 0           my $inode = shift;
849            
850 0 0 0       unless ($dev =~ /^\d+$/ && $inode =~ /^\d+$/) {
851 0           $self->_report("Expected numeric arguments");
852 0           return undef;
853             }
854            
855 0           $self->{Jobs}->{$jobkey}->{CE}->{S} = "$dev $inode";
856              
857 0           return 1;
858             }
859              
860             sub job_unlink {
861              
862 0 0   0 1   croak 'Usage: $lp->job_unlink($jobkey)' unless (@_ == 2);
863            
864 0           my $self = shift;
865            
866 0           my $jobkey = shift;
867            
868 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
869 0           $self->_report("Nonexistant Job Key '$jobkey'");
870 0           return undef;
871             }
872              
873 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
874 0           $self->_report("Already sent control file for '$jobkey'");
875 0           return undef;
876             }
877              
878 0           $self->{Jobs}->{$jobkey}->{UsedDataFileName} = 1;
879            
880 0           $self->{Jobs}->{$jobkey}->{CE}->{P} = $self->{Jobs}->{$jobkey}->{DataFileName};
881              
882 0           return 1;
883             }
884              
885             sub job_set_troff_r_font {
886              
887 0 0   0 0   croak 'Usage: $lp->job_set_troff_r_font($jobkey, $filename)' unless (@_ == 3);
888            
889 0           my $self = shift;
890            
891 0           my $jobkey = shift;
892            
893 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
894 0           $self->_report("Nonexistant Job Key '$jobkey'");
895 0           return undef;
896             }
897              
898 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
899 0           $self->_report("Already sent control file for '$jobkey'");
900 0           return undef;
901             }
902              
903 0           my $text = shift;
904              
905 0           $text =~ s/[\000-\040\200-\377]//g;
906            
907 0 0         unless (length($text) < 256) {
908 0           $self->_report("File Name is too long (255 octet limit)");
909 0           return undef;
910             }
911            
912 0 0         unless (length($text) > 0) {
913 0           $self->_report("File Name is too short (1 octet minimum)");
914 0           return undef;
915             }
916            
917 0           $self->{Jobs}->{$jobkey}->{CE}->{1} = $text;
918              
919 0           return 1;
920             }
921              
922             sub job_set_troff_i_font {
923              
924 0 0   0 0   croak 'Usage: $lp->job_set_troff_i_font($jobkey, $filename)' unless (@_ == 3);
925            
926 0           my $self = shift;
927            
928 0           my $jobkey = shift;
929            
930 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
931 0           $self->_report("Nonexistant Job Key '$jobkey'");
932 0           return undef;
933             }
934              
935 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
936 0           $self->_report("Already sent control file for '$jobkey'");
937 0           return undef;
938             }
939              
940 0           my $text = shift;
941              
942 0           $text =~ s/[\000-\040\200-\377]//g;
943            
944 0 0         unless (length($text) < 256) {
945 0           $self->_report("File Name is too long (255 octet limit)");
946 0           return undef;
947             }
948            
949 0 0         unless (length($text) > 0) {
950 0           $self->_report("File Name is too short (1 octet minimum)");
951 0           return undef;
952             }
953            
954 0           $self->{Jobs}->{$jobkey}->{CE}->{2} = $text;
955              
956 0           return 1;
957             }
958              
959             sub job_set_troff_b_font {
960              
961 0 0   0 0   croak 'Usage: $lp->job_set_troff_b_font($jobkey, $filename)' unless (@_ == 3);
962            
963 0           my $self = shift;
964            
965 0           my $jobkey = shift;
966            
967 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
968 0           $self->_report("Nonexistant Job Key '$jobkey'");
969 0           return undef;
970             }
971              
972 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
973 0           $self->_report("Already sent control file for '$jobkey'");
974 0           return undef;
975             }
976              
977 0           my $text = shift;
978              
979 0           $text =~ s/[\000-\040\200-\377]//g;
980            
981 0 0         unless (length($text) < 256) {
982 0           $self->_report("File Name is too long (255 octet limit)");
983 0           return undef;
984             }
985            
986 0 0         unless (length($text) > 0) {
987 0           $self->_report("File Name is too short (1 octet minimum)");
988 0           return undef;
989             }
990            
991 0           $self->{Jobs}->{$jobkey}->{CE}->{3} = $text;
992              
993 0           return 1;
994             }
995              
996             sub job_set_troff_s_font {
997              
998 0 0   0 0   croak 'Usage: $lp->job_set_troff_s_font($jobkey, $filename)' unless (@_ == 3);
999            
1000 0           my $self = shift;
1001            
1002 0           my $jobkey = shift;
1003            
1004 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1005 0           $self->_report("Nonexistant Job Key '$jobkey'");
1006 0           return undef;
1007             }
1008              
1009 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1010 0           $self->_report("Already sent control file for '$jobkey'");
1011 0           return undef;
1012             }
1013              
1014 0           my $text = shift;
1015              
1016 0           $text =~ s/[\000-\040\200-\377]//g;
1017            
1018 0 0         unless (length($text) < 256) {
1019 0           $self->_report("File Name is too long (255 octet limit)");
1020 0           return undef;
1021             }
1022            
1023 0 0         unless (length($text) > 0) {
1024 0           $self->_report("File Name is too short (1 octet minimum)");
1025 0           return undef;
1026             }
1027            
1028 0           $self->{Jobs}->{$jobkey}->{CE}->{4} = $text;
1029              
1030 0           return 1;
1031             }
1032              
1033             sub job_mode_cif {
1034              
1035 0 0   0 0   croak 'Usage: $lp->job_mode_cif($jobkey)' unless (@_ == 2);
1036            
1037 0           my $self = shift;
1038            
1039 0           my $jobkey = shift;
1040            
1041 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1042 0           $self->_report("Nonexistant Job Key '$jobkey'");
1043 0           return undef;
1044             }
1045              
1046 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1047 0           $self->_report("Already sent control file for '$jobkey'");
1048 0           return undef;
1049             }
1050              
1051 0           my $job = $self->{Jobs}->{$jobkey};
1052              
1053 0           my $f = $job->{PrintFormat};
1054              
1055 0           $job->{UsedDataFileName} = 1;
1056            
1057 0 0 0       if (defined($f) && length($f)) {
1058 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1059 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1060 0 0 0       delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
1061 0           delete $job->{CE}->{$f};
1062             }
1063            
1064 0           $job->{PrintFormat} = 'c';
1065            
1066 0           $job->{CE}->{c} = $job->{DataFileName};
1067              
1068 0           return 1;
1069             }
1070              
1071             sub job_mode_dvi {
1072              
1073 0 0   0 0   croak 'Usage: $lp->job_mode_dvi($jobkey)' unless (@_ == 2);
1074            
1075 0           my $self = shift;
1076            
1077 0           my $jobkey = shift;
1078            
1079 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1080 0           $self->_report("Nonexistant Job Key '$jobkey'");
1081 0           return undef;
1082             }
1083              
1084 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1085 0           $self->_report("Already sent control file for '$jobkey'");
1086 0           return undef;
1087             }
1088              
1089 0           my $job = $self->{Jobs}->{$jobkey};
1090              
1091 0           my $f = $job->{PrintFormat};
1092              
1093 0           $job->{UsedDataFileName} = 1;
1094            
1095 0 0 0       if (defined($f) && length($f)) {
1096 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1097 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1098 0 0 0       delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
1099 0           delete $job->{CE}->{$f};
1100             }
1101            
1102 0           $job->{PrintFormat} = 'd';
1103            
1104 0           $job->{CE}->{d} = $job->{DataFileName};
1105              
1106 0           return 1;
1107             }
1108              
1109             sub job_mode_text {
1110              
1111 0 0 0 0 0   croak 'Usage: $lp->job_mode_text($jobkey [, $width [, $indentation [, $nofilter]]])' unless (@_ >= 2 && @_ <= 5);
1112            
1113 0           my $self = shift;
1114            
1115 0           my $jobkey = shift;
1116            
1117 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1118 0           $self->_report("Nonexistant Job Key '$jobkey'");
1119 0           return undef;
1120             }
1121              
1122 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1123 0           $self->_report("Already sent control file for '$jobkey'");
1124 0           return undef;
1125             }
1126              
1127 0           my $width = shift;
1128            
1129 0 0 0       if (defined($width) && $width !~ /^\d+$/) {
1130 0           $self->_report("Width argument must be numeric");
1131 0           return undef;
1132             }
1133            
1134 0           my $indentation = shift;
1135              
1136 0 0 0       if (defined($indentation) && $indentation !~ /^\d+$/) {
1137 0           $self->_report("Indentation argument must be numeric");
1138 0           return undef;
1139             }
1140            
1141 0           my $nofilter = shift;
1142            
1143 0           my $job = $self->{Jobs}->{$jobkey};
1144              
1145 0           my $f = $job->{PrintFormat};
1146              
1147 0           $job->{UsedDataFileName} = 1;
1148            
1149 0 0 0       if (defined($f) && length($f)) {
1150 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1151 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1152 0 0 0       delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
1153 0           delete $job->{CE}->{$f};
1154             }
1155            
1156 0 0 0       if (defined($nofilter) && $nofilter) {
1157 0           $f = 'l';
1158             } else {
1159 0           $f = 'f';
1160             }
1161            
1162 0           $job->{PrintFormat} = $f;
1163            
1164 0           $job->{CE}->{$f} = $job->{DataFileName};
1165 0 0         $job->{CE}->{W} = $width if (defined($width));
1166 0 0         $job->{CE}->{I} = $indentation if (defined($indentation));
1167              
1168 0           return 1;
1169             }
1170              
1171             sub job_mode_plot {
1172              
1173 0 0   0 0   croak 'Usage: $lp->job_mode_plot($jobkey)' unless (@_ == 2);
1174            
1175 0           my $self = shift;
1176            
1177 0           my $jobkey = shift;
1178            
1179 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1180 0           $self->_report("Nonexistant Job Key '$jobkey'");
1181 0           return undef;
1182             }
1183              
1184 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1185 0           $self->_report("Already sent control file for '$jobkey'");
1186 0           return undef;
1187             }
1188              
1189 0           my $job = $self->{Jobs}->{$jobkey};
1190              
1191 0           my $f = $job->{PrintFormat};
1192              
1193 0           $job->{UsedDataFileName} = 1;
1194            
1195 0 0 0       if (defined($f) && length($f)) {
1196 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1197 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1198 0 0         delete $job->{CE}->{I} if ($f eq 'f');
1199 0           delete $job->{CE}->{$f};
1200             }
1201            
1202 0           $job->{PrintFormat} = 'g';
1203            
1204 0           $job->{CE}->{g} = $job->{DataFileName};
1205              
1206 0           return 1;
1207             }
1208              
1209             sub job_mode_ditroff {
1210              
1211 0 0   0 0   croak 'Usage: $lp->job_mode_ditroff($jobkey)' unless (@_ == 2);
1212            
1213 0           my $self = shift;
1214            
1215 0           my $jobkey = shift;
1216            
1217 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1218 0           $self->_report("Nonexistant Job Key '$jobkey'");
1219 0           return undef;
1220             }
1221              
1222 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1223 0           $self->_report("Already sent control file for '$jobkey'");
1224 0           return undef;
1225             }
1226              
1227 0           my $job = $self->{Jobs}->{$jobkey};
1228              
1229 0           my $f = $job->{PrintFormat};
1230              
1231 0           $job->{UsedDataFileName} = 1;
1232            
1233 0 0 0       if (defined($f) && length($f)) {
1234 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1235 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1236 0 0 0       delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
1237 0           delete $job->{CE}->{$f};
1238             }
1239            
1240 0           $job->{PrintFormat} = 'n';
1241            
1242 0           $job->{CE}->{n} = $job->{DataFileName};
1243              
1244 0           return 1;
1245             }
1246              
1247             sub job_mode_postscript {
1248              
1249 0 0   0 0   croak 'Usage: $lp->job_mode_postscript($jobkey)' unless (@_ == 2);
1250            
1251 0           my $self = shift;
1252            
1253 0           my $jobkey = shift;
1254            
1255 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1256 0           $self->_report("Nonexistant Job Key '$jobkey'");
1257 0           return undef;
1258             }
1259              
1260 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1261 0           $self->_report("Already sent control file for '$jobkey'");
1262 0           return undef;
1263             }
1264              
1265 0           my $job = $self->{Jobs}->{$jobkey};
1266              
1267 0           my $f = $job->{PrintFormat};
1268              
1269 0           $job->{UsedDataFileName} = 1;
1270            
1271 0 0 0       if (defined($f) && length($f)) {
1272 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1273 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1274 0 0 0       delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
1275 0           delete $job->{CE}->{$f};
1276             }
1277            
1278 0           $job->{PrintFormat} = 'o';
1279            
1280 0           $job->{CE}->{o} = $job->{DataFileName};
1281              
1282 0           return 1;
1283             }
1284              
1285             sub job_mode_pr {
1286              
1287 0 0 0 0 0   croak 'Usage: $lp->job_mode_pr($jobkey [, $title [, $width]])' unless (@_ >= 2 && @_ <= 4);
1288            
1289 0           my $self = shift;
1290            
1291 0           my $jobkey = shift;
1292            
1293 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1294 0           $self->_report("Nonexistant Job Key '$jobkey'");
1295 0           return undef;
1296             }
1297              
1298 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1299 0           $self->_report("Already sent control file for '$jobkey'");
1300 0           return undef;
1301             }
1302              
1303 0           my $title = shift;
1304            
1305 0 0         if (defined($title)) {
1306 0           $title =~ s/[\000-\040\200-\377]//g;
1307 0 0         if (length($title) < 0) {
1308 0           $self->_report("Title too short (1 octet minimum)");
1309 0           return undef;
1310             }
1311 0 0         if (length($title) > 79) {
1312 0           $self->_report("Title too long (79 octet maximum)");
1313             }
1314             }
1315            
1316 0           my $width = shift;
1317            
1318 0 0 0       if (defined($width) && $width !~ /^\d+$/) {
1319 0           $self->_report("Width argument must be numeric");
1320 0           return undef;
1321             }
1322              
1323 0           my $job = $self->{Jobs}->{$jobkey};
1324              
1325 0           my $f = $job->{PrintFormat};
1326              
1327 0           $job->{UsedDataFileName} = 1;
1328            
1329 0 0 0       if (defined($f) && length($f)) {
1330 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1331 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1332 0 0 0       delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
1333 0           delete $job->{CE}->{$f};
1334             }
1335            
1336 0           $job->{PrintFormat} = 'p';
1337            
1338 0           $job->{CE}->{p} = $job->{DataFileName};
1339 0 0         $job->{CE}->{T} = $title if (defined($title));
1340 0 0         $job->{CE}->{W} = $width if (defined($width));
1341              
1342 0           return 1;
1343             }
1344              
1345             sub job_mode_fortran {
1346              
1347 0 0   0 0   croak 'Usage: $lp->job_mode_fortran($jobkey)' unless (@_ == 2);
1348            
1349 0           my $self = shift;
1350            
1351 0           my $jobkey = shift;
1352            
1353 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1354 0           $self->_report("Nonexistant Job Key '$jobkey'");
1355 0           return undef;
1356             }
1357              
1358 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1359 0           $self->_report("Already sent control file for '$jobkey'");
1360 0           return undef;
1361             }
1362              
1363 0           my $job = $self->{Jobs}->{$jobkey};
1364              
1365 0           my $f = $job->{PrintFormat};
1366              
1367 0           $job->{UsedDataFileName} = 1;
1368            
1369 0 0 0       if (defined($f) && length($f)) {
1370 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1371 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1372 0 0 0       delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
1373 0           delete $job->{CE}->{$f};
1374             }
1375            
1376 0           $job->{PrintFormat} = 't';
1377            
1378 0           $job->{CE}->{t} = $job->{DataFileName};
1379              
1380 0           return 1;
1381             }
1382              
1383             sub job_mode_troff {
1384              
1385 0 0   0 0   croak 'Usage: $lp->job_mode_troff($jobkey)' unless (@_ == 2);
1386            
1387 0           my $self = shift;
1388            
1389 0           my $jobkey = shift;
1390            
1391 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1392 0           $self->_report("Nonexistant Job Key '$jobkey'");
1393 0           return undef;
1394             }
1395              
1396 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1397 0           $self->_report("Already sent control file for '$jobkey'");
1398 0           return undef;
1399             }
1400              
1401 0           my $job = $self->{Jobs}->{$jobkey};
1402              
1403 0           my $f = $job->{PrintFormat};
1404              
1405 0           $job->{UsedDataFileName} = 1;
1406            
1407 0 0 0       if (defined($f) && length($f)) {
1408 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1409 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1410 0 0 0       delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
1411 0           delete $job->{CE}->{$f};
1412             }
1413            
1414 0           $job->{PrintFormat} = 't';
1415            
1416 0           $job->{CE}->{t} = $job->{DataFileName};
1417              
1418 0           return 1;
1419             }
1420              
1421             sub job_mode_raster {
1422              
1423 0 0   0 0   croak 'Usage: $lp->job_mode_raster($jobkey)' unless (@_ == 2);
1424            
1425 0           my $self = shift;
1426            
1427 0           my $jobkey = shift;
1428            
1429 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1430 0           $self->_report("Nonexistant Job Key '$jobkey'");
1431 0           return undef;
1432             }
1433              
1434 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1435 0           $self->_report("Already sent control file for '$jobkey'");
1436 0           return undef;
1437             }
1438              
1439 0           my $job = $self->{Jobs}->{$jobkey};
1440              
1441 0           my $f = $job->{PrintFormat};
1442              
1443 0           $job->{UsedDataFileName} = 1;
1444            
1445 0 0 0       if (defined($f) && length($f)) {
1446 0 0 0       delete $job->{CE}->{W} if ($f eq 'f' || $f eq 'l' || $f eq 'p');
      0        
1447 0 0         delete $job->{CE}->{T} if ($f eq 'p');
1448 0 0 0       delete $job->{CE}->{I} if ($f eq 'f' || $f eq 'l');
1449 0           delete $job->{CE}->{$f};
1450             }
1451            
1452 0           $job->{PrintFormat} = 'v';
1453            
1454 0           $job->{CE}->{v} = $job->{DataFileName};
1455              
1456 0           return 1;
1457             }
1458              
1459             sub job_send_control_file {
1460              
1461 0 0   0 1   croak 'Usage: $lp->job_send_control_file($jobkey)' unless (@_ == 2);
1462              
1463 0           my $self = shift;
1464            
1465 0           my $jobkey = shift;
1466            
1467 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1468 0           $self->_report("Nonexistant Job Key '$jobkey'");
1469 0           return undef;
1470             }
1471              
1472 0 0         if ($self->{Jobs}->{$jobkey}->{SentControl}) {
1473 0           $self->_report("Already sent control file for '$jobkey'");
1474 0           return undef;
1475             }
1476              
1477 0 0         unless ($self->{Mode} == 2) {
1478 0           $self->_report("Not in JOB command mode");
1479 0           return undef;
1480             }
1481              
1482 0           my $cf = "";
1483            
1484 0           my $k;
1485              
1486             my $result;
1487            
1488 0           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)) {
1489 0 0         next unless (exists($self->{Jobs}->{$jobkey}->{CE}->{$k}));
1490 0           $cf .= $k . $self->{Jobs}->{$jobkey}->{CE}->{$k} . "\n";
1491             }
1492              
1493 0 0         $self->{Socket}->print("\002".length($cf)." ".$self->{Jobs}->{$jobkey}->{ControlFileName}."\n") or do {
1494 0           $self->_report("Error sending command ($!)");
1495 0           return undef;
1496             };
1497            
1498 0 0         $self->{Socket}->flush() or do {
1499 0           $self->_report("Error flushing buffer ($!)");
1500 0           return undef;
1501             };
1502              
1503 0           $result = $self->{Socket}->getc();
1504            
1505 0 0         if (length($result)) {
1506 0           $result = unpack("C", $result);
1507             } else {
1508 0           $self->_report("Error getting result ($!)");
1509 0           return undef;
1510             };
1511            
1512 0 0         if ($result != 0) {
1513 0           $self->_report("Printer reported an error ($result)");
1514 0           return undef;
1515             }
1516              
1517 0 0         $self->{Socket}->print("$cf\000") or do {
1518 0           $self->_report("Error sending control file ($!)");
1519 0           return undef;
1520             };
1521            
1522 0 0         $self->{Socket}->flush() or do {
1523 0           $self->_report("Error flushing buffer ($!)");
1524 0           return undef;
1525             };
1526              
1527 0           $result = $self->{Socket}->getc();
1528            
1529 0 0         if (length($result)) {
1530 0           $result = unpack("C", $result);
1531             } else {
1532 0           $self->_report("Error getting result ($!)");
1533 0           return undef;
1534             };
1535            
1536 0 0         if ($result != 0) {
1537 0           $self->_report("Printer reported an error ($result)");
1538 0           return undef;
1539             }
1540              
1541 0           $self->{Jobs}->{$jobkey}->{SentControl} = 1;
1542             }
1543              
1544             sub job_send_data {
1545              
1546 0 0   0 1   croak 'Usage: $lp->job_send_data($jobkey, $data [, $totalsize])' unless (@_ >= 1);
1547            
1548 0           my $self = shift;
1549            
1550 0 0         if ($self->{Mode} == 2) {
    0          
1551 0 0 0       croak 'JOB Mode Usage: $lp->job_send_data($jobkey, $data [, $totalsize])' unless (@_ >= 2 && @_ <= 3);
1552             } elsif ($self->{Mode} == 3) {
1553 0 0         croak 'DATA Mode Usage: $lp->job_send_data($jobkey, $data)' unless (@_ == 2);
1554             } else {
1555 0           $self->_report("Not in JOB or DATA command mode");
1556             }
1557            
1558 0           my $jobkey = shift;
1559            
1560 0 0         unless (exists($self->{Jobs}->{$jobkey})) {
1561 0           $self->_report("Nonexistant Job Key '$jobkey'");
1562 0           return undef;
1563             }
1564              
1565 0 0         if ($self->{Jobs}->{$jobkey}->{SentData}) {
1566 0           $self->_report("Already sent data file for '$jobkey'");
1567 0           return undef;
1568             }
1569            
1570 0           my $data = shift;
1571              
1572 0           my $totalsize = shift;
1573              
1574 0 0 0       if (defined($totalsize) && $totalsize !~ /^\d+$/) {
1575 0           $self->_report("Size argument must be numeric");
1576 0           return undef;
1577             }
1578              
1579 0 0         if ($self->{Mode} == 2) {
1580              
1581 0 0         if (defined($totalsize)) {
1582 0 0         $self->{Socket}->print("\003$totalsize ".$self->{Jobs}->{$jobkey}->{DataFileName}."\n") or do {
1583 0           $self->_report("Error sending command ($!)");
1584 0           return undef;
1585             };
1586             } else {
1587 0 0         $self->{Socket}->print("\003 ".$self->{Jobs}->{$jobkey}->{DataFileName}."\n") or do {
1588 0           $self->_report("Error sending command ($!)");
1589 0           return undef;
1590             };
1591             }
1592              
1593 0 0         $self->{Socket}->flush() or do {
1594 0           $self->_report("Error flushing buffer ($!)");
1595 0           return undef;
1596             };
1597              
1598 0           my $result;
1599              
1600 0           $result = $self->{Socket}->getc();
1601              
1602 0 0 0       if (defined($result) && length($result)) {
1603 0           $result = unpack("C", $result);
1604             } else {
1605 0           $self->_report("Error getting result ($!)");
1606 0           return undef;
1607             };
1608              
1609 0 0         if ($result != 0) {
1610 0           $self->_report("Printer reported an error ($result)");
1611 0           return undef;
1612             }
1613              
1614 0 0         $self->{Jobs}->{$jobkey}->{DataSize} = $totalsize if (defined($totalsize));
1615 0           $self->{Mode} = 3;
1616 0           $self->{Jobs}->{$jobkey}->{UsedDataFileName} = 1;
1617             }
1618            
1619 0 0         if ($self->{Mode} != 3) {
1620 0           $self->_report("Can't send data in this mode");
1621 0           return undef;
1622             }
1623            
1624 0           my $job = $self->{Jobs}->{$jobkey};
1625              
1626 0           my $dsize = length($data);
1627              
1628 0 0 0       if ($job->{DataSize} > 0 && $dsize + $job->{DataSent} > $job->{DataSize}) {
1629 0           $data = substr($data, 0, $job->{DataSize} - $job->{DataSent});
1630             }
1631            
1632 0 0         if (length($data) > 0) {
1633 0 0         $self->{Socket}->print($data) or do {
1634 0           $self->_report("Error sending data ($!)");
1635 0           return undef;
1636             };
1637             }
1638            
1639 0           $job->{DataSent} += length($data);
1640            
1641 0 0         if ($job->{DataSent} >= $job->{DataSize}) {
1642              
1643 0           $job->{SentData} = 1;
1644              
1645 0 0         if ($job->{SentControl}) {
1646 0           delete $self->{Jobs}->{$jobkey};
1647             }
1648            
1649 0 0         $self->{Socket}->print("\000") or do {
1650 0           $self->_report("Error sending data ($!)");
1651 0           return undef;
1652             };
1653            
1654 0 0         $self->{Socket}->flush() or do {
1655 0           $self->_report("Error flushing buffer ($!)");
1656 0           return undef;
1657             };
1658              
1659 0           my $result;
1660              
1661 0           $result = $self->{Socket}->getc();
1662              
1663 0 0         if (length($result)) {
1664 0           $result = unpack("C", $result);
1665             } else {
1666 0           $self->_report("Error getting result ($!)");
1667 0           return undef;
1668             };
1669              
1670 0 0         if ($result != 0) {
1671 0           $self->_report("Printer reported an error ($result)");
1672 0           return undef;
1673             }
1674             }
1675            
1676 0 0         if ($dsize != length($data)) {
1677 0           $self->_report("Data overflow error");
1678 0           return undef;
1679             }
1680            
1681 0           return 1;
1682             }
1683              
1684             1;