Changeset 2836

Show
Ignore:
Timestamp:
07/24/08 23:36:22 (4 months ago)
Author:
bchoate
Message:

Cover more tag POD testing.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • branches/release-42/t/91-tagcoverage.t

    r2742 r2836  
    55use Test::More; 
    66use MT::Test; 
     7use File::Spec; 
    78use Data::Dumper; 
    89 
    9 my @core_docs = qw( 
    10     lib/MT/Template/ContextHandlers.pm 
    11     lib/MT/Template/Context/Search.pm 
    12 ); 
     10my $components = { 
     11    'core' => { 
     12        paths => [ 
     13            'MT/Template/ContextHandlers.pm', 
     14            'MT/Template/Context/Search.pm', 
     15        ], 
     16    }, 
     17    'commercial' => { 
     18        paths => [ 
     19            'CustomFields/Template/ContextHandlers.pm', 
     20        ], 
     21    }, 
     22    'community' => { 
     23        paths => [ 
     24            'MT/Community/Tags.pm', 
     25        ], 
     26    }, 
     27    'multiblog' => { 
     28        paths => [ 
     29            'MultiBlog/Tags.pm', 
     30        ], 
     31    }, 
     32    'FeedsAppLite' => { 
     33        paths => [ 
     34            'MT/Feeds/Tags.pm', 
     35        ], 
     36    }, 
     37}; 
    1338 
    1439my $mt = MT->instance; 
    15 my $tags = $mt->component('core')->registry('tags'); 
    1640 
    17 my $tag_count = (scalar keys(%{ $tags->{function} }) 
    18     + scalar keys(%{ $tags->{modifier} }) 
    19     + scalar keys(%{ $tags->{block} })) 
    20     - 3; # the registry gives us an extra 'plugin' key for each element 
     41my $tag_count = 0; 
     42foreach my $c (keys %$components) { 
     43    next unless $mt->component($c); 
     44    my $tags = $mt->component($c)->registry('tags'); 
     45    my $fn_count = scalar keys(%{ $tags->{function} }); 
     46    $fn_count-- if $fn_count; 
     47    my $mod_count = scalar keys(%{ $tags->{modifier} }); 
     48    $mod_count-- if $mod_count; 
     49    my $block_count = scalar keys(%{ $tags->{block} }); 
     50    $block_count-- if $block_count; 
     51    my $count = $fn_count + $mod_count + $block_count; 
     52    $tag_count += $count; 
     53} 
     54 
    2155plan tests => $tag_count; 
    2256 
    23 my $core_docs = ''; 
    24 { 
    25     local $/ = undef; 
    26     foreach my $file ( @core_docs ) { 
    27         # core tag docs are embedded as POD 
    28         open DOC, "< $file"; 
    29         $core_docs .= <DOC>; 
    30         close DOC; 
     57foreach my $c (keys %$components) { 
     58    next unless $mt->component($c); 
     59    diag("Checking for tag documentation for component $c"); 
     60    my $all_docs = ''; 
     61    my $tags = $mt->component($c)->registry('tags'); 
     62    my $paths = $components->{$c}{paths}; 
     63    { 
     64        local $/ = undef; 
     65        FILE: foreach my $file ( @$paths ) { 
     66            # core tag docs are embedded as POD 
     67            foreach my $inc ( @INC ) { 
     68                my $file_path = File::Spec->catfile($inc, $file); 
     69                next unless -e $file_path; 
     70 
     71                diag("Reading module $file_path"); 
     72                open DOC, "< $file_path" 
     73                    or die "Can't read file $file_path: " . $!; 
     74                $all_docs .= <DOC>; 
     75                close DOC; 
     76                next FILE; 
     77            } 
     78            die "Could not locate $file!"; 
     79        } 
     80    } 
     81 
     82    # Determine if the core tags have adequate documentation or not. 
     83    my $doc_names = {}; 
     84    while ($all_docs =~ m/\n=head2[ ]+([\w:]+)[ ]*\n(.*?)?\n=cut[ ]*\n/gs) { 
     85        my $tag = $1; 
     86        my $docs = defined $2 ? $2 : ''; 
     87        $docs =~ s/\r//g; # for windows newlines 
     88        # ignore comment lines 
     89        $docs =~ s/^#.*//gm; 
     90        # ignore empty lines 
     91        $docs =~ s/^\s*$//gm; 
     92        # strip any '=for ...', etc. directive. docs should be above this 
     93        $docs =~ s/(^|\n)=\w+.*//s; 
     94        # strip trailing/leading newlines 
     95        $docs =~ s/^\n+//s; 
     96        $docs =~ s/\n+$//s; 
     97        # if documentation block doesn't have anything left, the tag is undocumented 
     98        next if $docs eq ''; 
     99        $doc_names->{$tag} = 1; 
     100    } 
     101 
     102    foreach my $tag ( keys %{ $tags->{function} } ) { 
     103        next if $tag eq 'plugin'; 
     104        ok(exists $doc_names->{$tag}, "component $c, function tag $tag"); 
     105    } 
     106 
     107    foreach my $tag ( keys %{ $tags->{block} } ) { 
     108        next if $tag eq 'plugin'; 
     109        $tag =~ s/\?$//; 
     110        ok(exists $doc_names->{$tag}, "component $c, block tag $tag"); 
     111    } 
     112 
     113    foreach my $tag ( keys %{ $tags->{modifier} } ) { 
     114        next if $tag eq 'plugin'; 
     115        ok(exists $doc_names->{$tag}, "component $c, modifier $tag"); 
    31116    } 
    32117} 
    33118 
    34 # Determine if the core tags have adequate documentation or not. 
    35 my $doc_names = {}; 
    36 while ($core_docs =~ m/\n=head2[ ]+([\w:]+)[ ]*\n(.*?)?\n=cut[ ]*\n/gs) { 
    37     my $tag = $1; 
    38     my $docs = defined $2 ? $2 : ''; 
    39     $docs =~ s/\r//g; # for windows newlines 
    40     # ignore comment lines 
    41     $docs =~ s/^#.*//gm; 
    42     # ignore empty lines 
    43     $docs =~ s/^\s*$//gm; 
    44     # strip any '=for ...', etc. directive. docs should be above this 
    45     $docs =~ s/(^|\n)=\w+.*//s; 
    46     # strip trailing/leading newlines 
    47     $docs =~ s/^\n+//s; 
    48     $docs =~ s/\n+$//s; 
    49     # if documentation block doesn't have anything left, the tag is undocumented 
    50     next if $docs eq ''; 
    51     $doc_names->{lc $tag} = 1; 
    52 } 
    53  
    54 foreach my $tag ( keys %{ $tags->{function} } ) { 
    55     next if $tag eq 'plugin'; 
    56     ok(exists $doc_names->{lc $tag}, "function tag $tag"); 
    57 } 
    58  
    59 foreach my $tag ( keys %{ $tags->{block} } ) { 
    60     next if $tag eq 'plugin'; 
    61     $tag =~ s/\?$//; 
    62     ok(exists $doc_names->{lc $tag}, "block tag $tag"); 
    63 } 
    64  
    65 foreach my $tag ( keys %{ $tags->{modifier} } ) { 
    66     next if $tag eq 'plugin'; 
    67     ok(exists $doc_names->{lc $tag}, "modifier $tag"); 
    68 } 
    69