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             @{$tags->{VERSION} // []},
 109             @{$tags->{PARTNUMBER} // []},
 110         )
 111     ) . '.mp3';
 112 }
 113
 114 sub plan_flac {
 115     my $workdir = shift;
 116     my $path = shift;
 117     my $tags = shift;
 118
 119     (
 120      tags => {track_tags($tags)},
 121      flac => $path,
 122      filename => filename($tags),
 123      dir => join('/', $workdir, mangle_for_file_name(@{$tags->{ALBUM}})),
 124     )
 125 }
 126
 127 sub plan {
 128     my $workdir = shift;
 129     map { {plan_flac($workdir, @$_)} } @_
 130 }
 131
 132 # if @layout is partially on disk, return the portion that remains to be written
 133 sub check_directory {
 134     my $workdir = shift;
 135     my $workdir_files = shift;
 136     my @layout = @_;
 137
 138     my @remaining;
 139     my $last;
 140     my %workdir_files = map { ($_, 1) } @$workdir_files;
 141     for my $mp3 (@layout) {
 142         my $path = join('/', $mp3->{dir}, $mp3->{filename});
 143         if (exists($workdir_files{$path})) {
 144             delete($workdir_files{$path});
 145             $last = $mp3;
 146         } else {
 147             if (defined($last)) {
 148                 push(@remaining, $last);
 149                 undef($last);
 150             }
 151             push(@remaining, $mp3);
 152         }
 153     }
 154     defined($last) && push(@remaining, $last);
 155     if (%workdir_files > 0) {
 156         die("unexpected files in $workdir: ", join(' ', sort(keys(%workdir_files))))
 157     }
 158
 159     @remaining
 160 }
 161
 162 sub read_args {
 163     my $workdir = '.';          # TODO
 164     my $imagefile;              # TODO
 165     # TODO other flags
 166     $workdir, $imagefile, @_
 167 }
 168
 169 sub find_files {
 170     my $path = shift;
 171     # If we come across stupid file names embedded newlines, check_directory will complain about them.
 172     open(my $fh, '-|', 'find', $path, '!', '-type', 'd') || die("find $path ! -type d: $!");
 173     my @files;
 174     while (<$fh>) {
 175         chomp;
 176         push(@files, $_);
 177     }
 178     if (!close($fh)) {
 179         if ($! == 0) {
 180             die("find $path ! -type d exited $?")
 181         }
 182         die("close(find $path ! -type d): $!")
 183     }
 184     \@files
 185 }
 186
 187 sub main {
 188     my ($workdir, $imagefile, @flac_files) = read_args(@_);
 189
 190     # -no-resume would mean skipping preparing the work directory at all.
 191     # So that's probably not the right name for the flag.
 192     my @layout = check_directory(
 193         $workdir,
 194         find_files($workdir),
 195         plan(
 196             $workdir,
 197             map { ["$_", read_tags_metaflac($_)] } @flac_files,
 198         ));
 199     for my $mp3 (@layout) {
 200         say('mkdir -p ' . $mp3->{dir});
 201         epg::flac::archive::mp3::flac2mp3(join('/', $mp3->{dir}, $mp3->{filename}), $mp3->{flac}, $mp3->{tags});
 202     }
 203
 204     my @output;
 205     if (defined($imagefile)) {
 206         # Have to redirect it; won't accept -o with -reproducible-date!
 207         #'-o', quote($imagefile)
 208         @output = ('>', quote($imagefile));
 209     } else {
 210         # "Print estimated filesystem size in multiples of the sector size (2048 bytes)"
 211         # Overhead seems to be under 1MB so shoot for total of 649 MB of files.
 212         @output = ('-print-size');
 213     }
 214     # If I cared for fully reproducible image, set all file and directory timestamps:
 215     #  touch -d `git log -1 '--format=%cd' '--date=format:%FT%T'`
 216     say(join(' ',
 217              'mkisofs',
 218              @output,
 219              #'-reproducible-date', `date '+%Y-%m-%d %H:%M:%S %z'`,
 220              #'-reproducible-date', `git log -1 '--format=%ai'`,
 221              #'-reproducible-date', quote('2022-03-11 23:37:11 -0600'),
 222              '-J',
 223              '-full-iso9660-filenames',
 224              '-r',
 225              '-udf',
 226              quote($workdir),
 227         ));
 228
 229     0
 230 }
 231
 232 if (!caller) {
 233     exit(main(@ARGV))
 234 }
 235
 236 1;