Changeset 10051

Show
Ignore:
Timestamp:
04/21/06 17:41:57 (3 years ago)
Author:
audreyt
Message:

* Perl6::Doc Makefile.PL: tweak it to use LWP::Simple

instead of /usr/bin/svn to save bandwidth.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • docs/Perl6/Makefile.PL

    r10050 r10051  
    11use strict; 
    22use lib "../..", "../../inc"; 
    3 use inc::Module::Install prefix => '../../inc'; 
     3use inc::Module::Install ( 
     4    -d '../../misc/pX' ? (prefix => '../../inc') : () 
     5); 
    46use File::Path; 
    57 
    … …  
    810license    ('perl'); 
    911 
    10  
    11 my $svn_path = "/usr/bin/svn"; 
    12 my $location = "http://svn.perl.org/perl6/doc/trunk/design/syn"; 
    13 my $synopsis_svn = "synopsis-svn"; 
    14  
    15 my %commands = ( 'checkout' => "$svn_path co $location $synopsis_svn", 
    16                  'update'   => "$svn_path update $synopsis_svn" 
    17                 ); 
    18  
    19 my %table = ( 'S01' => 'Overview', 
    20               'S02' => 'Syntax', 
    21               'S03' => 'Operator', 
    22               'S04' => 'Block', 
    23               'S05' => 'Rule', 
    24               'S06' => 'Subroutine', 
    25 #             'S07' => '', 
    26 #             'S08' => '', 
    27               'S09' => 'Structure', 
    28               'S10' => 'Package', 
    29               'S11' => 'Module', 
    30               'S12' => 'Object', 
    31               'S13' => 'Overload', 
    32               'S17' => 'Threads', 
    33               'S29' => 'Functions' 
    34               ); 
    35  
    36 print "Checkout the newest Synopsis from $location\n"; 
    37 if ( -e $svn_path ) { 
    38         if( -d $synopsis_svn && ! -f $synopsis_svn) { 
    39 #               system( $commands{'update'} ); 
    40         } else { 
    41                 system( $commands{'checkout'} ); 
    42         } 
    43 } 
    44 print "Moving newest synopsis to Spec\n"; 
    45 for (keys %table) { 
    46         rename "$synopsis_svn/$_.pod", "Spec/$table{$_}.pod"; 
    47 } 
    48 print "Removing temporary download directory.\n"; 
    49 rmtree $synopsis_svn, 0, 0; 
    50  
    51  
    5212install_script( 'p6doc' ); 
    5313makemaker_args( PMLIBDIRS => [ grep { -d } glob("[A-Z]*") ]); 
    5414 
     15refresh_specs() if -d '../../misc/pX'; 
     16 
    5517WritePugs  (5); 
     18 
     19sub refresh_specs { 
     20    # okay, we are at author side - refresh Synopses 
     21    require LWP::Simple; 
     22 
     23    use vars '$ua'; 
     24    LWP::Simple->import('mirror', '$ua'); 
     25 
     26    my $BaseURI = 'http://svn.perl.org/perl6/doc/trunk/design/syn'; 
     27    my %Spec = qw( 
     28        01 Overview 02 Syntax       03 Operator     04 Block 
     29        05 Rule     06 Subroutine   09 Structure    10 Package 
     30        11 Module   12 Object       13 Overload 
     31    ); 
     32 
     33    my $request = HTTP::Request->new(HEAD => $BaseURI); 
     34    my $response = $ua->request($request); 
     35 
     36    $response->is_success or return; 
     37 
     38    my $etags = $response->header('ETag') or return; 
     39    ($etags =~ /(\d+)/) or return; 
     40 
     41    local $| = 1; 
     42    print "==> Refreshing specs from $BaseURI...\n"; 
     43 
     44    my $remote_revision = $1; 
     45    my $local_revision = -1; 
     46 
     47    if ( open(FH, '.spec-revision') ) { 
     48        chomp($local_revision = <FH>); 
     49        close FH; 
     50    } 
     51 
     52    if ($local_revision == $remote_revision) { 
     53        print "==> No changes.\n"; 
     54        return; 
     55    } 
     56 
     57    print "==> Synchronizing to revision $remote_revision:\n"; 
     58 
     59    for my $num (sort keys %Spec) { 
     60        my $file = $Spec{$num}; 
     61        print "  $num --> Spec/$file\n"; 
     62        LWP::Simple::mirror( 
     63            "$BaseURI/$num.pod" => "Spec/$file.pod" 
     64        ); 
     65    } 
     66 
     67    open FH, '>', '.spec-revision' or return; 
     68    print FH $remote_revision, "\n"; 
     69    close FH; 
     70}