File Coverage

blib/lib/Parse/BBCode/Tag.pm

Criterion	Covered	Total	%
statement	62	72	86.1
branch	15	22	68.1
condition	9	14	64.2
subroutine	10	11	90.9
pod	4	4	100.0
total	100	123	81.3

package Parse::BBCode::Tag;
$Parse::BBCode::Tag::VERSION = '0.15_002'; # TRIAL

$Parse::BBCode::Tag::VERSION = '0.15002';use strict;
use warnings;
use Carp qw(croak carp);

use base 'Class::Accessor::Fast';
__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_accessors(qw/ id name attr attr_raw content
    finished start end close class single type in_url num level auto_closed /);

sub add_content {
    my ($self, $new) = @_;
    my $content = $self->get_content;
    if (ref $new) {
        push @$content, $new;
        return;
    }
    if (@$content and not ref $content->[-1]) {
        $content->[-1] .= $new;
    }
    else {
        push @$content, $new;
    }
}

sub raw_text {
    my ($self, %args) = @_;
    %args = (
        auto_close => 1,
        %args,
    );
    my $auto_close = $args{auto_close};
    my ($start, $end) = ($self->get_start, $self->get_end);
    if (not $auto_close and $self->get_auto_closed) {
        $end = '';
    }
    my $text = $start;
    $text .= $self->raw_content(%args);
    no warnings;
    $text .= $end;
    return $text;
}

sub _init_info {
    my ($self, $num, $level) = @_;
    $level ||= 0;
    my $name = $self->get_name;
    $num->{$name}++;
    $self->set_num($num->{$name});
    $self->set_level($level);
    my $content = $self->get_content || [];
    for my $c (@$content) {
        next unless ref $c;
        $c->_init_info($num, $level + 1);
    }
}

sub walk {
    my ($self, $type, $sub) = @_;
    $type ||= 'bfs';
    unless ($type eq 'bfs') {
        croak "walk(): $type '$type' not implemented";
    }
    my $result = $sub->($self);
    return if $result;
    my $content = $self->get_content || [];
    for my $c (@$content) {
        next unless ref $c;
        $c->walk($type, $sub);
    }
}

sub raw_content {
    my ($self, %args) = @_;
    my $content = $self->get_content;
    my $text = '';
    #warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$self], ['self']);
    for my $c (@$content) {
        if (ref $c eq ref $self) {
            $text .= $c->raw_text(%args);
        }
        else {
            $text .= $c;
        }
    }
    return $text;
}

sub _reduce {
    my ($self) = @_;
    if ($self->get_finished) {
        return $self;
    }
    my @text = $self->get_start;
    my $content = $self->get_content;
    for my $c (@$content) {
        if (ref $c eq ref $self) {
            push @text, $c->_reduce;
        }
        else {
            push @text, $c;
        }
    }
    push @text, $self->get_end if defined $self->get_end;
    return @text;
}


1;

__END__