home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _9c67b9f8241b2f97da970c691eded049 < prev    next >
Encoding:
Text File  |  2004-06-01  |  3.0 KB  |  137 lines
  1. package ActivePerl::DocTools::Tree::HTML;
  2.  
  3. use strict;
  4. use warnings;
  5. use Pod::Find;
  6. use Pod::Html;
  7. use File::Basename;
  8. use File::Path;
  9. use Config;
  10.  
  11. sub _rel_path {
  12.     my $path = shift;
  13.     my $pfx = shift;
  14.     $path =~ s{\\}{/}g if $^O =~ /^MSWin/;
  15.     $path =~ s{/\z}{} if $path !~ m{^([A-Za-z]:)?/\z};
  16.     if (defined $pfx and length $pfx) {
  17.     $pfx =~ s{\\}{/}g if $^O =~ /^MSWin/;
  18.         $pfx =~ s{/\z}{} if $pfx !~ m{^([A-Za-z]:)?/\z};
  19.     my @pathbits = split '/', $path;
  20.     my @pfxbits = split '/', $pfx;
  21.     return $path if @pathbits < @pfxbits;
  22.     while (@pfxbits) {
  23.         my $pathbit = shift @pathbits;
  24.         my $pfxbit = shift @pfxbits;
  25.         unless ($pathbit eq $pfxbit
  26.             or ($^O =~ /^MSWin/ and lc($pathbit) eq lc($pfxbit)))
  27.         {
  28.         return $path;
  29.         }
  30.     }
  31.     $path = join '/', @pathbits;
  32.     $path = "." unless length $path;
  33.     }
  34.     $path;
  35. }
  36.  
  37. sub Update {
  38.     my %args = @_;
  39.  
  40.     chdir $Config{installprefix}
  41.     || do { warn "Can't cd to root of Perl installation: $!\n"; return; };
  42.  
  43.     my $wd = $Config{installprefix};
  44.     my $hd = $Config{installhtmldir} || "$Config{installprefix}/html";
  45.  
  46.     # turn $hd into a relative path
  47.     $hd = _rel_path($hd,$wd);
  48.  
  49.     print "Building HTML tree at $hd, cwd is $wd\n" if $args{verbose};
  50.     
  51.     my $css = "Active.css";
  52.  
  53.     my %pods = Pod::Find::pod_find({}, @Config{qw(privlib sitelib scriptdir)});
  54.     my $podpath = join ":", map { _rel_path($_,$wd) }
  55.                 @Config{qw(privlib sitelib scriptdir)};
  56.                  
  57.     foreach my $key (sort(keys %pods)) {
  58.  
  59.     my $infile = $key;
  60.     $infile = _rel_path($infile,$wd);
  61.  
  62.     my $outfile = "$hd/$infile";
  63.  
  64.         # replace trailing .suffix with .html
  65.     $outfile =~ s{\.[^.]*\z}{};
  66.     $outfile .= ".html";
  67.  
  68.     if (! -e $outfile or (stat $infile)[9] > (stat $outfile)[9]) {
  69.         print "Making $outfile from $infile => $pods{$key}\n"
  70.         if $args{verbose};
  71.         unlink($outfile) if -e $outfile;
  72.         my $dir = dirname($outfile);
  73.         mkpath($dir);
  74.  
  75.         my $depth = 0;
  76.         while ($dir =~ m!/!g) {
  77.         $depth++;
  78.         }
  79.  
  80.         (my $back = "../" x $depth) =~ s{/$}{};
  81.         $back = "." unless $back;
  82.  
  83.     
  84.         my @args = (
  85.             "--htmldir=$dir",
  86.             "--htmlroot=$back",
  87.             "--podroot=.",
  88.             "--podpath=$podpath",
  89.             "--libpods=perlfunc:perlguts:perlvar:perlrun:perlopt",
  90.             "--header", 
  91.             "--infile=$infile", 
  92.             "--outfile=$outfile", 
  93.             "--css=$back/$css", 
  94.             "--quiet",
  95.             );
  96.         #print "pod2html('", join("',", @args), "')\n" if $args{verbose};
  97.         pod2html(@args);
  98.     }
  99.     else {
  100.         print "Skipping $outfile\n" if $args{verbose};
  101.     }
  102.     }
  103. }
  104.  
  105. 1;
  106.  
  107. __END__
  108.  
  109. #=head1 NAME
  110.  
  111. ActivePerl::DocTools::Tree::HTML - module for generating Perl documentation
  112.  
  113. #=head1 SYNOPSIS
  114.  
  115.   use ActivePerl::DocTools;
  116.   ActivePerl::DocTools::UpdateHTML();
  117.   
  118. #=head1 DESCRIPTION
  119.  
  120. Module for generating Perl html docs.
  121.  
  122. #=head2 EXPORTS
  123.  
  124. nothing
  125.  
  126. #=head1 AUTHOR
  127.  
  128. David Sparks, daves@ActiveState.com
  129.  
  130. #=head1 SEE ALSO
  131.  
  132. The amazing L<PPM>.
  133.  
  134. L<ActivePerl::DocTools>
  135.  
  136. #=cut
  137.