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 # Encode a single wav file to a single flac file, whether the wav and
 213 # flac files represent individual tracks or whole discs.
 214 sub flac {
 215     my $dir = shift;
 216     my $artist = shift;
 217     my $album = shift;
 218     my $discnum = shift;
 219     my $tracknum = shift;
 220     my $track_tags = shift;
 221     my $disc_artist = shift;
 222     my $single_file = not defined($tracknum);
 223     my @tags = @_;
 224     my $outdir;
 225     my $outfile;
 226     my $outlog;
 227     my @files;
 228
 229     for ($artist, $album) {
 230         s|/|_|g;
 231     }
 232
 233     verbose("mkdir($artist)\n");
 234     mkdir($artist) or $!{EEXIST} or die("mkdir($artist): $!");
 235
 236     if (not $single_file) {
 237         $outdir = "$artist/$album";
 238         verbose("mkdir($outdir)\n");
 239         mkdir("$outdir") or $!{EEXIST} or die("mkdir($outdir): $!");
 240     }
 241
 242     verbose("chdir($dir)\n");
 243     chdir($dir) or die("chdir($dir): $!");
 244
 245     if ($single_file) {
 246         $outfile = $album;
 247         defined($discnum) and $outfile .= " (disc $discnum)";
 248         run_flac('wav', 'cue', "../$artist/$outfile", @tags);
 249         $outlog = "../$artist/$outfile.log";
 250         @files = ("$artist/$outfile.flac");
 251
 252         unlink('cue') or die("unlink(cue): $!");
 253         rename('log', $outlog)
 254           or die("rename(log, $outlog): $!");
 255     } else {
 256         my $title = join(' ', map(split, @{$track_tags->{'TITLE'}}));
 257         $title =~ s|/|_|g;
 258         $outfile = join('/',
 259                         $outdir,
 260                         join(' ',
 261                              (defined($discnum)
 262                               ? sprintf('%02d', $discnum)
 263                               : ()),
 264                              sprintf('%02d', $tracknum),
 265                              $title));
 266
 267         # If we have ARTIST[n] tags for this track, set @track_artist
 268         # to the empty list; they will go in along with the other [n]
 269         # tags.
 270         my @track_artist;
 271         if (exists($track_tags->{'ARTIST'})) {
 272             @track_artist = ();
 273         } else {
 274             @track_artist = @$disc_artist;
 275         }
 276
 277         run_flac(sprintf('track%02d.cdda.wav', $tracknum), undef,
 278                  "../$outfile",
 279                  @track_artist,
 280                  @tags,
 281                  "TRACKNUMBER=$tracknum",
 282                  track_tags($track_tags));
 283         $outlog = "../$outfile.log";
 284         push(@files, "$outfile.flac");
 285
 286         rename("$tracknum.log", $outlog)
 287           or die("rename($tracknum.log, $outlog): $!");
 288     }
 289
 290     chdir('..') or die("chdir(..): $!");
 291
 292     if (-x "$dir/post-processor") {
 293         verbose(join(' ', "Running ./$dir/post-processor", @files), "\n");
 294         system("./$dir/post-processor", @files);
 295         unlink("$dir/post-processor") or die("unlink($dir/post-processor): $!");
 296     }
 297
 298     # Clean up if we're the last job for $dir; for multi-file dirs,
 299     # it's possible for more than one job to run cleanup at once, so
 300     # don't fail if things are already clean.
 301 #     if (nothing but using-tags in $dir) {
 302 #         unlink("$dir/using-tags") or $!{ENOENT} or die("unlink($dir/using-tags): $!");
 303 #         rmdir($dir) or or $!{ENOENT} die("rmdir($dir): $!");
 304 #     }
 305
 306     return 0;
 307 }
 308
 309 sub flacloop {
 310     my $MAXJOBS = shift;
 311     my $dir;
 312     my @jobs;
 313
 314     # Get a job for Jobs::run.  On each call, look for new fa-rip
 315     # directories and append an item to the queue @jobs for each wav
 316     # file therein.  Then, if we have anything in the queue, return a
 317     # function to call flac for it, otherwise sleep for a bit.  This
 318     # looks forever, never returning undef, so Jobs::run never returns.
 319     my $getjob = sub {
 320         # Look for new fa-rip directories.
 321         while (1) {
 322             for my $i (glob('*/tags')) {
 323                 $dir = dirname($i);
 324
 325                 verbose("Renaming $dir/tags\n");
 326                 rename("$dir/tags", "$dir/using-tags")
 327                   or die("rename($dir/tags, $dir/using-tags): $!");
 328
 329                 my ($artist, $album,
 330                     $discnum, @tags) = get_tags("$dir/using-tags");
 331                 if (-e "$dir/wav") {
 332                     # single-file
 333                     push(@jobs,
 334                          [$dir, $artist, $album, $discnum,
 335                           undef, undef, undef, @tags]);
 336                 } else {
 337                     #multi-file
 338                     # Don't need cue file.
 339                     unlink("$dir/cue") or die("unlink($dir/cue): $!");
 340
 341                     # Go over @tags, store all [n] tags in a list keyed by
 342                     # n in %tracks_to_tags, store all ARTIST (not
 343                     # ARTIST[n]) tags in @disc_artist, and leave the rest
 344                     # in @tags.
 345                     my %tracks_to_tags;
 346                     my @disc_artist;
 347                     my @tmp;
 348                     for my $tag (@tags) {
 349                         if ($tag =~ /^([^[]+)\[(\d+)]=(.*)/) {
 350                             push(@{$tracks_to_tags{$2}->{$1}}, $3);
 351                         } elsif ($tag =~ /^ARTIST=/) {
 352                             push(@disc_artist, $tag);
 353                         } else {
 354                             push(@tmp, $tag);
 355                         }
 356                     }
 357                     @tags = @tmp;
 358
 359                     push(@jobs,
 360                          map {
 361                              [$dir, $artist, $album, $discnum, $_,
 362                               $tracks_to_tags{$_}, \@disc_artist, @tags]
 363                          } sort(map(int, keys(%tracks_to_tags))));
 364                 }
 365             }
 366
 367             # Return a job if we found any work.
 368             if (my $job = shift(@jobs)) {
 369                 return sub {
 370                     my $log = defined($job->[4]) ? $job->[4] . '.log' : 'log';
 371                     $dir = $job->[0];
 372                     open(STDERR, ">$dir/$log") or die("open(STDERR, >$dir/$log): $!");
 373                     return flac(@$job);
 374                 }
 375             }
 376
 377             # Didn't find anything; wait a while and check again.
 378             sleep(5);
 379         }
 380     };
 381
 382     # Never returns (see $getjob comment).
 383     Jobs::run('max-jobs'=>$MAXJOBS,
 384               'debug'=>$debug,
 385               'get-job'=>$getjob,
 386
 387               'notify-start'=>sub {
 388                   my $pid = shift;
 389                   verbose("new job $pid for $dir\n");
 390                   verbose(scalar(@_), " jobs\n");
 391               },
 392
 393               'notify-finish'=>sub {
 394                   my $pid = shift;
 395                   my $status = shift;
 396                   verbose("$pid finished (");
 397                   if (WIFEXITED($status)) {
 398                       verbose('exited with status ', WEXITSTATUS($status));
 399                   } elsif (WIFSIGNALED($status)) {
 400                       verbose('killed with signal ', WTERMSIG($status));
 401                   } elsif (WIFSTOPPED($status)) {
 402                       verbose('stopped with signal ', WSTOPSIG($status));
 403                   }
 404                   verbose(")\n");
 405               });
 406 }
 407
 408 MAIN: {
 409     my $jobs;
 410     my $help;
 411
 412     $jobs = 4;
 413     GetOptions(
 414                'debug|X' => \$debug,
 415                'jobs|j=i' => \$jobs,
 416                'verbose|v' => \$verbose,
 417                'help|h|?' => \$help,
 418               ) or pod2usage();
 419     $help and pod2usage(-exitstatus=>0, -verbose=>1);
 420
 421     flacloop($jobs);
 422 }
 423
 424 \f
 425 __END__
 426
 427 =head1 DESCRIPTION
 428
 429 B<fa-flacd> and B<fa-rip> together comprise B<flac-archive>, a system
 430 for archiving audio CDs to single FLAC files.  B<fa-flacd> is the guts
 431 of the system.  It runs in the directory where the audio archives are
 432 stored, scanning for new ripped CDs to encode and rename; it never
 433 exits.  B<fa-rip> generates the inputs for B<fa-flacd>: the ripped WAV
 434 file, Vorbis tags, and a cuesheet.
 435
 436 Both programs expect to be run from the same directory.  They use that
 437 directory to manage directories named by artist.  Intermediate files
 438 are written to temporary directories here.  B<fa-flacd> processes the
 439 temporary directories into per-album files in the artist directories.
 440
 441 Every 5 seconds, B<fa-flacd> scans its current directory for
 442 directories with a file called "tags" and creates a processing job for
 443 each one.  The number of jobs B<fa-flacd> attempts to run is
 444 controlled by the B<-j> option and defaults to 4.  B<fa-flacd> will
 445 print diagnostic output when the B<-v> option is given.
 446
 447 A processing job first renames the directory's "tags" file to
 448 "using-tags" so that B<ra-flacd> will not try to start another job for
 449 this directory.  This file is left as is when an error is encountered,
 450 so a new job will not be started until the user corrects the error
 451 condition and renames "using-tags" back to "tags".  Next, it encodes
 452 the "wav" file to a FLAC file, using the "cue" file for the cuesheet
 453 and "using-tags" for Vorbis tags.  Any diagnostic output is saved in
 454 the "log" file.  Finally, B<fa-flacd> moves the "cue" and "log" files
 455 to the artist directory (named by album) and removes the temporary
 456 directory.
 457
 458 If the temporary directory contains an executable file named
 459 "post-processor", B<fa-flacd> executes that file with the relative
 460 path to the output FLAC file as an argument.  The output files are in
 461 their final location when "post-processor" starts.  Possible uses are
 462 running B<flac2mp3>, moving the output files to a different location,
 463 removing the lock file, or adding to a database.  The standard input,
 464 output, and error streams are inherited from B<fa-flacd>, so they may
 465 be connected to anything from a tty to /dev/null.  This means that you
 466 may want to redirect these streams, if you want to save them or do any
 467 logging.
 468
 469 =head1 OPTIONS
 470
 471 =over 4
 472
 473 =item B<-j> [B<--jobs>] I<jobs>
 474
 475 Run up to I<jobs> jobs instead of the default 4.
 476
 477 =item B<-v> [B<--verbose>]
 478
 479 Print diagnostic information.
 480
 481 =back
 482
 483 =head1 AUTHORS
 484
 485 Written by Eric Gillespie <epg@pretzelnet.org>.
 486
 487 flac-archive is free software; you may redistribute it and/or modify
 488 it under the same terms as Perl itself.
 489
 490 =cut
 491
 492 # Local variables:
 493 # cperl-indent-level: 4
 494 # perl-indent-level: 4
 495 # indent-tabs-mode: nil
 496 # End:
 497
 498 # vi: set tabstop=4 expandtab: