Pod::Abstract::Filter::unoverlay - paf command to remove "overlay" blocks

Pod-Abstract documentation Contained in the Pod-Abstract distribution.

Index

Code Index:

NAME

Top

Pod::Abstract::Filter::unoverlay - paf command to remove "overlay" blocks from a Pod document, as created by the paf overlay command.

METHODS

Top

new

filter

Strips any sections marked =for overlay from the listed overlay specification from the target document. This will expunge everything that has been previously overlaid or marked for overlay from the specified documents.

AUTHOR

Top

Ben Lilburne <bnej@mac.com>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2009 Ben Lilburne

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Pod-Abstract documentation Contained in the Pod-Abstract distribution. 
package Pod::Abstract::Filter::unoverlay;
use strict;
use warnings;

use base qw(Pod::Abstract::Filter);

our $VERSION = '0.20';


sub filter {
    my $self = shift;
    my $pa = shift;
    
    my ($overlay_list) = $pa->select("//begin[. =~ {^:overlay}](0)");
    unless($overlay_list) {
        die "No overlay defined in document\n";
    }
    my @overlays = $overlay_list->select("/overlay");
    foreach my $overlay (@overlays) {
        my $o_def = $overlay->body;
        my ($section, $module) = split " ", $o_def;
        
        my ($t) = $pa->select("//[\@heading =~ {$section}](0)");
        my @t_headings = $t->select("/[\@heading]");
        foreach my $hdg (@t_headings) {
            my @overlay_from = 
                $hdg->select(
                    "/for[. =~ {^overlay from }]");
            my @from_current = grep {
                substr($_->body, -(length $module)) eq $module
            } @overlay_from;
            if(@from_current) {
                $hdg->detach;
            }
        }
    }
    return $pa;
}


1;