home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / BuildMM.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-07  |  7.8 KB  |  269 lines
  1. package ModPerl::BuildMM;
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use ExtUtils::MakeMaker ();
  7. use Cwd ();
  8. use File::Spec::Functions qw(catdir catfile splitdir);
  9. use File::Basename;
  10.  
  11. use Apache::Build ();
  12. use ModPerl::MM;
  13.  
  14. our %PM; #add files to installation
  15.  
  16. # MM methods that this package overrides
  17. no strict 'refs';
  18. my $stash = \%{__PACKAGE__ . '::MY::'};
  19. my @methods = grep *{$stash->{$_}}{CODE}, keys %$stash;
  20. ModPerl::MM::override_eu_mm_mv_all_methods(@methods);
  21. use strict 'refs';
  22.  
  23. my $apache_test_dir = catdir Cwd::getcwd(), "Apache-Test", "lib";
  24.  
  25. #to override MakeMaker MOD_INSTALL macro
  26. sub mod_install {
  27.     q{$(PERL) -I$(INST_LIB) -I$(PERL_LIB) \\}."\n" .
  28.     qq{-I$apache_test_dir -MModPerl::BuildMM \\}."\n" .
  29.     q{-e "ModPerl::MM::install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"}."\n";
  30. }
  31.  
  32. sub build_config {
  33.     my $key = shift;
  34.     my $build = Apache::Build->build_config;
  35.     return $build unless $key;
  36.     $build->{$key};
  37. }
  38.  
  39. #the parent WriteMakefile moves MY:: methods into a different class
  40. #so alias them each time WriteMakefile is called in a subdir
  41.  
  42. sub my_import {
  43.     no strict 'refs';
  44.     my $stash = \%{__PACKAGE__ . '::MY::'};
  45.     for my $sym (keys %$stash) {
  46.         next unless *{$stash->{$sym}}{CODE};
  47.         my $name = "MY::$sym";
  48.         undef &$name if defined &$name;
  49.         *$name = *{$stash->{$sym}}{CODE};
  50.     }
  51. }
  52.  
  53. sub WriteMakefile {
  54.     my %args = @_;
  55.  
  56.     my $build = build_config();
  57.     ModPerl::MM::my_import(__PACKAGE__);
  58.  
  59.     my $inc = $build->inc;
  60.     if (my $glue_inc = $build->{MP_XS_GLUE_DIR}) {
  61.         for (split /\s+/, $glue_inc) {
  62.             $inc .= " -I$_";
  63.         }
  64.     }
  65.  
  66.     my $libs = join ' ', $build->apache_libs, $build->modperl_libs;
  67.     my $ccflags = $build->perl_ccopts . $build->ap_ccopts;
  68.  
  69.     my @opts = (
  70.         INC       => $inc,
  71.         CCFLAGS   => $ccflags,
  72.         OPTIMIZE  => $build->perl_config('optimize'),
  73.         LDDLFLAGS => $build->perl_config('lddlflags'),
  74.         LIBS      => $libs,
  75.         dynamic_lib => { OTHERLDFLAGS => $build->otherldflags },
  76.     );
  77.  
  78.     my @typemaps;
  79.     my $pwd = Cwd::fastcwd();
  80.     for ('xs', $pwd, "$pwd/..") {
  81.         my $typemap = $build->file_path("$_/typemap");
  82.         if (-e $typemap) {
  83.             push @typemaps, $typemap;
  84.         }
  85.     }
  86.     push @opts, TYPEMAPS => \@typemaps if @typemaps;
  87.  
  88.     my $clean_files = (exists $args{clean} && exists $args{clean}{FILES}) ?
  89.         $args{clean}{FILES} : '';
  90.     $clean_files .= " glue_pods"; # cleanup the dependency target
  91.     $args{clean}{FILES} = $clean_files;
  92.  
  93.     ExtUtils::MakeMaker::WriteMakefile(@opts, %args);
  94. }
  95.  
  96. my %always_dynamic = map { $_, 1 }
  97.   qw(ModPerl::Const Apache::Const APR::Const APR APR::PerlIO);
  98.  
  99. sub ModPerl::BuildMM::MY::constants {
  100.     my $self = shift;
  101.     my $build = build_config();
  102.  
  103.     #install everything relative to the Apache2/ subdir
  104.     if ($build->{MP_INST_APACHE2}) {
  105.         $self->{INST_ARCHLIB} = catdir $self->{INST_ARCHLIB}, 'Apache2';
  106.         $self->{INST_LIB} = catdir $self->{INST_LIB}, 'Apache2';
  107.     }
  108.  
  109.     #"discover" xs modules.  since there is no list hardwired
  110.     #any module can be unpacked in the mod_perl-2.xx directory
  111.     #and built static
  112.  
  113.     #this stunt also make it possible to leave .xs files where
  114.     #they are, unlike 1.xx where *.xs live in src/modules/perl
  115.     #and are copied to subdir/ if DYNAMIC=1
  116.  
  117.     if ($build->{MP_STATIC_EXTS}) {
  118.         #skip .xs -> .so if we are linking static
  119.         my $name = $self->{NAME};
  120.         unless ($always_dynamic{$name}) {
  121.             if (my($xs) = keys %{ $self->{XS} }) {
  122.                 $self->{HAS_LINK_CODE} = 0;
  123.                 print "$name will be linked static\n";
  124.                 #propagate static xs module to src/modules/perl/Makefile
  125.                 $build->{XS}->{$name} =
  126.                   join '/', Cwd::fastcwd(), $xs;
  127.                 $build->save;
  128.             }
  129.         }
  130.     }
  131.  
  132.     $self->MM::constants;
  133. }
  134.  
  135. sub ModPerl::BuildMM::MY::top_targets {
  136.     my $self = shift;
  137.     my $string = $self->MM::top_targets;
  138.  
  139.     ModPerl::MM::add_dep_after(\$string, "pure_all", pm_to_blib => 'glue_pods');
  140.  
  141.     return $string;
  142. }
  143.  
  144. sub ModPerl::BuildMM::MY::postamble {
  145.     my $self = shift;
  146.  
  147.     my $doc_root = catdir Cwd::getcwd(), "docs", "api";
  148.  
  149.     my @targets = ();
  150.  
  151.     # add the code to glue the existing pods to the .pm files in blib
  152.     my @target = ('glue_pods:');
  153.  
  154.     if (-d $doc_root) {
  155.         while (my ($pm, $blib) = each %{$self->{PM}}) {
  156.             my $pod = catdir(
  157.                 (splitdir($blib))[-2 .. -1]);
  158.             $pod =~ s/\.pm/\.pod/;
  159.             my $podpath = catfile $doc_root, $pod;
  160.             next unless -r $podpath;
  161.  
  162.             push @target, 
  163.                 '$(FULLPERL) -I$(INST_LIB) ' .
  164.                 "-I$apache_test_dir -MModPerl::BuildMM " .
  165.                 "-e ModPerl::BuildMM::glue_pod $pm $podpath $blib";
  166.         }
  167.  
  168.         push @target, $self->{NOECHO} . '$(TOUCH) $@';
  169.     }
  170.     else {
  171.         # we don't have the docs sub-cvs repository extracted, skip
  172.         # the docs gluing
  173.         push @target, $self->{NOECHO} . '$(NOOP)';
  174.     }
  175.     push @targets, join "\n\t", @target;
  176.  
  177. #    # next target: cleanup the dependency file
  178. #    @target = ('glue_pods_clean:');
  179. #    push @target, '$(RM_F) glue_pods';
  180. #    push @targets, join "\n\t", @target;
  181.  
  182.     return join "\n\n", @targets, '';
  183. }
  184.  
  185. sub glue_pod {
  186.  
  187.     die "expecting 3 arguments: pm, pod, dst" unless @ARGV == 3;
  188.     my($pm, $pod, $dst) = @ARGV;
  189.  
  190.     # have we already glued the doc?
  191.     exit 0 unless -s $pm == -s $dst;
  192.  
  193.     # ExtUtils::Install::pm_to_blib removes the 'w' perms, so we can't
  194.     # just append the doc there
  195.     my $orig_mode = (stat $dst)[2];
  196.     my $rw_mode   = 0666;
  197.  
  198.     chmod $rw_mode, $dst      or die "Can't chmod $rw_mode $dst: $!";
  199.     open my $pod_fh, "<$pod"  or die "Can't open $pod: $!";
  200.     open my $dst_fh, ">>$dst" or die "Can't open $dst: $!";
  201.     print $dst_fh (<$pod_fh>);
  202.     close $pod_fh;
  203.     close $dst_fh;
  204.     # restore the perms
  205.     chmod $orig_mode, $dst    or die "Can't chmod $orig_mode $dst: $!";
  206. }
  207.  
  208. sub ModPerl::BuildMM::MY::post_initialize {
  209.     my $self = shift;
  210.     my $build = build_config();
  211.     my $pm = $self->{PM};
  212.  
  213.     while (my($k, $v) = each %PM) {
  214.         if (-e $k) {
  215.             $pm->{$k} = $v;
  216.         }
  217.     }
  218.  
  219.     # prefix typemap with Apache/ so when installed in the
  220.     # perl-lib-tree it won't be picked by non-mod_perl modules
  221.     if (exists $pm->{'lib/typemap'} ) {
  222.         $pm->{'lib/typemap'} = '$(INST_ARCHLIB)/auto/Apache/typemap';
  223.     }
  224.  
  225.     #not everything in MakeMaker uses INST_LIB
  226.     #so we have do fixup a few PMs to make sure *everything*
  227.     #gets installed into Apache2/
  228.     if ($build->{MP_INST_APACHE2}) {
  229.         while (my($k, $v) = each %$pm) {
  230.             #up one from the Apache2/ subdir
  231.             #so it can be found for 'use Apache2 ()'
  232.             next if $v =~ /Apache2\.pm$/;
  233.  
  234.             # another module generated by A-T that needs to go to the
  235.             # normal @INC
  236.             next if $v =~ /TestConfigData\.pm$/;
  237.  
  238.             #move everything else to the Apache2/ subdir
  239.             #unless already specified with \$(INST_LIB)
  240.             #or already in Apache2/
  241.             unless ($v =~ /Apache2/) {
  242.                 $v =~ s{ (blib[/\\:]lib) }{ catdir $1, 'Apache2'}xe;
  243.             }
  244.  
  245.             $pm->{$k} = $v;
  246.         }
  247.     }
  248.  
  249.     '';
  250. }
  251.  
  252. sub ModPerl::BuildMM::MY::libscan {
  253.     my($self, $path) = @_;
  254.  
  255.     my $apr_config = build_config()->get_apr_config();
  256.  
  257.     if ($path =~ m/(Thread|Global)Mutex/) {
  258.         return unless $apr_config->{HAS_THREADS};
  259.     }
  260.  
  261.     return '' if $path =~ m/\.(pl|cvsignore)$/;
  262.     return '' if (basename dirname $path) eq 'CVS';
  263.     return '' if $path =~ m/~$/;
  264.  
  265.     $path;
  266. }
  267.  
  268. 1;
  269.