File Coverage

blib/lib/Pod/Licensizer.pm

Criterion	Covered	Total	%
statement	52	71	73.2
branch	11	30	36.6
condition	1	3	33.3
subroutine	10	12	83.3
pod	2	8	25.0
total	76	124	61.2

###########################################
package Pod::Licensizer;
###########################################
use strict;
use warnings;
use Pod::Abstract;
use Log::Log4perl qw(:easy);

our $VERSION = "0.03";

###########################################
sub new {
###########################################
    my( $class, %options ) = @_;

    my $self = {
        pa       => undef,
        file     => undef,
        org_pod  => undef,
        %options,
    };

    bless $self, $class;

    return $self;
}

###########################################
sub load_file {
###########################################
    my( $self, $file ) = @_;

    $self->{ file }    = $file;
    $self->{ pa }      = Pod::Abstract->load_file( $file );

    $self->{ org_pod } = $self->{ pa }->pod();

    return $self->{ pa };
}

###########################################
sub modified {
###########################################
    my( $self ) = @_;

    return $self->{ org_pod } ne $self->{ pa }->pod();
}

###########################################
sub write_file {
###########################################
    my( $self, $file ) = @_;

    if( !defined $file ) {
        if( defined $self->{ file } ) {
            $file = $self->{ file };
        } else {
            LOGWARN "No file defined";
            return  undef;
        }
    }

    if( ! open FILE, ">$file" ) {
        ERROR "Can't open $file: $!";
        return undef;
    }

    print FILE $self->{ pa }->pod();
    close FILE;
}

###########################################
sub as_string {
###########################################
    my( $self ) = @_;

    return $self->{ pa }->pod();
}

###########################################
sub author_patch {
###########################################
    my( $self, $text, $opts ) = @_;

    $opts = {} unless defined $opts;

    if( $opts->{author_heading} ) {
        $opts->{author_regex} = "^$opts->{author_heading}\$";
    } else {
        $opts->{author_regex} = '^AUTHORS?$';
        $opts->{author_heading} = "AUTHOR";
    }

    return $self->section_patch( $opts->{author_heading},
                                 $opts->{author_regex},
                                 $text,
                                 $opts );
}

###########################################
sub license_patch {
###########################################
    my( $self, $text, $opts ) = @_;

    $opts = {} unless defined $opts;
    $opts->{license_heading} = "LICENSE" if !defined $opts->{license_heading};

    return $self->section_patch( $opts->{license_heading},
                                 "^$opts->{license_heading}\$",
                                 $text,
                                 $opts );
}

###########################################
sub section_patch {
###########################################
    my( $self, $heading, $regex, $text, $opts ) = @_;

    my $info_prefix = "";
    $info_prefix = "(dryrun) " if $opts->{ dryrun };

    while( $text !~ /\n\n$/ ) {
        $text = "$text\n";
    }

    $text =~ s/^/    /gm if exists $opts->{mode} and
        $opts->{mode} eq "verbatim";

    my($section_head) = $self->{pa}->select("/head1[\@heading =~ {$regex}]");

    if( $opts->{ clear } ) {
        if( defined $section_head ) {
            INFO "${info_prefix}deleting section $heading from $self->{ file }";
            if( ! $opts->{ dryrun } ) {
                $section_head->detach();
            }
        }
        return 1;
    }

    my $section_new = Pod::Abstract->load_string( $text );

    if( !defined $section_head ) {
        $section_head = Pod::Abstract->load_string(
            "=head1 $heading\n\nBlah.\n\n" );
          # skip the root
        ($section_head) = $section_head->children();

          # find the last =head1
        my( $last_head1 ) = reverse $self->{pa}->select("/head1");
        $last_head1 = $self->{pa} unless defined $last_head1;

            $section_head->insert_after( $last_head1 );
    }

    INFO "${info_prefix}adding section $heading to $self->{ file }";
    if( ! $opts->{ dryrun } ) {
        $section_head->clear();
        $section_head->push( $section_new );
    }
}

1;

__END__