Makefile.PL

   1 require 5.005;
   2 use ExtUtils::MakeMaker;
   3
   4 my $tmpl = "./Info.pm.tmpl";
   5 my $info_pm = "./lib/Image/Info.pm";
   6 my $idir = "./lib/Image/Info";
   7 opendir(DIR, $idir) || die "Can't opendir $idir: $!";
   8 my @code;
   9 my @desc;
  10 for my $file (sort readdir(DIR)) {
  11     next unless $file =~ /^([a-zA-Z]\w*)\.pm$/;
  12     my $format = $1;
  13
  14     open(F, "$idir/$file") || die "Can't open '$idir/$file': $!";
  15     my @magic;
  16     my @desc;
  17     while (<F>) {
  18         if (/^=begin\s+register\b/ ... /^=end\s+register\b/) {
  19             next if /^=(begin|end)/;
  20             if (/^MAGIC:\s+(.*)/) {
  21                 push(@magic, $1);
  22                 next;
  23             }
  24             push(@desc, $_);
  25         }
  26     }
  27     die "Missing magic for $format" unless @magic;
  28     for (@magic) {
  29         if (m:^/:) {
  30             push(@code, qq(return "$format" if $_;));
  31         }
  32         else {
  33             push(@code, qq(return "$format" if \$_ eq $_;));
  34         }
  35     }
  36
  37     # trim
  38     shift(@desc) while @desc && $desc[0]  =~ /^\s*$/;
  39     pop(@desc)   while @desc && $desc[-1] =~ /^\s*$/;
  40
  41     $desc .= "\n=item $format\n" unless @desc && $desc[0] =~ /^=item/;
  42     $desc .= "\n" . join("", @desc);
  43
  44 }
  45 closedir(DIR);
  46
  47 my $code = "sub determine_file_format
  48 {
  49    local(\$_) = \@_;
  50    " . join("\n   ", @code) . "
  51    return undef;
  52 }
  53 ";
  54
  55 # Copy template to top level module with substitutions
  56 open(TMPL, $tmpl) || die "Can't open $tmpl: $!";
  57 open(INFO, ">$info_pm") || die "Can't create $info_pm: $!";
  58 print INFO <<"EOT";
  59 # This file is autogenerated from $tmpl.
  60 # Please do not edit!!
  61
  62 EOT
  63
  64 while (<TMPL>) {
  65     if (/^%%DETERMINE_FILE_FORMAT%%/) {
  66         $_ = $code;
  67     }
  68     elsif (/^%%FORMAT_DESC%%/) {
  69        $_ = $desc;
  70     }
  71     print INFO $_;
  72 }
  73 close(INFO);
  74 close(TMPL);
  75
  76 WriteMakefile(
  77     NAME         => 'Image::Info',
  78     AUTHOR       => 'Gisle Aas <gisle@ActiveState.com',
  79     VERSION_FROM => $info_pm,
  80     PREREQ_PM    => {
  81                       'IO::String' => 1,
  82                     },
  83     clean        => { FILES => $info_pm },
  84     dist         => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
  85 );
  86