source: client/bin/gbq @ 9fdf4a1

debianmacno-cups
Last change on this file since 9fdf4a1 was 9fdf4a1, checked in by Kyle Brogle <broglek@…>, 14 years ago

Fixed gbq bug with uninitialized values resulting from having an Artist but
no Title tag

Added more helpful error messages to gb{q,r,rm} when they can't contact the queue

  • Property mode set to 100755
File size: 1.2 KB
Line 
1#!/usr/bin/perl
2
3# Written by Jessica Hamrick (C) 2010
4
5use strict;
6use warnings;
7
8use Net::CUPS;
9use Net::CUPS::Destination;
10
11my $usage = "Usage: gbq QUEUE\n";
12
13my $q = $ARGV[0];
14
15if (!$q) {
16    print $usage;
17    exit 1
18}
19
20my $configpath = "$ENV{'HOME'}/.gutenbach/$q";
21if (! -e $configpath) {
22    print "Queue '$q' does not exist!  Did you forget to add it with 'gutenbach-client-config'?\n";
23    exit 1;
24}
25
26my ($host, $queue);
27
28if (-r $configpath) {
29    local $/;
30    my $fh;
31    open $fh, $configpath;
32    eval <$fh>;
33}
34
35my $cups = Net::CUPS->new();
36$cups->setServer("$host");
37my $printer = $cups->getDestination("$queue");
38
39unless( $printer){
40    print "Cannot access queue $q...do you have network connectivity and permission to view the queue?\n";
41    exit 1;
42}
43print "Queue listing for queue '$queue' on '$host'\n\n";
44print "Job ID\t\tOwner\t\tTitle\n";
45print "-----------------------------------------------------------------\n";
46
47my @jobs = $printer->getJobs(0, 0);
48my ($job_ref, $jobid);
49
50foreach $jobid(@jobs) 
51{       
52        $job_ref = $printer->getJob($jobid);
53        my $id = $job_ref->{'id'};
54        my $user = $job_ref->{'user'};
55        my $title = $job_ref->{'title'};
56
57        print "$id\t\t$user\t\t$title\n";
58}
Note: See TracBrowser for help on using the repository browser.