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

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

Changed 'sipbmp3' to 'gutenbach' by popular demand. Have not checked for errors, yet.

  • Property mode set to 100755
File size: 8.7 KB
Line 
1#!/usr/athena/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 = "gutenbach";
26my $host = `hostname`;
27my $queue = "gutenbach";
28my $mixer = "PCM";
29my $channel = "Front Left";
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
97# Status messages at start of playback
98open(ZEPHYR, '|/usr/athena/bin/zwrite -d -n -c '. $zephyr_class .' -i ' .
99  $queue.'@'.$host.' -s "Gutenbach Music Spooler"');
100
101# For the Now Playing remctl command
102open(STATUS, '>', '/var/run/gutenbach/status') or die("Can't open status file /var/run/gutenbach/status");
103
104print(ZEPHYR "$opts{'n'}\@$opts{'H'} is playing:\n");
105print(STATUS "User: $opts{'n'}\@$opts{'H'}\n");
106
107# SIGHUP handler
108sub clear_status {
109    # Possible race condition if the previous status is still going
110    open(STA, '>', '/var/run/gutenbach/status');
111    close(STA);
112    open(ZEPH, '|/usr/athena/bin/zwrite -d -n -c '. $zephyr_class .' -i '.
113        $queue.'@'.$host.' -s "Gutenbach Music Spooler"');
114    print(ZEPH "Playback aborted.\n");
115    close(ZEPH);
116    die;
117}
118$SIG{HUP} = \&clear_status;
119
120# So, the file we're currently processing is "-d/-e".
121
122# Read the metadata information from the file.
123my ($filepath) = catfile($opts{'d'}, $opts{'e'});
124my ($fileinfo) = ImageInfo($filepath);
125my ($magic) = $fileinfo->{FileType};
126
127if ($magic) {
128    printf(ZEPHYR "%s file %s\n", $magic, $opts{'J'});
129    printf(STATUS "Filetype: %s\n", $magic);
130    printf(STATUS "Filename: %s\n", $opts{'J'});
131    if (exists $fileinfo->{'Title'}) {
132        printf(ZEPHYR "\@b{%s}\n", $fileinfo->{'Title'}) if exists $fileinfo->{'Title'};
133        printf(STATUS "Title: %s\n", $fileinfo->{'Title'});
134    }
135    foreach my $key (qw/Artist Album AlbumArtist/) {
136        if (exists $fileinfo->{$key}) {
137            printf(ZEPHYR "%s\n", $fileinfo->{$key}) if exists $fileinfo->{$key};
138            printf(STATUS "%s: %s\n", $key, $fileinfo->{$key});
139        }
140    }
141    my $tempdir = tempdir();
142    $opts{'J'} =~ s/_mp3/.mp3/; #awful hack -- geofft
143    my $newpath = $tempdir . '/' . basename($opts{'J'});
144    symlink($filepath, $newpath);
145    $filepath = $newpath;
146}
147elsif ($opts{'C'} eq 'Z') {
148    $filepath = resolve_external_reference($filepath, \%opts);
149    if ($filepath =~ m|http://www\.youtube\.com/watch\?v=|) {
150        $pid = open2($out, $in, qw{youtube-dl -g2}, $filepath);
151        $title = <$out>;
152        print ZEPHYR "YouTube video $filepath\n$title";
153        print STATUS "YouTube video $filepath\n$title";
154        $filepath = <$out>;
155        chomp $filepath;
156        waitpid $pid, 0;
157    } else {
158        print STDERR "Resolved external reference to $filepath\n";
159        printf(ZEPHYR "%s\n", $filepath);
160        printf(STATUS "External: %s\n", $filepath);
161    }
162}
163elsif (-T $filepath) {
164    split_playlist($filepath, \%opts);
165    close(ZEPHYR);
166    close(STATUS);
167    exit 0;
168}
169
170#printf(STDERR "Job priority %s\n", $opts{'C'}) if $opts{'C'} eq 'Z';
171#printf(ZEPHYR "Job priority %s\n", $opts{'C'}) if ($opts{'C'} && ($opts{'C'} ne 'A'));
172close(ZEPHYR);
173close(STATUS);
174play_mplayer_audio($filepath, \%opts);
175
176if ($magic) {
177    unlink($newpath);
178    rmdir($tempdir);
179}
180
181# Play an external stream reference
182sub resolve_external_reference {
183    # Retrieve those command line opts.
184    my ($filepath, $opts) = @_;
185
186    my $format, $uri, $userpass;
187
188    if (<STDIN> =~ /^(\S+)/) {
189        $uri=$1;
190
191        if ($uri =~ m|http://www\.youtube\.com/watch\?v=|) {
192            return $uri;
193        }
194
195        my $response = $ua->head($uri);
196       
197        $contenttype=($response->content_type() or "unknown");
198       
199        if ($contenttype eq "audio/mpeg") { $format="MP3" }
200        elsif ($contenttype eq "application/x-ogg") { $format="OGG" }
201        elsif ($contenttype eq "application/ogg") { $format="OGG" }
202        elsif ($contenttype eq "audio/x-scpls") { $format="SHOUTCAST" }
203        else {
204            print ZEPHYR
205                "Unknown Content-Type $contenttype for URI $uri\n";
206        }
207    } else {
208        print ZEPHYR "Couldn't read URI for external reference\n";
209        return $filepath;
210    }
211
212    if ($format eq "SHOUTCAST") {
213        print ZEPHYR "Shoutcast playlist...\n";
214        #Don't close ZEPHYR yet, will print the name of the stream if available
215        return &get_shoutcast($uri);
216    } elsif ($format eq "MP3") {
217    } elsif ($format eq "OGG") {
218    } else {
219      print ZEPHYR "Unrecognized stream format: $format\n";
220    }
221    return $uri;
222}
223
224sub split_playlist {
225    my ($file, $opts) = @_;
226
227    my $i = 0;
228   
229    while (<STDIN>) {
230        chomp;
231        if (/^([^#]\S+)/) {
232            printf (STDERR "Found line: %s\n", $_);
233            open(LPR, "|-", 'mit-lpr', '-P'.$queue.'@localhost', '-CZ', '-J'.$opts->{J});
234            print LPR $1;
235            close(LPR);
236        $i++;
237        }
238    }
239    printf(ZEPHYR "Playlist containing %d valid entries, split into separate jobs.\n", $i);
240}
241
242# Process a Shoutcast playlist
243# get_shoutcast(URI)
244sub get_shoutcast {
245  my $uri = shift(@_);
246 
247  my $response = $ua->get($uri);
248
249  foreach (split("\n", $response->content())) {
250      if (/^File\d+=(\S+)/) {
251          push(@uris, $1);
252      }
253      if (/^Title\d+=(.+)$/) {
254          push(@titles, $1);
255      }
256  }
257 
258  # choose a random server
259  $server = int(rand scalar(@uris));
260  # print the name of the stream if available
261  print ZEPHYR "$titles[$server]\n";
262  return $uris[$server];
263}
264
265sub play_mplayer_audio {
266    my ($filepath, $opts) = @_;
267
268    # Prepare to write status:
269    open(ZEPHYR, '|/usr/athena/bin/zwrite -d -n -c '.$zephyr_class.' -i ' .
270         $queue.'@'.$host.' -s "Gutenbach Music Spooler"');
271   
272    # fork for mpg123
273    my $pid = open(MP3STATUS, "-|");
274    unless (defined $pid) {
275        print ZEPHYR "Couldn't fork: $!\n";
276        close(ZEPHYR);
277        return;
278    }
279   
280    if ($pid) { #parent
281        # Check if there were any errors
282        if ($_ = <MP3STATUS>) {
283            print ZEPHYR "Playback completed with the following errors:\n";
284            print ZEPHYR $_;
285            while (<MP3STATUS>) {
286                print ZEPHYR $_;
287            }
288        } else {
289            print ZEPHYR "Playback completed successfully.\n";
290        }
291        close(MP3STATUS) || print ZEPHYR "mplayer exited $?\n";
292       
293        close(ZEPHYR);
294        open(STATUS, '>', '/var/run/gutenbach/status');
295        close(STATUS);
296    }
297  else { # child
298      # redirect STDERR to STDOUT
299      open STDERR, '>&STDOUT';
300      # make sure that mplayer doesn't try to intepret the file as keyboard input
301      close(STDIN);
302      open(STDIN, "/dev/null");
303      #print STDERR Dumper([qw|/usr/bin/mplayer -nolirc -ao alsa -quiet|, $filepath]);
304      my @args = (qw|/usr/bin/mplayer -novideo -vo null -nolirc -ao alsa -cache 512 -really-quiet |, $filepath);
305      #print STDERR "About to exec: ", Dumper([@args]);
306      exec(@args) ||
307          die "Couldn't exec";
308  }
309}
310
311# ID3 comments often have useless crap because tools like iTunes were
312# written by drooling idiots
313sub filter_comment {
314  my $comment = shift(@_);
315
316  if ($comment =~ /^engiTunes_CDDB/) {
317    return undef;
318  }
319  return $comment;
320}
321
322
Note: See TracBrowser for help on using the repository browser.