File Coverage

blib/lib/HTML/ERuby.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package HTML::ERuby;
# $Id: ERuby.pm,v 1.5 2002/04/14 01:04:49 ikechin Exp $
use strict;
use vars qw($VERSION $ERUBY_TAG_RE);
use IO::File;
use Carp ();
use Inline::Ruby qw(rb_eval);
use Data::Dumper;

$ERUBY_TAG_RE = qr/(<%%|%%>|<%=|<%#|<%|%>|\n)/so;
$VERSION = '0.02';

sub new {
    my $class = shift;
    my $self = bless {
    }, $class;
    $self;
}

sub compile {
    my ($self, %args) = @_;
    my $data;
    if ($args{filename}) {
	$data = $self->_open_file($args{filename});
    }
    elsif ($args{scalarref}) {
	$data = ${$args{scalarref}};
    }
    elsif ($args{arrayref}) {
	$data = join('', @{$args{arrayref}});
    }
    else {
	Carp::croak("please specify ERuby document");
    }
    my $vars = '';
    if ($args{vars}) {
	$vars = $self->_convert_vars($args{vars});
    }
    my $src = $self->_parse(\$data);
    return rb_eval($vars. $src);
}

sub _open_file {
    my ($self, $filename) = @_;
    local $/ = undef;
    my $f = IO::File->new($filename, "r") or Carp::croak("can not open eruby file: $filename");
    my $data = $f->getline;
    $f->close;
    return $data;
}

sub _convert_vars {
    my ($self, $vars) = @_;
    my $code = '';
    local $Data::Dumper::Deepcopy = 1;
    while(my ($name, $value) = each %$vars) {
	if (my $type = ref($value)) {
	    Carp::croak(__PACKAGE__. " supports String, Hash and Array only")
		    if $type ne 'ARRAY' && $type ne 'HASH';
	}
	my $dumped = Dumper $value;
	$dumped =~ s/\$VAR1 =//; # strip Data::Dumper '$VAR1 =' string.
	$code .= "$name = $dumped\n";
    }
    return $code;
}

# copy from erb/compile.rb and Perlize :)
sub _parse {
    my($self, $scalarref) = @_;
    my $src = q/_erb_out = '';/;
    my @text = split($ERUBY_TAG_RE, $$scalarref);
    my @content = ();
    my @cmd = ("_erb_out = ''\n");
    my $stag = '';
    my $token = '';
    for my $token(@text) {
	if ($token eq '<%%') {
	    push @content, '<%';
	    next;
	}
	if ($token eq '%%>') {
	    push @content, '%>';
	    next;
	}
	unless ($stag) {
	    if ($token eq '<%' || $token eq '<%=' || $token eq '<%#') {
		$stag = $token;
		my $str = join('', @content);
		if ($str) {
		    push @cmd, qq/_erb_out.concat '$str';/;
		}
		@content = ();
	    }
	    elsif($token eq "\n") {
		push @content, "\n";
		my $str = join('', @content);
		push @cmd, qq/_erb_out.concat '$str';/ if $str;
		@content = ();
	    }
	    else {
		push @content, $token;
	    }
	}
	else {
	    if ($token eq '%>') {
		my $str = join('', @content);
		if ($stag eq '<%') {
		    push @cmd, $str, "\n";
		}
		elsif ($stag eq '<%=') {
		    push @cmd, qq/_erb_out.concat( ($str).to_s );/;
		}
		elsif ($stag eq '<%#') {
		    # comment out SKIP!
		}
		@content = ();
		$stag = undef;
	    }
	    else {
		push @content, $token;
	    }
	}
    }
    if (@content) {
	my $str = join('', @content);
	push @cmd, qq/_erb_out.concat '$str';/;
    }
    push @cmd, '_erb_out;';
    return join('', @cmd);
}

1;

__END__