view release on metacpan or  search on metacpan

Template.pm  view on Meta::CPAN

	    }
	}
	my $prev = $env->{$sym};
	if( $prev ){
	    ref($prev) eq "HCKit::Template::Rule" 
		|| die "$sym already defined";
	    if( $append ){
		if( @args ){
		    die "cannot specify args in appending rule";
		}
		$prev->append($val);
	    }
	    else{
		$env->{$sym} = HCKit::Template::Rule->new($val);
	    }
	}
	else{
	    $env->{$sym} = HCKit::Template::Rule->new($val);
	    if( @args ){
		$env->{$sym}->set_args(@args);
	    }
	}
    }
}

sub parse_data {
    my ($self, $data, $env) = @_;
    $data ||= "";
    while( $data =~ 
	   /<([\w-]+)>(.*?)<\/\1>|<\*(.*?)\*>|(<--.*?-->)/gs ){
	my ($sym, $body, $cmd, $comm) = ($1, $2, trim($3), $4);
	if( $comm ){ next }
	if( $sym ){
	    my $val = $self->parse_data_body($body, $env);
	    extend_data($sym, $val, $env);
	}
	else{
	    if( $cmd =~ /^\?(.*?)\?$/ ){
		my $instr = trim($1);
		if( $instr =~ /^include\s+(\S+)$/ ){
		    $self->_include_file($1, $env);
		    next;
		}
		die "invalid instruction $cmd";
	    }
	    $self->eval_var_raw($cmd, $env);
	}
    }
}

sub parse_data_body {
    my ($self, $body, $env) = @_;
    my %hash;
    my $text;
    my $last = 0;
    while( $body =~ 
	   /(<([\w-]+)>(.*?)<\/\2> |
	     <\*(.*?)\*> |
	     (<!\[\[CDATA\[.*\]\]>)
	     )/gsx ){
	my ($match, $sym, $val, $cmd, $cdata) = ($1,$2,$3,$4,$5);
	my $len = length($match);
	my $pre = substr($body, $last, pos($body)-$len-$last);
	$text .= $pre;
	$last = pos($body);
	if( $sym ){
	    my $sub = $self->parse_data_body($val, $env);
	    extend_data($sym, $sub, \%hash);
	}
	elsif( $cdata ){
	    $cdata =~ s/^<!\[\[CDATA\[//;
	    $cdata =~ s/\]\]>$//;
	    $text .= $cdata;
	}
	else{
	    my ($key, $aux) = 
		$cmd =~ /\s*([\w:.-]+)\s*(.*)/;
	    my $val = $self->eval_var($key, $aux, $env);
	    if( ref($val) eq "HASH" ){
		while( my ($sym, $sub) = each %$val ){
		    extend_data($sym, $sub, \%hash);
		}
	    }
	    else{ $text .= $val }
	}
    }
    if( $last < length($body) ){
	$text .= substr($body, $last);
    }
    return %hash ? \%hash : $text;
}

sub extend_data {
    my ($key, $val, $env) = @_;
    if( defined($env->{$key}) ){
	if( ref($env->{$key}) eq 'ARRAY' ){
	    push @{$env->{$key}}, $val;
	}
	else{
	    $env->{$key} = [$env->{$key}, $val];
	}
    }
    else{
	$env->{$key} = $val;
    }
}

sub rewrite {
    my ($self, $tmpl, $env) = @_;
    $tmpl = "" if !defined($tmpl);
    my $last = 0;
    my $output = "";
    while( $tmpl =~ 
	   /(
	     <\*\s*([\w:.-]+)\s*(.*?)\*> |
	     <\&\s*([\w:.-]+(?:@\w+)?)\s*(.*?)\&>(.*?)<\&\s*\/\4\s*\&> |
	     <\{\s*([\w:.-]+(?:@\w+)?)\s*(.*?)\}>(.*?)<\{\s*\/\7\s*\}>
	     )/gxs ){
	my ($match, $var, $varaux, $fun, $funaux, $funarg, 
	    $loop, $loopaux, $loopbody) = 
		($1,$2,$3,$4,$5,$6,$7,$8,$9);
	my $len = length($match);
	my $pre = substr($tmpl, $last, pos($tmpl)-$len-$last);
	$output .= $pre;
	$last = pos($tmpl);
	if( $var ){
	    $output .= $self->eval_var($var, $varaux, $env);
	}
	elsif( $fun ){
	    $fun =~ s/@.*//;
	    $output .= $self->eval_fun($fun, $funaux, $funarg, $env);
	}
	elsif( $loop ){