diplodocus.org Git - flac-archive/blob - fa-flacd

   1 #! /usr/bin/env perl
   2
   3 # $Id$
   4 # $URL$
   5
   6 =head1 NAME
   7
   8 B<fa-flacd> - archive CDs to single FLAC files
   9
  10 =head1 SYNOPSIS
  11
  12 B<fa-flacd> [B<-j> I<jobs>] [B<-v>]
  13
  14 =cut
  15
  16 package Jobs;
  17
  18 use strict;
  19 use warnings;
  20
  21 use Errno;
  22 use POSIX ':sys_wait_h';
  23
  24 sub newjob {
  25     my $f = shift;
  26     my $jobs = shift;
  27     my $debug = shift;
  28     my $pid;
  29
  30     if (not $debug) {
  31         $pid = fork();
  32         if (not defined($pid)) {
  33             die("fork: $!");
  34         }
  35     }
  36
  37     if ($debug or $pid == 0) {
  38         exit($f->());
  39     }
  40
  41     if ($pid == 0) {
  42         exit($f->());
  43     }
  44
  45     push(@$jobs, $pid);
  46
  47     return $pid;
  48 }
  49
  50 sub deljob {
  51     my $pid = shift;
  52     my $status = shift;
  53     my $jobs = shift;
  54
  55     for (my $i = 0; $i <= $#$jobs; $i++) {
  56         if ($pid == $jobs->[$i]) {
  57             splice(@$jobs, $i, 1);
  58             last;
  59         }
  60     }
  61
  62     return ($pid, $status);
  63 }
  64
  65 sub run {
  66     my %o = @_;
  67     my $maxjobs = $o{'max-jobs'};
  68     my $get_job = $o{'get-job'};
  69     my $notify_start = $o{'notify-start'};
  70     my $notify_finish = $o{'notify-finish'};
  71     my @jobs;
  72     my $pid;
  73
  74     # Call notifier function if given.
  75     sub call {
  76         my $f = shift or return;
  77         ref($f) eq 'CODE' or return;
  78         $f->(@_);
  79     }
  80
  81     while (1) {
  82         if (@jobs <= $maxjobs) {
  83             my $job;
  84             while (defined($job = $get_job->())) {
  85                 $pid = newjob($job, \@jobs, $o{'debug'});
  86                 call($notify_start, $pid, @jobs);
  87                 @jobs < $maxjobs or last;
  88             }
  89
  90             # No jobs running and get-job returned undef; we're finished.
  91             if (@jobs == 0 and not defined($job)) {
  92                 return;
  93             }
  94         }
  95
  96         # Now running as many jobs as we can, block waiting for one to die.
  97         do {
  98             $pid = waitpid(-1, 0);
  99         } while ($pid == 0
 100                  or ($pid == -1 and ($!{ECHILD} or $!{EINTR})));
 101         $pid == -1 and die("waitpid(-1): $!");
 102
 103         # Before starting more, see if any others have finished.
 104         do {
 105             call($notify_finish, deljob($pid, $?, \@jobs), @jobs);
 106         } while (($pid = waitpid(-1, WNOHANG)) > 0);
 107         if ($pid == -1) {
 108             $!{ECHILD} or $!{EINTR} or die("waitpid(-1): $!");
 109         }
 110     }
 111 }
 112
 113 \f
 114 ################################################################################
 115 package main;
 116
 117 use strict;
 118 use warnings;
 119
 120 use File::Basename;
 121 use Getopt::Long qw(:config gnu_getopt no_ignore_case);
 122 use POSIX ':sys_wait_h';
 123 use Pod::Usage;
 124
 125 my $debug;
 126 my $verbose;
 127
 128 sub verbose {
 129     $verbose and print(STDERR $_) for @_;
 130 }
 131
 132 # Return the ARTIST, ALBUM, and DATE followed by a list of all the
 133 # lines in the file FN.
 134 sub get_tags {
 135     my $fn = shift;
 136     my $tag;
 137     my $value;
 138     my $artist;
 139     my $album;
 140     my $discnum;
 141     my @tags;
 142
 143     verbose("Opening tags file $fn\n");
 144     open(TAGS, $fn) or die("open($fn): $!");
 145     while (<TAGS>) {
 146         chomp;
 147         push(@tags, $_);
 148
 149         ($tag, $value) = split(/=/, $_, 2);
 150
 151         if (/^ARTIST=/i) {
 152             $artist = $value;
 153             verbose("ARTIST $artist from $fn\n");
 154         } elsif (/^ALBUM=/i) {
 155             $album = $value;
 156             verbose("ALBUM $album from $fn\n"); # cperl-mode sucks "
 157         } elsif (/^DISCNUMBER=/i) {
 158             $discnum = int($value);
 159             verbose("DISCNUMBER $discnum from $fn\n");
 160         }
 161     }
 162     close(TAGS) or die("close($fn): $!");
 163
 164     return ($artist, $album, $discnum, @tags);
 165 }
 166
 167 sub track_tags {
 168     my $h = shift;
 169     my @result;
 170
 171     while (my ($key, $vall) = each(%$h)) {
 172         for my $val (@$vall) {
 173             push(@result, "$key=$val")
 174         }
 175     }
 176
 177     return @result;
 178 }
 179
 180 sub run_flac {
 181     my $infile = shift;
 182     my $cue = shift;
 183     my $outfile = shift;
 184
 185     my @cue;
 186     if (defined($cue)) {
 187         @cue = ('--cuesheet', $cue);
 188     }
 189
 190     verbose("Running flac\n");
 191     my $status = system('flac', '-o', "$outfile.flac-tmp",
 192                      '--delete-input-file', '-V', '--no-padding', '--best',
 193                      @cue,
 194                      map({ ('-T', $_) } @_),
 195                      $infile);
 196     if (WIFEXITED($status)) {
 197         if (($status = WEXITSTATUS($status)) != 0) {
 198             die("flac exited with status $status");
 199         }
 200     } elsif (WIFSIGNALED($status)) {
 201         die("flac killed with signal ", WTERMSIG($status));
 202     } elsif (WIFSTOPPED($status)) {
 203         die("flac stopped with signal ", WSTOPSIG($status));
 204     } else {
 205         die("Major horkage on system(flac): \$? = $? \$! = $!");
 206     }
 207
 208     rename("$outfile.flac-tmp", "$outfile.flac")
 209       or die("rename($outfile.flac-tmp, $outfile.flac): $!");
 210 }
 211
 212 # Process the fa-rip output in the directory DIR.
 213 sub flac {
 214     my $dir = shift;
 215     my $artist;
 216     my $album;
 217     my $discnum;
 218     my @tags;
 219     my $single_file = -e "$dir/wav";
 220     my $outdir;
 221     my $outfile;
 222     my $outlog;
 223     my @files;
 224
 225     verbose("Renaming $dir/tags\n");
 226     rename("$dir/tags", "$dir/using-tags")
 227       or die("rename($dir/tags, $dir/using-tags): $!");
 228
 229     ($artist, $album, $discnum, @tags) = get_tags("$dir/using-tags");
 230     for ($artist, $album) {
 231         s|/|_|g;
 232     }
 233
 234     verbose("mkdir($artist)\n");
 235     -d $artist or mkdir($artist) or die("mkdir($artist): $!");
 236
 237     if (not $single_file) {
 238         $outdir = "$artist/$album";
 239         verbose("mkdir($outdir)\n");
 240         -d "$outdir" or mkdir("$outdir") or die("mkdir($outdir): $!");
 241     }
 242
 243     verbose("chdir($dir)\n");
 244     chdir($dir) or die("chdir($dir): $!");
 245
 246     if ($single_file) {
 247         $outfile = $album;
 248         defined($discnum) and $outfile .= " (disc $discnum)";
 249         run_flac('wav', 'cue', "../$artist/$outfile", @tags);
 250         $outlog = "../$artist/$outfile.log";
 251         @files = ("$artist/$outfile.flac");
 252     } else {
 253         # Go over @tags, store all [n] tags in a list keyed by n in
 254         # %tracks_to_tags, store all ARTIST (not ARTIST[n]) tags in
 255         # @disc_artist, and leave the rest in @tags.
 256         my %tracks_to_tags;
 257         my @disc_artist;
 258         my @tmp;
 259         for my $tag (@tags) {
 260             if ($tag =~ /^([^[]+)\[(\d+)]=(.*)/) {
 261                 push(@{$tracks_to_tags{$2}->{$1}}, $3);
 262             } elsif ($tag =~ /^ARTIST=/) {
 263                 push(@disc_artist, $tag);
 264             } else {
 265                 push(@tmp, $tag);
 266             }
 267         }
 268         @tags = @tmp;
 269
 270         for my $tracknum (sort(map(int, keys(%tracks_to_tags)))) {
 271             my $title = join(' ', map(split, @{$tracks_to_tags{$tracknum}->{'TITLE'}}));
 272             $title =~ s|/|_|g;
 273             $outfile = join('/',
 274                             $outdir,
 275                             join(' ',
 276                                  (defined($discnum)
 277                                   ? sprintf('%02d', $discnum)
 278                                   : ()),
 279                                  sprintf('%02d', $tracknum),
 280                                  $title));
 281
 282             # If we have ARTIST[n] tags for this track, set
 283             # @track_artist to the empty list; they will go in along
 284             # with the other [n] tags.
 285             my @track_artist;
 286             if (exists($tracks_to_tags{$tracknum}->{'ARTIST'})) {
 287                 @track_artist = ();
 288             } else {
 289                 @track_artist = @disc_artist;
 290             }
 291
 292             run_flac(sprintf('track%02d.cdda.wav', $tracknum), undef,
 293                      "../$outfile",
 294                      @track_artist,
 295                      @tags,
 296                      "TRACKNUMBER=$tracknum",
 297                      track_tags($tracks_to_tags{$tracknum}));
 298             push(@files, "$outfile.flac");
 299         }
 300         $outlog = "../$outdir/log";
 301     }
 302
 303     verbose("Cleaning up $dir\n");
 304     unlink('using-tags') or die("unlink(using-tags): $!");
 305     unlink('cue') or die("unlink(cue): $!");
 306     rename('log', $outlog)
 307       or die("rename(log, $outlog): $!");
 308     chdir('..') or die("chdir(..): $!");
 309
 310     if (-x "$dir/post-processor") {
 311         verbose(join(' ', "Running ./$dir/post-processor", @files), "\n");
 312         system("./$dir/post-processor", @files);
 313         unlink("$dir/post-processor") or die("unlink($dir/post-processor): $!");
 314     }
 315
 316     rmdir($dir) or die("rmdir($dir): $!");
 317
 318     return 0;
 319 }
 320
 321 sub flacloop {
 322     my $MAXJOBS = shift;
 323     my @jobs;
 324     my $dir;
 325
 326     while (1) {
 327         if (scalar(@jobs = glob('*/tags')) == 0) {
 328             sleep(5);
 329             next;
 330         }
 331
 332         Jobs::run('max-jobs'=>$MAXJOBS,
 333                   'debug'=>$debug,
 334                   'get-job'=>sub {
 335                       my $bork = shift(@jobs) or return;
 336                       $dir = dirname($bork);
 337                       return sub {
 338                           open(STDERR, ">$dir/log")
 339                             or die("open(STDERR, >$dir/log): $!");
 340                           return flac($dir);
 341                       }
 342                   },
 343
 344                   'notify-start'=>sub {
 345                       my $pid = shift;
 346                       verbose("new job $pid for $dir\n");
 347                       verbose(scalar(@_), " jobs\n");
 348                   },
 349
 350                   'notify-finish'=>sub {
 351                       my $pid = shift;
 352                       my $status = shift;
 353                       verbose("$pid finished (");
 354                       if (WIFEXITED($status)) {
 355                           verbose('exited with status ', WEXITSTATUS($status));
 356                       } elsif (WIFSIGNALED($status)) {
 357                           verbose('killed with signal ', WTERMSIG($status));
 358                       } elsif (WIFSTOPPED($status)) {
 359                           verbose('stopped with signal ', WSTOPSIG($status));
 360                       }
 361                       verbose(")\n");
 362                   });
 363     }
 364 }
 365
 366 MAIN: {
 367     my $jobs;
 368     my $help;
 369
 370     $jobs = 4;
 371     GetOptions(
 372                'debug|X' => \$debug,
 373                'jobs|j=i' => \$jobs,
 374                'verbose|v' => \$verbose,
 375                'help|h|?' => \$help,
 376               ) or pod2usage();
 377     $help and pod2usage(-exitstatus=>0, -verbose=>1);
 378
 379     flacloop($jobs);
 380 }
 381
 382 \f
 383 __END__
 384
 385 =head1 DESCRIPTION
 386
 387 B<fa-flacd> and B<fa-rip> together comprise B<flac-archive>, a system
 388 for archiving audio CDs to single FLAC files.  B<fa-flacd> is the guts
 389 of the system.  It runs in the directory where the audio archives are
 390 stored, scanning for new ripped CDs to encode and rename; it never
 391 exits.  B<fa-rip> generates the inputs for B<fa-flacd>: the ripped WAV
 392 file, Vorbis tags, and a cuesheet.
 393
 394 Both programs expect to be run from the same directory.  They use that
 395 directory to manage directories named by artist.  Intermediate files
 396 are written to temporary directories here.  B<fa-flacd> processes the
 397 temporary directories into per-album files in the artist directories.
 398
 399 Every 5 seconds, B<fa-flacd> scans its current directory for
 400 directories with a file called "tags" and creates a processing job for
 401 each one.  The number of jobs B<fa-flacd> attempts to run is
 402 controlled by the B<-j> option and defaults to 4.  B<fa-flacd> will
 403 print diagnostic output when the B<-v> option is given.
 404
 405 A processing job first renames the directory's "tags" file to
 406 "using-tags" so that B<ra-flacd> will not try to start another job for
 407 this directory.  This file is left as is when an error is encountered,
 408 so a new job will not be started until the user corrects the error
 409 condition and renames "using-tags" back to "tags".  Next, it encodes
 410 the "wav" file to a FLAC file, using the "cue" file for the cuesheet
 411 and "using-tags" for Vorbis tags.  Any diagnostic output is saved in
 412 the "log" file.  Finally, B<fa-flacd> moves the "cue" and "log" files
 413 to the artist directory (named by album) and removes the temporary
 414 directory.
 415
 416 If the temporary directory contains an executable file named
 417 "post-processor", B<fa-flacd> executes that file with the relative
 418 path to the output FLAC file as an argument.  The output files are in
 419 their final location when "post-processor" starts.  Possible uses are
 420 running B<flac2mp3>, moving the output files to a different location,
 421 removing the lock file, or adding to a database.  The standard input,
 422 output, and error streams are inherited from B<fa-flacd>, so they may
 423 be connected to anything from a tty to /dev/null.  This means that you
 424 may want to redirect these streams, if you want to save them or do any
 425 logging.
 426
 427 =head1 OPTIONS
 428
 429 =over 4
 430
 431 =item B<-j> [B<--jobs>] I<jobs>
 432
 433 Run up to I<jobs> jobs instead of the default 4.
 434
 435 =item B<-v> [B<--verbose>]
 436
 437 Print diagnostic information.
 438
 439 =back
 440
 441 =head1 AUTHORS
 442
 443 Written by Eric Gillespie <epg@pretzelnet.org>.
 444
 445 flac-archive is free software; you may redistribute it and/or modify
 446 it under the same terms as Perl itself.
 447
 448 =cut
 449
 450 # Local variables:
 451 # cperl-indent-level: 4
 452 # perl-indent-level: 4
 453 # indent-tabs-mode: nil
 454 # End:
 455
 456 # vi: set tabstop=4 expandtab: