conv.pl

   1 #!/usr/bin/perl
   2 use Getopt::Std;
   3 use File::Basename;
   4 use strict;
   5 use warnings;
   6
   7 my %rules;
   8 my %vars;
   9 my %opts = (
  10     j => 1
  11 );
  12
  13 getopts('vnsj:f:o:i:', \%opts);
  14
  15 my $dirout;
  16 if (defined $opts{o}) {
  17     if (-d $opts{o}) {
  18         # output is a directory
  19         $dirout = 1;
  20     } else {
  21         # output is a single file, imply -i <ext> unless -i has also been specified
  22         if ($opts{o} =~ /\.(\w+)$/) {
  23             $opts{i} = $1 unless exists $opts{i};
  24         } else {
  25             print "Specified -o <file>, but '$opts{o}' has no extension.\n";
  26             exit 1;
  27         }
  28     }
  29 }
  30
  31 print "Using $opts{j} processors\n" if $opts{v};
  32
  33 my $var_re = qr/[A-Za-z_][A-Za-z0-9_]*/;
  34
  35 sub convert {
  36     my ($base, $iext, $oext) = @_;
  37     my $cmd = $rules{$oext}{$iext};
  38     my $infile = "$base.$iext";
  39     $infile =~ s/"/\\"/g;
  40     $cmd =~ s!\$\<!"$infile"!g;
  41     $cmd =~ s!\$\*!"$base"!g;
  42     my $outfile;
  43     if ($opts{o}) {
  44         if ($dirout) {
  45             # Strip leading path from base so we can stick the file in
  46             # another dir.
  47             $base = basename($base);
  48             $outfile = "$opts{o}/$base.$oext";
  49         } else {
  50             $outfile = $opts{o};
  51         }
  52     } else {
  53         $outfile = "$base.$oext";
  54     }
  55     $outfile =~ s/"/\\"/g;
  56     $cmd =~ s!\$\@!"$outfile"!g;
  57     $cmd = expand($cmd);
  58     print "$cmd\n";
  59     return if $opts{n};
  60     my $pid = fork();
  61     return $pid if $pid;
  62
  63     exec($cmd);
  64 }
  65
  66 sub expand {
  67     local $_ = shift;
  68     s/\$($var_re)/(exists $vars{$1} ? $vars{$1} : '$' . $1)/eg;
  69     return $_;
  70 }
  71
  72 open CONF, ($opts{f} || 'Convfile') or die "Could not open Convfile";
  73 while (<CONF>) {
  74     s/#.*$//;
  75     s/^\s+//;
  76     s/\s+$//;
  77     next if /^$/;
  78
  79     if (/^([\w.-]+)\s*=>\s*([\w.-]+)\s*:\s*(.*)$/) {
  80         $rules{$2}{$1} = $3;
  81     } elsif (/^($var_re)\s*=\s*(.*)$/) {
  82         $vars{$1} = expand($2);
  83     } else {
  84         warn "Error in Convfile line $.: $_\n";
  85     }
  86 }
  87 close CONF;
  88
  89 my @queue;
  90 my @files;
  91
  92 # If we specify reading from stdin, do this.
  93 if (exists $opts{s}) {
  94     while (<STDIN>) {
  95         next if /^#/;
  96         chomp;
  97
  98         push @files, $_;
  99     }
 100 } else {
 101     @files = @ARGV;
 102 }
 103
 104 # Reversed semantics. Files are input to be converted to the specified extension
 105 if ($opts{i}) {
 106     unless (exists $rules{$opts{i}}) {
 107         print <<EOD;
 108 You have specified -i <ext>, but the Convfile has no rule to convert to
 109 extension '$opts{i}'
 110 EOD
 111         exit 1;
 112     }
 113     foreach (@files) {
 114         unless (-e $_) {
 115             print "$_ does not exist.\n";
 116             next;
 117         }
 118
 119         if (/^(.+)\.(\w+)$/) {
 120             my $base = $1;
 121             my $iext = $2;
 122             print "Considering $base.$iext\n" if $opts{v};
 123             if (exists $rules{$opts{i}}{$iext}) {
 124                 print "Using $base.$iext\n" if $opts{v};
 125                 push @queue, [$base, $iext, $opts{i}];
 126             }
 127         } else {
 128             print "I don't see an extension on $_, so I don't know what to do with it.\n";
 129         }
 130     }
 131 }
 132
 133 # Make semantics, files specified are desired output files
 134 else {
 135     # Do something fun (convert *.foo into a list of files that would match if they existed)
 136     my @tmpfiles;
 137     foreach (@files) {
 138         if (/^\*\.(\w+)$/) {
 139             my $extsub = $1;
 140             push @tmpfiles,
 141             map { s/\.(\w+)$/\.$extsub/; $_ }
 142                 grep { /^[^.]/ }
 143                 <*>;
 144         } else {
 145             push @tmpfiles, $_;
 146         }
 147     }
 148     @files = @tmpfiles;
 149
 150     # I like to call this the TOWER OF POWER
 151     for my $ofile (@files) {
 152         my $ofound = 0;
 153         for my $oext (keys %rules) {
 154             my $oext_re = $oext;
 155             $oext_re =~ s/\./\\./g;
 156             if ($ofile =~ /^(.*)\.$oext_re$/) {
 157                 my $base = $1;
 158                 my $ifound = 0;
 159                 for my $iext (keys %{$rules{$oext}}) {
 160                     print "Considering $base.$iext\n" if $opts{v};
 161                     if (-e "$base.$iext") {
 162                         print "Using $base.$iext\n" if $opts{v};
 163                         push @queue, [$base, $iext, $oext];
 164                         $ifound = 1;
 165                         last;
 166                     }
 167                 }
 168                 unless ($ifound) {
 169                     print "No suitable input file found for $ofile\n";
 170                 }
 171                 $ofound = 1;
 172                 last;
 173             }
 174         }
 175         unless ($ofound) {
 176             print "No rule to make $ofile\n";
 177         }
 178     }
 179 }
 180
 181 print scalar @queue, " items to process\n" if $opts{v};
 182
 183 my $procs = 0;
 184 foreach my $chunk (@queue) {
 185     convert(@$chunk);
 186     $procs++;
 187     if ($procs == $opts{j}) {
 188         wait;
 189         $procs--;
 190     }
 191 }
 192 wait while $procs--;
 193
 194 # vim:ts=4 sts=4 sw=4 expandtab