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

   1 #!/usr/local/bin/perl
   2
   3 =head1 NAME
   4
   5 B<fa-mp3cd> - Make Universal Disk Format image of MP3 files from FLAC files
   6
   7 =head1 SYNOPSIS
   8
   9 B<fa-mp3cd> [B<-d> I<work-directory>] [B<-o> I<image-file>] [B<-V> I<VOLI>] I<file> [...]
  10
  11 =head1 DESCRIPTION
  12
  13 Each I<file> argument is a single-track[1] FLAC file to be transcoded to MP3
  14 and stored in the UDF image.  By default, place MP3 files in directories named
  15 after the album title.  Change with B<-dirname> options tracks after the
  16 B<-dirname> go into that dirname.  Restore default with B<-diralbum>.[2]
  17
  18 B<fa-mp3cd> starts by validating all input files and planning the layout, then
  19 looking into I<work-directory> for any files not in the plan, exiting with an
  20 error if any are found.  If files exist that are in the plan, assume this is a
  21 rerun after crash and resume starting at the last file written.  E.g. if
  22 writing 100 files and crash after finishing file 98 but before starting file
  23 99, go ahead and rewrite file 98.
  24
  25 =head2 Notes
  26
  27 =over
  28
  29 =item 1.
  30 Still considering restoring whole-disc FLAC file support.
  31
  32 =item 2.
  33 Not yet implemented.
  34
  35 =back
  36
  37 =head1 OPTIONS
  38
  39 =over
  40
  41 =item B<-d> I<work-directory>
  42
  43 Path of the directory to write the UDF layout into.  Default is the
  44 current directory.
  45
  46 =item B<-o> I<image-file>
  47
  48 Path of file to write UDF image to.  No default: if not specified, B<fa-mp3cd>
  49 prepares the I<work-directory> but makes no image.
  50
  51 =item B<-V> I<VOLI>
  52
  53 Passed through to B<mkisofs(1)>, which says:
  54
  55 =item B<--no-resume>
  56
  57 Assume files in I<work-directory> are up to date rather than assuming resume
  58 after crash.
  59
  60 =item B<--print-size>
  61
  62 Run B<mkisofs(1)> to print out the estimated size (in kilobytes) of the image
  63 as well as how much remains of the 650 MB allowed on CD-ROM.
  64
  65 =over
  66
  67 Specifies the volume ID (volume name or label) to be written into the master
  68 block.  There is space on the disc for 32 characters of information.
  69
  70 =back
  71
  72 Some systems may use this volume ID as the name of a mount point.
  73
  74 =back
  75
  76 =head1 AUTHORS
  77
  78 Written by Eric Gillespie <epg@pretzelnet.org>.
  79
  80 =cut
  81
  82 package epg::flac::archive::mp3::cd;
  83
  84 use v5.12;
  85 use warnings;
  86 use FindBin;
  87
  88 use lib $FindBin::Bin;
  89
  90 require 'flac2mp3';
  91 require 'tags.pl';
  92 epg::flac::archive::tags->import(
  93     qw[
  94         track_tags
  95         read_tags_metaflac
  96         mangle_for_file_name
  97         quote
  98         two_digits
  99     ]);
 100
 101 sub filename {
 102     my $tags = shift;
 103     mangle_for_file_name(
 104         join(' ',
 105             (map { two_digits($_) } @{$tags->{DISCNUMBER} // []}),
 106             (map { two_digits($_) } @{$tags->{TRACKNUMBER} // []}),
 107             @{$tags->{TITLE}},
 108         )
 109     ) . '.mp3';
 110 }
 111
 112 sub plan_flac {
 113     local $@;
 114     my $workdir = shift;
 115     my $path = shift;
 116     my $tags = shift;
 117     my %track_tags = eval { track_tags($tags) };
 118     if ($@) {
 119         die("$@: $path")
 120     }
 121     (
 122      tags => \%track_tags,
 123      flac => $path,
 124      filename => filename($tags),
 125      dir => join('/', $workdir, mangle_for_file_name(@{$tags->{ALBUM}})),
 126     )
 127 }
 128
 129 sub plan {
 130     my $workdir = shift;
 131     map { {plan_flac($workdir, @$_)} } @_
 132 }
 133
 134 # if @layout is partially on disk, return the portion that remains to be written
 135 sub check_directory {
 136     my $workdir = shift;
 137     my $workdir_files = shift;
 138     my @layout = @_;
 139
 140     my @remaining;
 141     my $last;
 142     my %workdir_files = map { ($_, 1) } @$workdir_files;
 143     for my $mp3 (@layout) {
 144         my $path = join('/', $mp3->{dir}, $mp3->{filename});
 145         if (exists($workdir_files{$path})) {
 146             delete($workdir_files{$path});
 147             $last = $mp3;
 148         } else {
 149             if (defined($last)) {
 150                 push(@remaining, $last);
 151                 undef($last);
 152             }
 153             push(@remaining, $mp3);
 154         }
 155     }
 156     defined($last) && push(@remaining, $last);
 157     if (%workdir_files > 0) {
 158         die("unexpected files in $workdir: ", join(' ', sort(keys(%workdir_files))))
 159     }
 160
 161     @remaining
 162 }
 163
 164 sub read_args {
 165     my $workdir = '.';          # TODO
 166     my $imagefile;              # TODO
 167     # TODO other flags
 168     $workdir, $imagefile, @_
 169 }
 170
 171 sub find_files {
 172     my $path = shift;
 173     # If we come across stupid file names embedded newlines, check_directory will complain about them.
 174     open(my $fh, '-|', 'find', $path, '!', '-type', 'd') || die("find $path ! -type d: $!");
 175     my @files;
 176     while (<$fh>) {
 177         chomp;
 178         push(@files, $_);
 179     }
 180     if (!close($fh)) {
 181         if ($! == 0) {
 182             die("find $path ! -type d exited $?")
 183         }
 184         die("close(find $path ! -type d): $!")
 185     }
 186     \@files
 187 }
 188
 189 sub main {
 190     my ($workdir, $imagefile, @flac_files) = read_args(@_);
 191
 192     # -no-resume would mean skipping preparing the work directory at all.
 193     # So that's probably not the right name for the flag.
 194     my @layout = check_directory(
 195         $workdir,
 196         find_files($workdir),
 197         plan(
 198             $workdir,
 199             map { ["$_", read_tags_metaflac($_)] } @flac_files,
 200         ));
 201     for my $mp3 (@layout) {
 202         say('mkdir -p ' . $mp3->{dir});
 203         epg::flac::archive::mp3::flac2mp3(join('/', $mp3->{dir}, $mp3->{filename}), $mp3->{flac}, $mp3->{tags});
 204     }
 205
 206     my @output;
 207     if (defined($imagefile)) {
 208         # Have to redirect it; won't accept -o with -reproducible-date!
 209         #'-o', quote($imagefile)
 210         @output = ('>', quote($imagefile));
 211     } else {
 212         # "Print estimated filesystem size in multiples of the sector size (2048 bytes)"
 213         # Overhead seems to be under 1MB so shoot for total of 649 MB of files.
 214         @output = ('-print-size');
 215     }
 216     # If I cared for fully reproducible image, set all file and directory timestamps:
 217     #  touch -d `git log -1 '--format=%cd' '--date=format:%FT%T'`
 218     say(join(' ',
 219              'mkisofs',
 220              @output,
 221              #'-reproducible-date', `date '+%Y-%m-%d %H:%M:%S %z'`,
 222              #'-reproducible-date', `git log -1 '--format=%ai'`,
 223              #'-reproducible-date', quote('2022-03-11 23:37:11 -0600'),
 224              '-J',
 225              '-full-iso9660-filenames',
 226              '-r',
 227              '-udf',
 228              quote($workdir),
 229         ));
 230
 231     0
 232 }
 233
 234 if (!caller) {
 235     exit(main(@ARGV))
 236 }
 237
 238 1;