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