#!/usr/bin/perl
# -*- perl -*-
# This is foomatic-printjob, a program to print and manage printing
# jobs with the same commands independent whether the spooler is CUPS,
# LPD, LPRng, or PDQ.

# It also comprises half of a programattic API for user tools: you can
# learn and control everything about the properties of printing jobs
# here. With the sister program foomatic-configure, you can do
# everything related to print queue static state: install, modify,
# remove queues, query queue, printer, and driver info.

use Foomatic::Defaults;
use Foomatic::DB;

# Read out the program name with which we were called, but discard the path

$0 =~ m!/([^/]+)\s*$!;
$progname = $1;

# We use the library Getopt::Long here, so that we can have more than one "-o"
# option on one command line.

use Getopt::Long;
Getopt::Long::Configure("no_ignore_case", "pass_through");
GetOptions("P=s" => \$opt_P,         # which queue (Printer)?
       "d=s" => \$opt_d,         # which queue (Destination)?
       "s=s" => \$opt_s,         # which Spooler?
       "o=s" => \@opt_o,         # printing Options
       "Q"   => \$opt_Q,         # Query jobs in queue
       "R"   => \$opt_R,         # Remove job(s)
       "C"   => \$opt_C,         # Control job(s)/queue(s)
       "S"   => \$opt_S,         # set default Spooler
       "h"   => \$opt_h);        # Help!

help() if ($opt_h && !$opt_P);

my $db = new Foomatic::DB;

my $in_config = {'queue'   => $opt_P,
         'options' => \@opt_o,
         'spooler' => $opt_s};

# Default action: Printing
my $action = 'print';

# Determine the action by the name how we were called
if ($progname =~ m!^lpc!) { # 'lpc*' ==> control 
    $action = 'control';
} elsif ($progname =~ m!^lprm!) { # 'lprm*' ==> remove jobs 
    $action = 'remove';
} elsif ($progname =~ m!^lpq!) { # 'lpq*' ==> list jobs 
    $action = 'query';
} elsif (($progname =~ m!^lpr!) || ($progname =~ m!^lp!)) { 
    # 'lpr*', 'lp*' ==> print 
    $action = 'print';
}

# Determine the action by a command line option
$action = ($opt_R ? 'remove' : $action);
$action = ($opt_Q ? 'query' : $action);
$action = ($opt_C ? 'control' : $action);

my $procs = { 'lpd' => { 'print'    => \&print_lpd,
             'query'    => \&query_lpd,
                 'remove'   => \&remove_lpd,
                 'control'  => \&control_lpd },
          'lprng'=>{ 'print'    => \&print_lprng,
             'query'    => \&query_lprng,
             'remove'   => \&remove_lprng,
             'control'  => \&control_lpd },
          'cups' =>{ 'print'    => \&print_cups,
             'query'    => \&query_cups,
             'remove'   => \&remove_cups,
             'control'  => \&control_cups },
          'pdq'  =>{ 'print'    => \&print_pdq,
             'query'    => \&query_pdq,
             'remove'   => \&remove_pdq,
             'control'  => \&control_pdq } };

if (!(defined($in_config->{'queue'}))) {
    # No job handling without knowing the name of the queue
    # PRINTER environment variable
    if (defined($opt_d)) {
    $in_config->{'queue'} = $opt_d;
    } elsif (defined($ENV{PRINTER})) {
    $in_config->{'queue'} = $ENV{PRINTER};
    } else {
    # Use spoolers default
    }
}

if (!defined($in_config->{'spooler'})) {

    # Personal default spooler
    if (($> != 0) && (-f "$ENV{'HOME'}/.defaultspooler")) {
    $s = `cat $ENV{'HOME'}/.defaultspooler`;
    chomp $s;
    }
    
    # System default spooler
    if ((!defined($s)) && (-f "$sysdeps->{'foo-etc'}/defaultspooler")) {
    $s = `cat $sysdeps->{'foo-etc'}/defaultspooler`;
    chomp $s;
    }
    
    if (!defined($s)) {
    $s = detect_spooler();
    }

    die "Unable to identify spooler, please specify one with \"-s\"!\n"
    unless $s;

    if (defined($opt_i)) {
    print STDERR "You appear to be using $s.  Correct? ";
    my $yn = <STDIN>;
    die "\n" if ($yn !~ m!^y!i);
    }

    $in_config->{'spooler'} = $s;
}

if (defined($opt_S)) {
    if ($> == 0) { # Program invoked as "root"?
    # Set system default spooler
    open DEFAULTFILE, "> $sysdeps->{'foo-etc'}/defaultspooler" ||
        die "Cannot write $sysdeps->{'foo-etc'}/defaultspooler!\n";
    print DEFAULTFILE "$in_config->{'spooler'}\n";
    close DEFAULTFILE;
    exit 0;
    } else {
    # Set personal default spooler
    open DEFAULTFILE, "> $ENV{'HOME'}/.defaultspooler" ||
        die "Cannot write $ENV{'HOME'}/.defaultspooler!\n";
    print DEFAULTFILE "$in_config->{'spooler'}\n";
    close DEFAULTFILE;
    exit 0;
    }
}

# Exception...
help_options($in_config) if ($opt_h);

# Call proper proc
exit &{$procs->{$in_config->{'spooler'}}{$action}}($in_config);

### Printing/Job manipulation functions for LPD

sub print_lpd {
    my ($config) = $_[0];

    #sysdeps->{'lpd-lpr'} = "/home/test/lpr-0.71/lpr/lpr";

    # Auto-detect whether the "lpr" executable is the VA-Linux version or not
    my $valinuxlpr = 
    !(system "strings $sysdeps->{'lpd-lpr'} | grep option > /dev/null");

    # Printing command
    my $commandline = "$sysdeps->{'lpd-lpr'}";

    # Add the printer queue argument
    if (defined($config->{'queue'})) {
    $commandline .= " -P $config->{'queue'}";
    }

    # Add the driver-specific options supplied by the user, if any
    # For the VA-Linux implementation of "lpr" (gnulpr) options are passed
    # with '-o option=value -o switch', for the BSD implementation they are
    # passe with '-J"option=value switch"'.
    if ($valinuxlpr) {
    # VA-Linux/gnulpr
    if ($#{$config->{'options'}} >= 0) {
        for (@{$config->{'options'}}) {
        $commandline .= " -o $_";
        }
    }
    } else {
    # BSD
    if ($#{$config->{'options'}} >= 0) {
        $commandline .= " -J\"";
        for (@{$config->{'options'}}) {
        $commandline .= "$_ ";
        }
        $commandline .= "\"";
    }
    }

    # Add the remaining command line arguments, they are the names of
    # the files to print and also spooler-specific options
    $commandline .= " @ARGV";

    # Do it!

    #print "$commandline\n";
    return (system $commandline) >> 8;

}

sub query_lpd {
    my ($config) = $_[0];

    # standard lpq, emulate -a of lpq-cups
    # Read additional options
    GetOptions("a"   => \$opt_a);        # List jobs on all printers
    
    if (defined($opt_a)) {
    # Get all printer queues
    open QUEUELIST, "$sysdeps->{'lpd-lpc'} status 2>&1 | grep \":\$\" | ";
    my @queuelist = <QUEUELIST>;
    close QUEUELIST;
    # List the jobs on all the queues
    for (@queuelist) {
        my $queue = $_;
        chomp $queue;
        print "$queue\n";
        $queue =~ s/:$//;
        my $result = (system "$sysdeps->{'lpd-lpq'} -P $queue @ARGV") >> 8;
        if ($result != 0) {return $result};
    }
    } else {
    # List the jobs on the specified queue
    my $queue = "";
    if (defined($config->{'queue'})) {
        $queue = " -P $config->{'queue'}";
    }
    return (system "$sysdeps->{'lpd-lpq'}$queue @ARGV") >> 8;
    }
}

sub remove_lpd {
    my ($config) = $_[0];
    
    # Remove a job with the standard "lprm" command

    # Removing command
    my $commandline = "$sysdeps->{'lpd-lprm'}";

    # Add the printer queue argument
    if (defined($config->{'queue'})) {
    $commandline .= " -P $config->{'queue'}";
    }

    # Add the remaining command line arguments, they are the numbers
    # of the jobs to kill, the users whose jos to remove and also
    # spooler-specific options

    $commandline .= " @ARGV";

    # Do it!

    #print "$commandline\n";
    return (system $commandline) >> 8;

}

sub control_lpd {
    my ($config) = $_[0];
    
    # Control the printing system with the standard "lpc" command

    # Control command
    my $commandline = "$sysdeps->{'lpd-lpc'}";

    # Add the remaining command line arguments, they are the control command
    # with its arguments

    $commandline .= " @ARGV";

    # Do it!

    #print "$commandline\n";
    return (system $commandline) >> 8;

}

### Printing/Job manipulation functions for LPRng

sub print_lprng {
    my ($config) = $_[0];

    # Printing command
    my $commandline = "$sysdeps->{'lpd-lpr'}";

    # Add the printer queue argument
    if (defined($config->{'queue'})) {
    $commandline .= " -P $config->{'queue'}";
    }

    # Add the driver-specific options supplied by the user, if any
    if ($#{$config->{'options'}} >= 0) {
    for (@{$config->{'options'}}) {
        $commandline .= " -Z $_";
    }
    }

    # Add the remaining command line arguments, they are the names of
    # the files to print and also spooler-specific options
    $commandline .= " @ARGV";

    # Do it!

    #print "$commandline\n";
    return (system $commandline) >> 8;

}

sub query_lprng {
    my ($config) = $_[0];

    # We filter the output of lpq and rearrange it to have the same format
    # as of LPD and CUPS.

    GetOptions("l"   => \$opt_l);       # Long, more verbose output

    # List the jobs on the specified queue
    my $queue = "";
    if (defined($config->{'queue'})) {
    $queue = " -P $config->{'queue'}";
    }
    open LPQOUTPUT, "$sysdeps->{'lpd-lpq'}$queue @ARGV |" || return 1;
    my @lpqoutput = <LPQOUTPUT>;
    close LPQOUTPUT;
    # Filter the output
    for $line (@lpqoutput) {
    chomp $line;
    if ($line =~ m!^\s*(\S+)\s+([^@\s]+)@[^@\+\s]+\+[0-9]+\s+\S+\s+([0-9]+)\s+(\S+)\s+([0-9]+)\s+[0-9:]+\s*$!) {
        my ($rank, $owner, $jobid, $file, $size) = ($1, $2, $3, $4, $5);
        if (defined($opt_l)) {
        my $owner_rank = "$owner: $rank";
        if (length($owner_rank) > 40) {
            $owner_rank = substr($owner_rank, 0, 40);
        }
        if (length($file) > 40) {$file = substr($file, 0, 40);}
        print sprintf("\n%-40s [job %d]\n\t%-40s %d bytes\n",
                  $owner_rank, $jobid, $file, $size);
        } else {
        if (length($rank) > 6) {$rank = substr($rank, 0, 6)};
        if (length($owner) > 8) {$owner = substr($owner, 0, 8)};
        if (length($file) > 37) {$file = substr($file, 0, 37)};
        print sprintf("%-6s %-8s % 6d %-37s %d bytes\n",
                  $rank, $owner, $jobid, $file, $size);
        }
    } elsif ($line =~ m!\s*Rank\s+Owner!) {
        if (!defined($opt_l)) {
        print "Rank   Owner       Job File(s)                               Total Size\n";
        }
    } else {
        print("$line\n");
    }
    }
}

sub remove_lprng {
    my ($config) = $_[0];
    
    # Remove a job with the standard "lprm" command and emulate the "-"
    # option of the lprm command of BSD LPD

    # Removing command
    my $commandline = "$sysdeps->{'lpd-lprm'}";

    # Add the printer queue argument
    if (defined($config->{'queue'})) {
    $commandline .= " -P $config->{'queue'}";
    }

    # Replace the "-" option by the "all" option
    my $alljobs = "";
    for ($i = 0; ($i <= $#ARGV); $i++) {
    if ($ARGV[$i] =~ m!^\s*\-\s*$!) {
        $alljobs = " all";
        splice(@ARGV,$i,1);
        $i--;
    }
    }
    $commandline .= $alljobs;

    # Add the remaining command line arguments, they are the numbers
    # of the jobs to kill, the users whose jos to remove and also
    # spooler-specific options

    $commandline .= " @ARGV";

    # Do it!

    #print "$commandline\n";
    return (system $commandline) >> 8;

}

sub control_lprng {

    # The lpc command of lprng is compatible to the one of LPD, it has only
    # many more commands. So we use the "control_lpd" function also for
    # lprng.

}

### Printing/Job manipulation functions for CUPS

sub print_cups {
    my ($config) = $_[0];

    # Printing command
    my $commandline = "$sysdeps->{'cups-lpr'}";

    # Add the printer queue argument
    if (defined($config->{'queue'})) {
    $commandline .= " -P $config->{'queue'}";
    }

    # Add the driver-specific options supplied by the user, if any
    if ($#{$config->{'options'}} >= 0) {
    for (@{$config->{'options'}}) {
        $commandline .= " -o $_";
    }
    }

    # Add the remaining command line arguments, they are the names of
    # the files to print and also spooler-specific options
    $commandline .= " @ARGV";

    # Do it!

    #print "$commandline\n";
    return (system $commandline) >> 8;

}

sub query_cups {
    my ($config) = $_[0];

    # List the jobs on the specified queue
    my $queue = "";
    if (defined($config->{'queue'})) {
    $queue = " -P $config->{'queue'}";
    }
    return (system "$sysdeps->{'cups-lpq'}$queue @ARGV") >> 8;

}

sub remove_cups {
    my ($config) = $_[0];
    
    # Remove a job with the standard "lprm" command

    # Removing command
    my $commandline = "$sysdeps->{'cups-lprm'}";

    # Add the printer queue argument
    if (defined($config->{'queue'})) {
    $commandline .= " -P $config->{'queue'}";
    }

    # Add the remaining command line arguments, they are the numbers
    # of the jobs to kill, the users whose jos to remove and also
    # spooler-specific options

    $commandline .= " @ARGV";

    # Do it!

    #print "$commandline\n";
    return (system $commandline) >> 8;

}

sub control_cups {
    my ($config) = $_[0];

    # CUPS has no LPD/LPRng-compatible lpc command, so we must emulate
    # this functionality with the command line tools of CUPS.

    # The first command line argument (of the remaining ones) is the
    # control command (standard commands of lpc for LPD/LPRng)

    my $command = shift (@ARGV);

    if (!defined($command)) {
    die "You must supply a control command with the \"-C\" option!\n";
    } elsif (lc($command) eq "up") { # Turn on queue (queueing/printing)
    return (system "$sysdeps->{'cups-enable'} @ARGV; $sysdeps->{'cups-accept'} @ARGV") >> 8;
    } elsif (lc($command) eq "down") { # Turn off queue (queueing/printing)
    return (system "$sysdeps->{'cups-disable'} @ARGV; $sysdeps->{'cups-reject'} @ARGV") >> 8;
    } elsif (lc($command) eq "start") { # Turn on queue (printing)
    return (system "$sysdeps->{'cups-enable'} @ARGV") >> 8;
    } elsif (lc($command) eq "stop") { # Turn off queue (printing)
    return (system "$sysdeps->{'cups-disable'} @ARGV") >> 8;
    } elsif (lc($command) eq "enable") { # Accept new jobs
    return (system "$sysdeps->{'cups-accept'} @ARGV") >> 8;
    } elsif (lc($command) eq "disable") { # Reject new jobs
    return (system "$sysdeps->{'cups-reject'} @ARGV") >> 8;
    } elsif (lc($command) eq "move") { # Move jobs
    if (($#ARGV < 1) or ($#ARGV > 2)) {
        die "Usage of the \"move\" control command:\n\n   move oldqueue [ jobID ] newqueue\n\n";
    }
    # The first argument is always the source printer
    my $fromqueue = shift (@ARGV);
    # The second argument is the job ID or the destination
    my $jobid = shift (@ARGV);
    # The third argument is the destination
    my $toqueue = shift (@ARGV);
    if (!defined($toqueue)) {
        # No job ID given, move all jobs in the given queue
        $toqueue = $jobid;
        open LINES, "$sysdeps->{'cups-lpq'} -P $fromqueue |";
        my @lines = <LINES>;
        close LINES;
        for (@lines) {
        if ($_ =~ m!^\s*\S+\s+\S+\s+([0-9]+)\s+!) {
            system "$sysdeps->{'cups-lpmove'} $fromqueue-$1 $toqueue";
        }
        }
        return;
    } else {
        # Treat the specified job
        return (system "$sysdeps->{'cups-lpmove'} $fromqueue-$jobid $toqueue") >> 8;
    }
    } elsif ((lc($command) eq "hold") ||    # Hold job
         (lc($command) eq "release") || # Resume job
         (lc($command) eq "topq")) {    # Bring job to the top of the
                                        # queue
    if (($#ARGV < 0) or ($#ARGV > 1)) {
        die "Usage of the \"$command\" control command:\n\n   $command queue [ jobID ] \n\n";
    }
    # Clean up the command
    $command = lc($command);
    if ($command eq "release") {$command = "resume";} 
    if ($command eq "topq") {$command = "immediate";} 
    # The first argument is always the queue
    my $queue = shift (@ARGV);
    # The second argument is the job ID
    my $jobid = shift (@ARGV);
    if (!defined($jobid)) {
        # No job ID given, treat all jobs in the given queue
        open LINES, "$sysdeps->{'cups-lpq'} -P $queue |";
        my @lines = <LINES>;
        close LINES;
        for (@lines) {
        if ($_ =~ m!^\s*\S+\s+\S+\s+([0-9]+)\s+!) {
            system "$sysdeps->{'cups-lp'} -i $queue-$1 -H $command";
        }
        }
        return;
    } else {
        # Treat the specified job
        return (system "$sysdeps->{'cups-lp'} -i $queue-$jobid -H $command") >> 8;
    }
    } elsif (lc($command) eq "status") { # Queue status listing
    return (system "$sysdeps->{'cups-lpc'} status @ARGV") >> 8;
    } elsif (lc($command) eq "help") { # List the available commands
    print "The following control commands are available:\n\n";
    print "   up queue                : Turn on queue (queueing/printing)\n";
    print "   down queue              : Turn off queue (queueing/printing)\n";
    print "   start queue             : Turn on printing on queue\n";
    print "   stop queue              : Turn off printing on queue\n";
    print "   enable queue            : Make queue accepting new jobs\n";
    print "   disable queue           : Make queue rejecting new jobs\n";
    print "   move oldqueue [ jobid ] newqueue : \n";
    print "       Move job jobid in oldqueue to newqueue\n";
    print "       Move all jobs in oldqueue to newqueue when jobid not given\n";
    print "   hold queue [ jobid ]    : Hold job jobid or all jobs in queue\n";
    print "   release queue [ jobid ] : Release job jobid or all jobs in queue\n";
    print "   topq queue jobid        : Print job jobid in queue immediately\n";
    print "   status [ queue ]        : Status of queue or of all queues\n";
    print "   help                    : This help message\n\n";
    } else {
    die "Command \"$command\" not recognized!\n";
    }
    
}

### Printing/Job manipulation functions for PDQ

sub print_pdq {
    my ($config) = $_[0];

    # Printing command
    my $commandline = "$sysdeps->{'pdq-print'}";

    # Add the printer queue argument
    if (defined($config->{'queue'})) {
    $commandline .= " -P $config->{'queue'}";
    }

    # Add the driver-specific options supplied by the user, if any
    if ($#{$config->{'options'}} >= 0) {
    for (@{$config->{'options'}}) {
        my $option = $_;
        if ($option =~ m!^\s*([^=]+=[\+\-0-9\.]+)\s*$!) {
        # Foomatic treats numerical options as PDQ arguments ("-a"),
        # but there can be enumerated options with numbers as choices,
        # so we give the option in both styles. Since PDQ silently
        # ignores non-existent options, the wrong form of the option
        # will be ignored.
        $commandline .= " -aOPT_$1";
        }
        # Enumerated and boolean options are PDQ options ("-o"),
        # the "=" has to be replaced by "_" to work with the
        # PDQ-O-MATIC-generated configuration
        $option =~ s/=/_/;  # Replace only the first "="
        $commandline .= " -o$option";
    }
    }

    # The "-#" option for multiple copies is not supported by the print
    # command "pdq". So we launch "pdq" once per copy. Thw command line
    # will be modified appropriately directly before the printing command
    # is launched.
    # Note: '#' as option name is not supported by the Perl library
    # Getopt::Long.
    my $num_copies = 1;
    my $file_in_args = 0;
    my $i;
    for ($i = 0; ($i <= $#ARGV); $i++) {
    if ($ARGV[$i] =~ m!^\s*\-\#\s*([0-9]+)\s*$!) {
        $num_copies = $1;
        splice(@ARGV,$i,1);
        $i--;
    } elsif ($ARGV[$i] =~ m!^\s*\-\#\s*$!) {
        if ((defined $ARGV[$i+1]) && 
        ($ARGV[$i+1] =~ m!^\s*([0-9]+)\s*$!)) {
        $num_copies = $1;
        splice(@ARGV,$i,2);
        $i--;
        }
    } elsif ($ARGV[$i] =~ m!^\s*[^\-]+!) {
        $file_in_args = 1;
    }
    }

    # Add the remaining command line arguments, they are the names of
    # the files to print and also spooler-specific options
    $commandline .= " @ARGV";

    # Do it!
    #print "$commandline\n"; return 0;

    if ($num_copies == 1) {
    return (system $commandline) >> 8;
    } else {
    if ($file_in_args == 0) {
        # We print from standard input, so we must buffer it to be able
        # to print multiple copies
        my @job_contents = <STDIN>;
        my $i;
        for ($i = 0; $i < $num_copies; $i++) {
        open PIPE, "| $commandline" || 
            die "Could not launch printing command!\n";
        print PIPE @job_contents;
        close PIPE;
        }
        return 0;
    } else {
        # We print files
        my $result = 0;
        my $i;
        for ($i = 0; $i < $num_copies; $i++) {
        $result = (system $commandline) >> 8;
        if ($result != 0) {return $result};
        }
        return 0;
    }
    }
}

sub query_pdq {
    my ($config) = $_[0];

    # PDQ has no possiblity to list the printing jobs from the command
    # line.  So we read the *.status files in ~/.printjobs and generate
    # the job entry lines from that information.

    # Read additional options
    GetOptions("a"   => \$opt_a,        # List jobs on all printers
           "l"   => \$opt_l);       # Long, more verbose output

    # Make sure that a printer is specified when the "-a" option is not
    # given
    if ((!(defined($opt_a))) && (!(defined($config->{'queue'})))) {
    $config->{'queue'} = get_pdq_default_printer();
    }

    # If the user specified job numbers, list them. User names on the
    # command line do not make much sense, because under PDQ a user can
    # only see ones own jobs, they are supported here to do not break
    # front ends
    my $joblist = {};
    my $userlist = {};
    my $listalljobs = 1;
    my $listallusers = 1;
    my $i;
    for ($i = 0; ($i <= $#ARGV); $i++) {
    if ($ARGV[$i] =~ m!^\s*([0-9]+)\s*$!) {
        my $job=$1;
        # Fill up the number with zeros so that it has three digits
        while (length($job) < 3) {$job = "0" . $job;}
        $joblist->{$job} = 1;
        $listalljobs = 0;
        splice(@ARGV,$i,1);
        $i--;
    } elsif ($ARGV[$i] =~ m!^\s*[^\-]+!) {
        my $user=$ARGV[$i];
        $userlist->{$user} = 1;
        $listallusers = 0;
        splice(@ARGV,$i,1);
        $i--;
    } else {
        die "Unknown option: $ARGV[$i]\n";
    }
    }

    # When we list only the jobs for a specific printer, display the
    # printer status at first. In PDQ the printer status cannot be
    # retrived from the command line, so we put a dummy line
    # "<printer> is ready".
    if (!(defined($opt_a))) {
    if (!pdq_check_printer($config->{'queue'})) {
        die "$config->{'queue'}: unknown printer\n";
    }
    print "$config->{'queue'} is ready\n";
    }

    # Read in the names of all job status files in ~/.printjobs/
    my @jobnumbers = ();
    opendir PJDIR, "$ENV{'HOME'}/.printjobs" || 
    return 0;  # No ~/.printjobs/ directory ==> no jobs
    while ($filename = readdir(PJDIR)) {
    if ($filename =~ m!^([0-9][0-9][0-9]).status$!) {
        push (@jobnumbers, $1);
    }
    }
    close PJDIR;
    # Sort the filenames in descending order to get the most recent jobs
    # listed at first
    @jobnumbers = sort {$b cmp $a} @jobnumbers;

    # Now list the jobs
    my $firstline = 1;
    for ($i = 0; $i <= $#jobnumbers; $i ++) {
    # Omit this job if job numbers are specified on the command line, but
    # not the one of this job
    next if (($listalljobs == 0) && 
         (!(defined($joblist->{$jobnumbers[$i]}))));
    # Read the job status file
    next if !open JOBSTATUSFILE, 
    "< $ENV{'HOME'}/.printjobs/$jobnumbers[$i].status";
    my $jobstatusdata = join("", <JOBSTATUSFILE>);
    close JOBSTATUSFILE;
    # Extract the important fields from the file
    # Status:
    my $status = "";
    if ($jobstatusdata =~ m!^\s*status\s*\=\s*{([^{}]*)}\s*$!m) {
        $status = $1;
    }
    # Omit this job when it has no status field or when the job is
    # already finished, cancelled, or aborted
    next if (($status eq "") || ($status =~ m!aborted!) || 
         ($status =~ m!finished!) || ($status =~ m!cancelled!));
    # Avoid spaces in the status field, so that frontends can separate the
    # fields from the job list more easily.
    $status =~ s/\s//g;
    # Printer
    my $printer;
    if ($jobstatusdata =~ m!^\s*printer\s*\=\s*{([^{}]*)}\s*$!m) {
        $printer = $1;
    }
    # Omit this job when we are querying only the jobs of another printer
    next if ((!(defined($opt_a))) && ($printer ne $config->{'queue'}));
    # Owner
    my $owner;
    if ($jobstatusdata =~ 
    m!^\s*env_driver\s*\=\s*{.*\"LOGNAME\"\s*=\s*\"([^\"]*)\".*}\s*$!m) {
        $owner = $1;
    }
    # Omit this job if user names are specified on the command line, but
    # not the owner of this job
    next if (($listallusers == 0) && 
         (!(defined($userlist->{$owner}))));
    # File
    my $file;
    if ($jobstatusdata =~ m!^\s*input_filename\s*\=\s*{([^{}]*)}\s*$!m) {
        $file = $1;
    }
    # Size of job input file
    my $size;
    if (-f "$ENV{'HOME'}/.printjobs/$jobnumbers[$i].raw") {
        $size = (stat("$ENV{'HOME'}/.printjobs/$jobnumbers[$i].raw"))[7];
    }

    # Now get the info nicely onto the screen
    my $outputline;
    if ($opt_l) {
        # Long (3+ lines per job) mode
        my $owner_status = "$owner: $status";
        if (length($owner_status) > 40) {
        $owner_status = substr($owner_status, 0, 40);
        }
        if (length($file) > 40) {$file = substr($file, 0, 40);}
        $outputline = sprintf("\n%-40s [job %d]\n\t%-40s %d bytes\n",
                  $owner_status, $jobnumbers[$i], $file,
                  $size);
    } else {
        # Short (1 line per job) mode
        if ($firstline == 1) {
        # headline
        print "Rank   Owner      Job  File(s)                               Total Size\n";
        $firstline = 0;
        }
        if (length($status) > 6) {$status = substr($status, 0, 6);}
        if (length($owner) > 10) {$owner = substr($owner, 0, 10);}
        if (length($file) > 37) {$file = substr($file, 0, 37);}
        $outputline = sprintf("%-6s %-10s % 3d  %-37s %d bytes\n",
                  $status, $owner, $jobnumbers[$i], $file,
                  $size);
    }
    print $outputline;
    }

    # Say "no entries" if no job was listed
    if ($firstline == 1) {
    print "no entries\n";
    }
    
}

sub remove_pdq {
    my ($config) = $_[0];

    # PDQ has no possiblity to remove printing jobs from the command
    # line.  "xpdq" cancels jobs by "touch"ing <job id>.cancelled
    # files in ~/.printjobs and setting the permissions of these files
    # to 0600.

    # Make sure that a printer is specified when the "-a" option is not
    # given
    if (!(defined($config->{'queue'}))) {
    $config->{'queue'} = get_pdq_default_printer();
    }

    # If the user specified job numbers, list them. User names on the
    # command line do not make much sense, because under PDQ a user can
    # only see ones own jobs, they are supported here to do not break
    # front ends
    my $joblist = {};
    my $userlist = {};
    my $nojob = 1;
    my $nouser = 1;
    my $opt_alljobs = 0;
    my $i;
    for ($i = 0; ($i <= $#ARGV); $i++) {
    if ($ARGV[$i] =~ m!^\s*([0-9]+)\s*$!) {
        my $job=$1;
        # Fill up the number with zeros so that it has three digits
        while (length($job) < 3) {$job = "0" . $job;}
        $joblist->{$job} = 1;
        $nojob = 0;
        splice(@ARGV,$i,1);
        $i--;
    } elsif ($ARGV[$i] =~ m!^\s*[^\-]+!) {
        my $user=$ARGV[$i];
        $userlist->{$user} = 1;
        $nouser = 0;
        splice(@ARGV,$i,1);
        $i--;
    } elsif ($ARGV[$i] =~ m!^\s*\-\s*$!) {
        $opt_alljobs = 1;
        splice(@ARGV,$i,1);
        $i--;
    } else {
        die "Unknown option: $ARGV[$i]\n";
    }
    }

    # Does the chosen printer exist
    if (!pdq_check_printer($config->{'queue'})) {
    die "$config->{'queue'}: unknown printer\n";
    }

    # Read in the names of all job status files in ~/.printjobs/
    my @jobnumbers = ();
    opendir PJDIR, "$ENV{'HOME'}/.printjobs" || 
    return 0;  # No ~/.printjobs/ directory ==> no jobs
    while ($filename = readdir(PJDIR)) {
    if ($filename =~ m!^([0-9][0-9][0-9]).status$!) {
        push (@jobnumbers, $1);
    }
    }
    close PJDIR;
    # Sort the filenames in descending order to get the most recent
    # (probably still waiting) jobs removed at first
    @jobnumbers = sort {$b cmp $a} @jobnumbers;

    # Now search the jobs to remove
    my $nothingremoved = 1;
    my $mostrecent = 1;
    for ($i = 0; $i <= $#jobnumbers; $i ++) {
    # Read the job status file
    next if !open JOBSTATUSFILE, 
    "< $ENV{'HOME'}/.printjobs/$jobnumbers[$i].status";
    my $jobstatusdata = join("", <JOBSTATUSFILE>);
    close JOBSTATUSFILE;
    # Extract the important fields from the file
    # Status:
    my $status = "";
    if ($jobstatusdata =~ m!^\s*status\s*\=\s*{([^{}]*)}\s*$!m) {
        $status = $1;
    }
    # Omit this job when it is already finished, cancelled, or aborted
        # (then it cannot be killed any more)
    next if (($status eq "") || ($status =~ m!aborted!) || 
         ($status =~ m!finished!) || ($status =~ m!cancelled!));
    # Printer
    my $printer;
    if ($jobstatusdata =~ m!^\s*printer\s*\=\s*{([^{}]*)}\s*$!m) {
        $printer = $1;
    }
    # Omit this job when we want to remove jobs on another printer
    next if ((!(defined($opt_a))) && ($printer ne $config->{'queue'}));
    # Owner
    my $owner;
    if ($jobstatusdata =~ 
    m!^\s*env_driver\s*\=\s*{.*\"LOGNAME\"\s*=\s*\"([^\"]*)\".*}\s*$!m) {
        $owner = $1;
    }

    # Kill the job when it is in the scope of jobs defined by the
    # command line
    if ((($nojob == 0) && (defined($joblist->{$jobnumbers[$i]}))) || 
        (($nouser == 0) && (defined($userlist->{$owner}))) ||
        (($opt_alljobs == 1) && ($ENV{'LOGNAME'} eq $owner)) ||
        (($opt_alljobs == 1) && ($ENV{'LOGNAME'} eq "root")) ||
        (($mostrecent == 1) && ($nojob == 1) && ($nouser == 1) && 
         ($opt_alljobs == 0))) {
        system("touch $ENV{'HOME'}/.printjobs/$jobnumbers[$i].cancelled; chmod 0600 $ENV{'HOME'}/.printjobs/$jobnumbers[$i].cancelled");
        print STDERR "Cancel request for job $jobnumbers[$i] submitted!\n";
        $nothingremoved = 0;
    }
    $mostrecent = 0;
    }

    # Say "No cancel request sent" if no job was killed
    if ($nothingremoved == 1) {
    print STDERR "no cancel request sent\n";
    }
}

sub control_pdq {

    # PDQ does not have functionality for enabling/disabling queues, 
    # holding/releasing/moving jobs, etc.

    die "Advanced queue/job manipulation functionality is not supported under PDQ!\n";

}

sub get_pdq_default_printer {

    # Read the help message of PDQ
    open PDQHELP, "pdq --help 2>&1 |";
    $pdqhelp = join ("", <PDQHELP>);
    close PDQHELP;

    # Search the "default" line
    if ($pdqhelp =~ m!default\s+printer.*\s+(\S+)\s*$!mg) {
    return $1;
    } else {
    die "No default printer defined, you have to specify a printer with \"-P\" or \"-d\"!\n";
    }

}

sub pdq_check_printer {
    my $printer = $_[0];

    # Read the help message of PDQ
    open PDQHELP, "pdq --help 2>&1 |";
    $pdqhelp = join ("", <PDQHELP>);
    close PDQHELP;

    # Search the appropriate printer entry
    return ($pdqhelp =~ m!^\s+$printer\s+\-\s+.*\s+\-\s*$!mg);

}

sub detect_spooler {
    # If tcp/localhost:631 opens, cups
    my $page = $db->getpage('http://localhost:631/', 1);
    if ($page =~ m!Common UNIX Printing System!) {
    return 'cups';
    }

    # Else if /etc/printcap, some sort of lpd thing
    if (-f $sysdeps->{'lpd-pcap'}) {
    # If -f /etc/lpd.conf, lprng
    if (-f $sysdeps->{'lprng-conf'}) {
        return 'lprng';
    } elsif (-x $sysdeps->{'lpd-bin'}) {
        # There's a /usr/sbin/lpd
        return 'lpd';
    }
    }

    # pdq executable in our path somewhere?
    for (split(':', $ENV{'PATH'})) {
    if (-x "$_/pdq") {
        return 'pdq';
    }
    }

    return undef;
}

sub unimp {
    die "Sorry, $action for your spooler is unimplemented...\n";
}

sub help {

    my $action = 'all';
# Set up the help message depending on how we were called
    if ($progname =~ m!^lpc!) { # 'lpc*' ==> control 
    $action = 'control';
    print STDERR <<EOF;
Usage: $progname [ -s spooler ] [ -i ] command [ arguments ]
    or $progname -h
EOF
    } elsif ($progname =~ m!^lprm!) { # 'lprm*' ==> remove jobs 
    $action = 'remove';
    print STDERR <<EOF; 
Usage: $progname [ -s spooler ] [ -P queuename ] [ - ] [ -i ] [ jobid1 jobid2 ... ]
    or $progname -h
EOF
    } elsif ($progname =~ m!^lpq!) { # 'lpq*' ==> list jobs 
    $action = 'query';
    print STDERR <<EOF;
Usage: $progname [ -s spooler ] [ -P queuename ] [ -i ] [ -a ] [ user1 user2 ... ]
    or $progname -h
EOF
    } elsif (($progname =~ m!^lpr!) || ($progname =~ m!^lp!)) { # 'lpr*', 'lp*' ==> print 
    $action = 'print';
    print STDERR <<EOF;
Usage: $progname [ -s spooler ] [ -P queuename ] \
               [ -o option1=value1 -o option2 ... ] [ -i ] [ file1 file2 ... ]
    or $progname -S [ -s spooler ] [ -i ]
    or $progname -h [ -s spooler ] [ -P queuename ] [ -i ]
EOF
    } else { # name does not determine the action
    print STDERR <<EOF;
Usage: $progname [ -s spooler ] [ -P queuename ] \
               [ -o option1=value1 -o option2 ... ] [ -i ] \
           [ file1 file2 ... ]
    or $progname -Q [ -s spooler ] [ -P queuename ] [ -i ] [ -a ] \
           [ user1 user2 ... ]
    or $progname -R [ -s spooler ] [ -P queuename ] [ - ] [ -i ] \
           [ jobid1 jobid2 ... ]
    or $progname -C [ -s spooler ] [ -i ] command [ arguments ]
    or $progname -S [ -s spooler ] [ -i ]
    or $progname -h [ -s spooler ] [ -P queuename ] [ -i ]
EOF
    }

     print STDERR <<EOF;

 -s spooler      Explicit spooler type (cups,lpd,lprng,pdq)
EOF

    if ($action ne 'control') {
    print STDERR <<EOF;
 -P queuename    Command should apply to this queue
EOF
    }

    if (($action eq 'print') || ($action eq 'all')) {
    print STDERR <<EOF;
 -o option=value Set option to value
 -o option       Set the switch option
 -\# n            Print n copies
 file1 file2 ... Files to be printed, when no file is given, standard input
                 will be printed
EOF
    }

    if ($action eq 'all') {
    print STDERR <<EOF;
 -Q              Query the jobs in a queue
EOF
    }

    if (($action eq 'query') || ($action eq 'all')) {
    print STDERR <<EOF;
 -a              Query the jobs in all queues
 user1 user2 ... Users whose jobs should be listed
EOF
    }

    if ($action eq 'all') {
    print STDERR <<EOF;
 -R              Remove a job from a queue
EOF
    }

    if (($action eq 'remove') || ($action eq 'all')) {
    print STDERR <<EOF;
 -               Remove all your jobs
 jobid1 jobid2   IDs of the jobs to be removed
EOF
    }

    if ($action eq 'all') {
    print STDERR <<EOF;
 -C              Execute control commands for queue/job manipulation
EOF
    }

    if (($action eq 'control') || ($action eq 'all')) {
    print STDERR <<EOF;
 command [ arguments ]  Control command for queue/job manipulation. The 
                 commands are the ones of the BSD "lpc" utility. Use
         the control command "help" to get a list of supported 
                 commands. Note: the amount of commands varies with the
                 spooler, but the same commands given under different 
                 spoolers do the same thing.
EOF
    }

    print STDERR <<EOF;
 -i              Interactive mode: You will be asked if $progname
                 is in doubt about something. Otherwise $progname
         uses auto-detection or quits with an error.
EOF

    if (($action eq 'print') || ($action eq 'all')) {
    print STDERR <<EOF;
 -S              Save the chosen spooler as the default spooler
 -h              Show this message or show a list of available options if a 
                 queue is specified

EOF
    } else {
    print STDERR <<EOF;
 -h              Show this message

EOF
    }

    exit 0;
}

# Help on printer-specific options
sub help_options {
    my ($config) = $_[0];
    
    # Is there an easier way to do this?
    eval `foomatic-configure -P -n $config->{'queue'} -s $config->{'spooler'}`;
    print "Available options for queue $config->{'queue'}:\n";
    
    foreach my $arg (@{$QUEUES[0]->{'args'}}) {
        next if $arg->{'hidden'};
        my @vals = ();

        print "  $arg->{'name'} : < ";
        foreach my $val (@{$arg->{'vals'}}) {
            push @vals, $val->{'value'};
        }
        print join(' | ', @vals) . " >\n";
    }

    exit 0;
}