File Coverage

blib/lib/Text/Annotated/Writer.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Text::Annotated::Writer;
# $Id: Writer.pm,v 1.7 2007-05-12 18:39:16 wim Exp $
use strict;
use vars qw($VERSION);
use Text::Annotated::Line;
use Text::Filter;
use base qw(Text::Filter);
$VERSION = '0.04';

sub new {
    my $proto = shift;
    my $pkg = ref($proto) || $proto;
    my %arg = @_;

    # initialize the no_annotation flag
    my $no_annotation = $arg{no_annotation} || 0; # defaults to printing of the annotations
    delete $arg{no_annotation};

    # construct the filter
    my $this = $pkg->SUPER::new(input => [], %arg);
    bless $this, $pkg;

    # add the fields
    $this->{no_annotation} = $no_annotation;

    # return the filter
    return $this;
}

sub set_input { # overrides set_input in Text::Filter, adding a type check
    my ($this,$input,$postread) = @_;

    ref($input) eq 'ARRAY' or
	die "Invalid input specified,\n"
	  . "Text::Annotated::Writer expects an array of Text::Annotated::Line objects,\n"
          . "stopped";

    $this->SUPER::set_input($input,$postread);
}

sub write {
    my Text::Annotated::Writer $this = shift;
    my $na = $this->{no_annotation};
    while(defined(my $line = $this->readline)) {
	$this->writeline($na
	    ? "$line" # this will work both on annotated lines and ordinary strings
	    : $line->stringify_annotated
	);
    }
}

sub run { # needed when using the filter in a Text::Filter::Chain
    my $this = shift;
    $this->write(@_);
}

sub writer { # constructs and runs the filter
    my $proto = shift;
    my $this = $proto->new(@_);
    $this->write;
    return $this;
}

1;

__END__