source: gutenbach/debian/lib/gutenbach-filter @ edce45f

debianmacno-cupsnodebathenaweb
Last change on this file since edce45f was 80bbeea, checked in by Jessica B. Hamrick <jhamrick@…>, 14 years ago

Fixed path to config file, and changed the defaults.

  • Property mode set to 100755
File size: 8.8 KB
Line 
1#!/usr/bin/perl
2# Play the data on STDIN as an audio file
3#
4# $Id: gutenbach-filter,v 1.26 2009/02/20 00:27:17 geofft Exp root $
5# $Source: /usr/local/bin/RCS/gutenbach-filter,v $
6#
7# TODO
8# ----
9# Make this structured code. It's a mess.
10# Repeat what we just played for EXT files too
11# Support HTTP Auth on ogg streams
12# License, cleanup and package
13#
14# Jered Floyd <jered@mit.edu> takes very little credit for this code
15# apparently neither does Quentin Smith <quentin@mit.edu>
16
17use Image::ExifTool qw(ImageInfo);
18use File::Spec::Functions;
19use File::Temp qw{tempdir};
20use File::Basename qw(basename);
21use LWP::UserAgent;
22use Data::Dumper;
23use IPC::Open2;
24
25my $zephyr_class = `hostname`;
26chomp($zephyr_class);
27my $host = `hostname`;
28chomp($host);
29my $queue = "gutenbach";
30
31# Configuration
32my $config_file = "/usr/lib/gutenbach/config/gutenbach-filter-config.pl";
33if (-r $config_file) {
34    # Inline the configuration file
35    local $/;
36    my $fh;
37    open $fh, $config_file;
38    eval <$fh>;
39}
40
41my $ua = new LWP::UserAgent;
42
43close(STDERR);
44open(STDERR, ">>", "/tmp/gutenbach.log") or warn "Couldn't open log: $!";
45
46$ENV{"TERM"}="vt100";
47
48print STDERR "STDERR FROM SPOOL FILTER\n";
49
50# set real uid to be effective uid
51$< = $>;
52
53# Select the correct output device and set the volume
54#system("amixer -q set Headphone 100\% unmute");
55
56# The command line we get from lpd is (no spaces between options and args):
57#  -C lpr -C class
58#  -A LPRng internal identifier
59#  -H originating host
60#  -J lpr -J jobname (default: list of files)
61#  -L lpr -U username
62#  -P logname
63#  -Q queuename (lpr -Q)
64#  -Z random user-specified options
65#  -a printcap af (accounting file name)
66#  -d printcap sd entry (spool dir)
67#  -e print job data file name (currently being processed)
68#  -h print job originiating host (same as -H)
69#  -j job number in spool queue
70#  -k print job control file name
71#  -l printcap pl (page length)
72#  -n user name (same as -L)
73#  -s printcap sf (status file)
74#  -w printcap pw (page width)
75#  -x printcap px (page x dimension)
76#  -y printcap py (page y dimension)
77# accounting file name
78
79printf(STDERR "Got \@ARGV: %s\n", Dumper(\@ARGV));
80
81my %opts;
82
83my @NEWARGV;
84
85foreach my $arg (@ARGV) {
86  if ($arg =~ m/^-([a-zA-Z])(.*)$/) {
87    $opts{$1} = $2;
88  } else {
89    push @NEWARGV, @ARGV;
90  }
91}
92
93@ARGV = @NEWARGV;
94
95printf(STDERR Dumper(\%opts));
96
97print(STDERR '/usr/bin/zwrite -d -n -c '.$zephyr_class.' -i '.$queue.'@'.$host.' -s "Gutenbach Music Spooler"');
98
99# Status messages at start of playback
100open(ZEPHYR, '|/usr/bin/zwrite -d -n -c '.$zephyr_class.' -i '.$queue.'@'.$host.' -s "Gutenbach Music Spooler"');
101
102# For the Now Playing remctl command
103open(STATUS, '>', '/var/run/gutenbach/status') or die("Can't open status file /var/run/gutenbach/status");
104
105
106print(ZEPHYR "$opts{'n'}\@$opts{'H'} is playing:\n");
107print(STATUS "User: $opts{'n'}\@$opts{'H'}\n");
108
109# SIGHUP handler
110sub clear_status {
111    # Possible race condition if the previous status is still going
112    open(STA, '>', '/var/run/gutenbach/status');
113    close(STA);
114    open(ZEPH, '|/usr/bin//zwrite -d -n -c '.$zephyr_class.' -i '.$queue.'@'.$host.' -s "Gutenbach Music Spooler"');
115    print(ZEPH "Playback aborted.\n");
116    close(ZEPH);
117    die;
118}
119$SIG{HUP} = \&clear_status;
120
121# So, the file we're currently processing is "-d/-e".
122
123# Read the metadata information from the file.
124my ($filepath) = catfile($opts{'d'}, $opts{'e'});
125my ($fileinfo) = ImageInfo($filepath);
126my ($magic) = $fileinfo->{FileType};
127
128if ($magic) {
129    printf(ZEPHYR "%s file %s\n", $magic, $opts{'J'});
130    printf(STATUS "Filetype: %s\n", $magic);
131    printf(STATUS "Filename: %s\n", $opts{'J'});
132    if (exists $fileinfo->{'Title'}) {
133        printf(ZEPHYR "\@b{%s}\n", $fileinfo->{'Title'}) if exists $fileinfo->{'Title'};
134        printf(STATUS "Title: %s\n", $fileinfo->{'Title'});
135    }
136    foreach my $key (qw/Artist Album AlbumArtist/) {
137        if (exists $fileinfo->{$key}) {
138            printf(ZEPHYR "%s\n", $fileinfo->{$key}) if exists $fileinfo->{$key};
139            printf(STATUS "%s: %s\n", $key, $fileinfo->{$key});
140        }
141    }
142    my $tempdir = tempdir();
143    $opts{'J'} =~ s/_mp3/.mp3/; #awful hack -- geofft
144    my $newpath = $tempdir . '/' . basename($opts{'J'});
145    symlink($filepath, $newpath);
146    $filepath = $newpath;
147}
148elsif ($opts{'C'} eq 'Z') {
149    $filepath = resolve_external_reference($filepath, \%opts);
150    if ($filepath =~ m|http://www\.youtube\.com/watch\?v=|) {
151        $pid = open2($out, $in, qw{youtube-dl -g}, $filepath);
152        #$title = <$out>;
153        $title = "";
154        print ZEPHYR "YouTube video $filepath\n$title";
155        print STATUS "YouTube video $filepath\n$title";
156        $filepath = <$out>;
157        chomp $filepath;
158        waitpid $pid, 0;
159    } else {
160        print STDERR "Resolved external reference to $filepath\n";
161        printf(ZEPHYR "%s\n", $filepath);
162        printf(STATUS "External: %s\n", $filepath);
163    }
164}
165elsif (-T $filepath) {
166    split_playlist($filepath, \%opts);
167    close(ZEPHYR);
168    close(STATUS);
169    exit 0;
170}
171
172#printf(STDERR "Job priority %s\n", $opts{'C'}) if $opts{'C'} eq 'Z';
173#printf(ZEPHYR "Job priority %s\n", $opts{'C'}) if ($opts{'C'} && ($opts{'C'} ne 'A'));
174close(ZEPHYR);
175close(STATUS);
176play_mplayer_audio($filepath, \%opts);
177
178if ($magic) {
179    unlink($newpath);
180    rmdir($tempdir);
181}
182
183# Play an external stream reference
184sub resolve_external_reference {
185    # Retrieve those command line opts.
186    my ($filepath, $opts) = @_;
187
188    my $format, $uri, $userpass;
189
190    if (<STDIN> =~ /^(\S+)/) {
191        $uri=$1;
192
193        if ($uri =~ m|http://www\.youtube\.com/watch\?v=|) {
194            return $uri;
195        }
196
197        my $response = $ua->head($uri);
198       
199        $contenttype=($response->content_type() or "unknown");
200       
201        if ($contenttype eq "audio/mpeg") { $format="MP3" }
202        elsif ($contenttype eq "application/x-ogg") { $format="OGG" }
203        elsif ($contenttype eq "application/ogg") { $format="OGG" }
204        elsif ($contenttype eq "audio/x-scpls") { $format="SHOUTCAST" }
205        else {
206            print ZEPHYR
207                "Unknown Content-Type $contenttype for URI $uri\n";
208        }
209    } else {
210        print ZEPHYR "Couldn't read URI for external reference\n";
211        return $filepath;
212    }
213
214    if ($format eq "SHOUTCAST") {
215        print ZEPHYR "Shoutcast playlist...\n";
216        #Don't close ZEPHYR yet, will print the name of the stream if available
217        return &get_shoutcast($uri);
218    } elsif ($format eq "MP3") {
219    } elsif ($format eq "OGG") {
220    } else {
221      print ZEPHYR "Unrecognized stream format: $format\n";
222    }
223    return $uri;
224}
225
226sub split_playlist {
227    my ($file, $opts) = @_;
228
229    my $i = 0;
230   
231    while (<STDIN>) {
232        chomp;
233        if (/^([^#]\S+)/) {
234            printf (STDERR "Found line: %s\n", $_);
235            open(LPR, "|-", 'mit-lpr', '-P'.$queue.'@localhost', '-CZ', '-J'.$opts->{J});
236            print LPR $1;
237            close(LPR);
238        $i++;
239        }
240    }
241    printf(ZEPHYR "Playlist containing %d valid entries, split into separate jobs.\n", $i);
242}
243
244# Process a Shoutcast playlist
245# get_shoutcast(URI)
246sub get_shoutcast {
247  my $uri = shift(@_);
248 
249  my $response = $ua->get($uri);
250
251  foreach (split("\n", $response->content())) {
252      if (/^File\d+=(\S+)/) {
253          push(@uris, $1);
254      }
255      if (/^Title\d+=(.+)$/) {
256          push(@titles, $1);
257      }
258  }
259 
260  # choose a random server
261  $server = int(rand scalar(@uris));
262  # print the name of the stream if available
263  print ZEPHYR "$titles[$server]\n";
264  return $uris[$server];
265}
266
267sub play_mplayer_audio {
268    my ($filepath, $opts) = @_;
269
270    # Prepare to write status:
271    open(ZEPHYR, '|/usr/bin//zwrite -d -n -c '.$zephyr_class.' -i '.$queue.'\@'.$host.' -s "Gutenbach Music Spooler"');
272   
273    # fork for mpg123
274    my $pid = open(MP3STATUS, "-|");
275    unless (defined $pid) {
276        print ZEPHYR "Couldn't fork: $!\n";
277        close(ZEPHYR);
278        return;
279    }
280   
281    if ($pid) { #parent
282        # Check if there were any errors
283        if ($_ = <MP3STATUS>) {
284            print ZEPHYR "Playback completed with the following errors:\n";
285            print ZEPHYR $_;
286            while (<MP3STATUS>) {
287                print ZEPHYR $_;
288            }
289        } else {
290            print ZEPHYR "Playback completed successfully.\n";
291        }
292        close(MP3STATUS) || print ZEPHYR "mplayer exited $?\n";
293       
294        close(ZEPHYR);
295        open(STATUS, '>', '/var/run/gutenbach/status');
296        close(STATUS);
297    }
298  else { # child
299      # redirect STDERR to STDOUT
300      open STDERR, '>&STDOUT';
301      # make sure that mplayer doesn't try to intepret the file as keyboard input
302      close(STDIN);
303      open(STDIN, "/dev/null");
304      #print STDERR Dumper([qw|/usr/bin/mplayer -nolirc -ao alsa -quiet|, $filepath]);
305      my @args = (qw|/usr/bin/mplayer -vo fbdev2 -zoom -x 1024 -y 768 -framedrop -nolirc -ao alsa -cache 512 -really-quiet |, $filepath);
306      #print STDERR "About to exec: ", Dumper([@args]);
307      exec(@args) ||
308          die "Couldn't exec";
309  }
310}
311
312# ID3 comments often have useless crap because tools like iTunes were
313# written by drooling idiots
314sub filter_comment {
315  my $comment = shift(@_);
316
317  if ($comment =~ /^engiTunes_CDDB/) {
318    return undef;
319  }
320  return $comment;
321}
322
323
Note: See TracBrowser for help on using the repository browser.