Ticket #94: trac94-pod2man.patch

File trac94-pod2man.patch, 7.8 KB (added by rurban, 13 years ago)
  • (a) /dev/null vs. (b) parrot-svn/config/auto/pod2man.pm

    https://trac.parrot.org/parrot/ticket/94
    
    make install-docs needs pod2man.
    Analog to perldoc we check for the path and the version of pod2man
    
    a b  
     1# Copyright (C) 2008, The Perl Foundation. 
     2# $Id: pod2man.pm 30367 2008-08-20 02:21:59Z rurban $ 
     3 
     4=head1 NAME 
     5 
     6config/auto/pod2man - Check whether pod2man works 
     7 
     8=head1 DESCRIPTION 
     9 
     10Determines whether F<pod2man> exists on the system and, if so, which 
     11version of F<pod2man> it is, analog to F<perldoc>. 
     12 
     13More specifically, we look for the F<pod2man> associated with the 
     14instance of F<perl> with which F<Configure.pl> was invoked. 
     15 
     16=cut 
     17 
     18package auto::pod2man; 
     19 
     20use strict; 
     21use warnings; 
     22 
     23use File::Temp qw (tempfile ); 
     24use base qw(Parrot::Configure::Step); 
     25use Parrot::Configure::Utils ':auto'; 
     26 
     27 
     28sub _init { 
     29    my $self = shift; 
     30    my %data; 
     31    $data{description} = q{Is pod2man installed}; 
     32    $data{result}      = q{}; 
     33    return \%data; 
     34} 
     35 
     36sub runstep { 
     37    my ( $self, $conf ) = @_; 
     38 
     39    my $cmd = $conf->data->get_p5('scriptdirexp') . q{/pod2man}; 
     40    my ( $fh, $filename ) = tempfile( UNLINK => 1 ); 
     41    my $content = capture_output("$cmd -ud $filename pod2man") || undef; 
     42 
     43    return 1 unless defined( $self->_initial_content_check($conf, $content) ); 
     44 
     45    my $version = $self->_analyze_pod2man($cmd, $filename, $content); 
     46 
     47    _handle_version($conf, $version, $cmd); 
     48 
     49    return 1; 
     50} 
     51 
     52sub _initial_content_check { 
     53    my $self = shift; 
     54    my ($conf, $content) = @_; 
     55    if (! defined $content) { 
     56        $conf->data->set( 
     57            has_pod2man => 0, 
     58            new_pod2man => 0, 
     59        ); 
     60        $self->set_result('no'); 
     61        return; 
     62    } 
     63    else { 
     64        return 1; 
     65    } 
     66} 
     67 
     68sub _analyze_pod2man { 
     69    my $self = shift; 
     70    my ($cmd, $tmpfile, $content) = @_; 
     71    my $version; 
     72    if ( $content =~ m/^Unknown option:/ ) { 
     73        $content = capture_output("$cmd pod2man") || ''; 
     74        if ($content =~ m/pod2man/) { 
     75            $version = $self->_handle_old_pod2man(); 
     76        } 
     77        else { 
     78            $version = $self->_handle_no_pod2man(); 
     79        } 
     80    } 
     81    elsif ( open my $FH, '<', $tmpfile ) { 
     82        local $/; 
     83        $content = <$FH>; 
     84        close $FH; 
     85        $version = 2; 
     86        $self->set_result('yes'); 
     87    } 
     88    else { 
     89        $version = $self->_handle_no_pod2man(); 
     90    } 
     91    unlink $tmpfile; 
     92    return $version; 
     93} 
     94 
     95sub _handle_old_pod2man { 
     96    my $self = shift; 
     97    $self->set_result('yes, old version'); 
     98    return 1; 
     99} 
     100 
     101sub _handle_no_pod2man { 
     102    my $self = shift; 
     103    $self->set_result('failed'); 
     104    return 0; 
     105} 
     106 
     107sub _handle_version { 
     108    my ($conf, $version, $cmd) = @_; 
     109    $conf->data->set( 
     110        has_pod2man => $version != 0 ? 1 : 0, 
     111        new_pod2man => $version == 2 ? 1 : 0 
     112    ); 
     113 
     114    $conf->data->set( pod2man => $cmd ) if $version; 
     115 
     116    return 1; 
     117} 
     118 
     1191; 
     120 
     121# Local Variables: 
     122#   mode: cperl 
     123#   cperl-indent-level: 4 
     124#   fill-column: 100 
     125# End: 
     126# vim: expandtab shiftwidth=4: 
  • lib/Parrot/Configure/Step/List.pm

    old new  
    6060    auto::gettext 
    6161    auto::snprintf 
    6262    auto::perldoc 
     63    auto::pod2man 
    6364    auto::ctags 
    6465    auto::revision 
    6566    auto::icu 
  • (a) /dev/null vs. (b) parrot-svn/t/steps/auto_pod2man-01.t

    a b  
     1#! perl 
     2# Copyright (C) 2007, The Perl Foundation. 
     3# $Id: auto_pod2man-01.t 30640 2008-08-29 23:09:28Z jkeenan $ 
     4# auto_pod2man-01.t 
     5 
     6use strict; 
     7use warnings; 
     8use Test::More tests => 32; 
     9use Carp; 
     10use lib qw( lib t/configure/testlib ); 
     11use_ok('config::init::defaults'); 
     12use_ok('config::auto::pod2man'); 
     13use Parrot::BuildUtil; 
     14use Parrot::Configure; 
     15use Parrot::Configure::Options qw( process_options ); 
     16use Parrot::Configure::Test qw( 
     17    test_step_thru_runstep 
     18    rerun_defaults_for_testing 
     19    test_step_constructor_and_description 
     20); 
     21use IO::CaptureOutput qw| capture |; 
     22 
     23########## regular ########## 
     24 
     25my ($args, $step_list_ref) = process_options( { 
     26    argv            => [], 
     27    mode            => q{configure}, 
     28} ); 
     29 
     30my $conf = Parrot::Configure->new(); 
     31 
     32test_step_thru_runstep($conf, q{init::defaults}, $args); 
     33 
     34my $pkg = q{auto::pod2man}; 
     35 
     36$conf->add_steps($pkg); 
     37 
     38my $serialized = $conf->pcfreeze(); 
     39 
     40$conf->options->set(%{$args}); 
     41my $step = test_step_constructor_and_description($conf); 
     42ok($step->runstep($conf), "runstep() completed successfully"); 
     43ok(defined($step->result), "Result was defined"); 
     44my $has = $conf->data->get('has_pod2man'); 
     45ok( ( ($has == 1) or ($has == 0) ), 
     46    "Got an acceptable value for 'has_pod2man'"); 
     47my $new = $conf->data->get('new_pod2man'); 
     48ok( ( ($new == 1) or ($new == 0) ), 
     49    "Got an acceptable value for 'new_pod2man'"); 
     50 
     51$conf->replenish($serialized); 
     52 
     53########## _initial_content_check() ########## 
     54 
     55my $content = undef; 
     56my $rv = $step->_initial_content_check($conf, $content); 
     57ok(! defined $rv, "Got expected return value when content was undefined"); 
     58is($step->result(), 
     59    q{no}, "Got expected result when content was undefined"); 
     60 
     61########## _handle_version() ########## 
     62 
     63my $version; 
     64$version = 0; 
     65ok(auto::pod2man::_handle_version($conf, $version, 'not_a_path'), 
     66    "_handle_version() returned true value"); 
     67is($conf->data->get('has_pod2man'), 0, 
     68    "Got expected value for 'has_pod2man'"); 
     69is($conf->data->get('new_pod2man'), 0, 
     70    "Got expected value for 'new_pod2man'"); 
     71is($conf->data->get('pod2man'), undef, 
     72    "... and expected 'pod2man' path"); 
     73 
     74$version = 1; 
     75ok(auto::pod2man::_handle_version($conf, $version, 'path_to_pd'), 
     76    "_handle_version() returned true value"); 
     77is($conf->data->get('has_pod2man'), 1, 
     78    "Got expected value for 'has_pod2man'"); 
     79is($conf->data->get('new_pod2man'), 0, 
     80    "Got expected value for 'new_pod2man'"); 
     81is($conf->data->get('pod2man'), 'path_to_pd', 
     82    "... and expected 'pod2man' path"); 
     83 
     84$version = 2; 
     85ok(auto::pod2man::_handle_version($conf, $version, 'another_path_to_pd'), 
     86    "_handle_version() returned true value"); 
     87is($conf->data->get('has_pod2man'), 1, 
     88    "Got expected value for 'has_pod2man'"); 
     89is($conf->data->get('new_pod2man'), 1, 
     90    "Got expected value for 'new_pod2man'"); 
     91is($conf->data->get('pod2man'), 'another_path_to_pd', 
     92    "... and expected 'pod2man' path"); 
     93 
     94########## _handle_old_pod2man() ########## 
     95 
     96$version = $step->_handle_old_pod2man(); 
     97is($version, 1, "Got expected version setting for old pod2man"); 
     98is($step->result(), q{yes, old version}, 
     99    "Got expected result when old pod2man"); 
     100 
     101########## _handle_no_pod2man() ########## 
     102 
     103$version = $step->_handle_no_pod2man(); 
     104is($version, 0, "Got expected version setting for no pod2man"); 
     105is($step->result(), q{failed}, "Got expected result when no pod2man"); 
     106 
     107pass("Completed all tests in $0"); 
     108 
     109################### DOCUMENTATION ################### 
     110 
     111=head1 NAME 
     112 
     113auto_pod2man-01.t - test auto::pod2man 
     114 
     115=head1 SYNOPSIS 
     116 
     117    % prove t/steps/auto_pod2man-01.t 
     118 
     119=head1 DESCRIPTION 
     120 
     121The files in this directory test functionality used by F<Configure.pl>. 
     122 
     123The tests in this file test auto::pod2man. 
     124 
     125=head1 AUTHOR 
     126 
     127Reini Urban 
     128 
     129=head1 SEE ALSO 
     130 
     131config::auto::pod2man, F<Configure.pl>. 
     132 
     133=cut 
     134 
     135# Local Variables: 
     136#   mode: cperl 
     137#   cperl-indent-level: 4 
     138#   fill-column: 100 
     139# End: 
     140# vim: expandtab shiftwidth=4: