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.6 KB
|
Rev | Line | |
---|
[fe74c7c] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | # Written by Jessica Hamrick (C) 2010 |
---|
| 4 | |
---|
| 5 | use strict; |
---|
| 6 | use warnings; |
---|
| 7 | |
---|
[b58aada] | 8 | use Net::CUPS; |
---|
| 9 | use Net::CUPS::Destination; |
---|
| 10 | use Image::ExifTool qw(ImageInfo); |
---|
| 11 | |
---|
[38388ac] | 12 | my $usage = "Usage: gbr QUEUE FILES\n"; |
---|
[fe74c7c] | 13 | |
---|
| 14 | my $q = $ARGV[0]; |
---|
[38388ac] | 15 | my @files = @ARGV[1 .. $#ARGV]; |
---|
[fe74c7c] | 16 | |
---|
[38388ac] | 17 | if (!$q or !@files) { |
---|
[fe74c7c] | 18 | print $usage; |
---|
| 19 | exit 1 |
---|
| 20 | } |
---|
| 21 | |
---|
| 22 | my $configpath = "$ENV{'HOME'}/.gutenbach/$q"; |
---|
[85a1ac1] | 23 | if (! -e $configpath) { |
---|
[0d02eca] | 24 | print "Queue '$q' does not exist! Did you forget to add it with 'gutenbach-client-config'?\n"; |
---|
[85a1ac1] | 25 | exit 1; |
---|
| 26 | } |
---|
| 27 | |
---|
[fe74c7c] | 28 | my ($host, $queue); |
---|
| 29 | |
---|
| 30 | if (-r $configpath) { |
---|
| 31 | local $/; |
---|
| 32 | my $fh; |
---|
| 33 | open $fh, $configpath; |
---|
| 34 | eval <$fh>; |
---|
| 35 | } |
---|
| 36 | |
---|
[b58aada] | 37 | my $cups = Net::CUPS->new(); |
---|
| 38 | $cups->setServer("$host"); |
---|
| 39 | my $printer = $cups->getDestination("$queue"); |
---|
[9fdf4a1] | 40 | unless( $printer){ |
---|
| 41 | print "Cannot access queue $q...do you have network connectivity and permission to view the queue?\n"; |
---|
| 42 | exit 1; |
---|
| 43 | } |
---|
[b58aada] | 44 | my ($jobid, $title); |
---|
[c5a98db] | 45 | |
---|
[38388ac] | 46 | foreach my $file(@files) { |
---|
| 47 | if ($file =~ m|http://www\.youtube\.com/watch\?v=|) { |
---|
[b58aada] | 48 | open FILE, ">", "/tmp/gutenbach-youtube\n" or die "Couldn't create temporary file"; |
---|
| 49 | print FILE $file; |
---|
| 50 | $title = $file; |
---|
| 51 | $file = "/tmp/gutenbach-youtube"; |
---|
| 52 | $printer->addOption("copies", 42); |
---|
[38388ac] | 53 | } |
---|
| 54 | else { |
---|
[b58aada] | 55 | my $fileinfo = ImageInfo($file); |
---|
| 56 | my $magic = $fileinfo->{FileType}; |
---|
| 57 | |
---|
[9fdf4a1] | 58 | if ($magic && exists($fileinfo->{Title}) && exists($fileinfo->{Artist}) && exists($fileinfo->{Album})) { |
---|
[b58aada] | 59 | $title = $fileinfo->{'Title'}." - ".$fileinfo->{'Artist'}." - ".$fileinfo->{'Album'}; |
---|
| 60 | } |
---|
| 61 | else { |
---|
| 62 | $title = $file; |
---|
[38388ac] | 63 | } |
---|
| 64 | } |
---|
| 65 | |
---|
[b58aada] | 66 | $jobid = $printer->printFile($file, $title); |
---|
| 67 | |
---|
| 68 | if ($jobid) { |
---|
| 69 | print "Sent job '$title' (id $jobid)\n"; |
---|
| 70 | } |
---|
| 71 | else { |
---|
| 72 | print "Error sending job '$title'\n"; |
---|
| 73 | } |
---|
[c5a98db] | 74 | } |
---|
Note: See
TracBrowser
for help on using the repository browser.