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

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

Changed /usr/athena/bin/perl to /usr/bin/perl in
gutenbach-filter and gutenbach-get-config

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