Makefile.PL

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