File Coverage

blib/lib/Text/Yats.pm

Criterion	Covered	Total	%
statement	74	74	100.0
branch	21	22	95.4
condition	4	6	66.6
subroutine	9	9	100.0
pod	4	7	57.1
total	112	118	94.9

#
# Yats.pm
# Last Modification: 2002/01/07 ([e-mail])
#
# Copyright (c) 2001 Henrique Dias. All rights reserved.
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
#

package Text::Yats;

require 5;
use strict;

require Exporter;
use vars qw($VERSION @ISA @EXPORT);
@ISA = qw(Exporter DynaLoader);
$VERSION = '0.03';

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = {
		section => [],
		level   => 0,
		file    => "",
		text    => "",
		base    => '\\d+',
		pattern => '\\d+',
		@_,
	};
	bless ($self, $class);

	$self->{text} = &get_text($self->{'file'}) if($self->{file});
	my $sections = ($self->{level} > 0) ? $self->wrapper() : [];
	if($#{$sections} > 0) {
		$self->{level}--;
		$self->{pattern} .= '\\.' . $self->{base};
		for(0 .. $#{$sections}) {
			$self->{section}->[$_] = $self->new(
				'level'   => $self->{level},
				'pattern' => $self->{pattern},
				'text'    => $sections->[$_]);
		}
	}
	return($self);
}

sub section { $_[0]->{'section'}; }

sub replace {
	my $self = shift;
	my $param = {@_};

	my $text = "";
	my $max = 0;
	my $i = 0;
	my $pattern = '\$(\w+) *).)+)\)-->';
	LOOP: while(1) {
		my $tmp = $self->{text};
		while($tmp =~ s/$pattern/\$$1/o) {
			$self->{text} = $tmp;
			$param->{$1} = [eval($2)];
		}
		for(keys(%{$param})) {
			$param->{$_} = &make_array($param->{$param->{$_}->{array}},$param->{$_}->{match},$param->{$_}->{value})
				if(ref($param->{$_}) eq "HASH");
			if(ref($param->{$_}) eq "ARRAY") {
				my $maxtmp = $#{$param->{$_}};
				$max = $maxtmp unless($maxtmp <= $max);
				if(($i <= $maxtmp) && ($param->{$_}->[$i] ne "")) { $tmp =~ s/\$$_\b/$param->{$_}->[$i]/g; }
				else { $tmp =~ s/ ?\$$_\b//g; }
			} else { $tmp =~ s/\$$_\b/$param->{$_}/g; }
		}
		$text .= $tmp;
		last LOOP if($i == $max);
		$i++;
	}
	return($text);
}

sub make_array {
	my ($array, $match, $value) = @_;

	my @matched = ();
	$#matched = $#{$array};
	my %keys = ();
	if(ref($match) eq "ARRAY") { @keys{@{$match}} = (); }
	else { $keys{$match} = ""; }
	for my $j (0 .. $#{$array}) {
		$matched[$j] = (exists($keys{$array->[$j]})) ? $value : "";
	}
	return(\@matched);
}

sub text {
	my $self = shift;
	return($self->{text});
}

sub wrapper {
	my $self = shift;
	my $pattern = '\n*';
	my $re = qr/$pattern/;
	my @sections = split(/$re/, $self->{text});
	return(\@sections);
}

sub get_text {
	my $filename = shift;

	local $/ = undef;
	local *FILE;
	open (FILE, "<$filename") || die "Can't open $filename: $!\n";
	my $text = ;
	close(FILE);
	return($text);
}

1;
__END__