package Text::Xslate::Util; use strict; use warnings; use Carp (); use parent qw(Exporter); our @EXPORT_OK = qw( mark_raw unmark_raw html_escape escaped_string uri_escape p dump html_builder hash_with_default literal_to_value value_to_literal import_from neat is_int any_in read_around make_error $DEBUG $STRING $NUMBER ); our $DEBUG; defined($DEBUG) or $DEBUG = $ENV{XSLATE} || ''; our $DisplayWidth = 76; if($DEBUG =~ /display_width=(\d+)/) { $DisplayWidth = $1; } # cf. http://swtch.com/~rsc/regexp/regexp1.html my $dquoted = qr/" [^"\\]* (?: \\. [^"\\]* )* "/xms; my $squoted = qr/' [^'\\]* (?: \\. [^'\\]* )* '/xms; our $STRING = qr/(?: $dquoted | $squoted )/xms; our $NUMBER = qr/ (?: (?: [0-9][0-9_]* (?: \. [0-9_]+)? \b) # decimal | (?: 0 (?: (?: [0-7_]+ ) # octal | (?: x [0-9a-fA-F_]+) # hex | (?: b [01_]+ ) # binary )?) )/xms; require Text::Xslate; # load XS stuff sub mark_raw; # XS sub unmark_raw; # XS sub html_escape; # XS sub uri_escape; # XS sub escaped_string; *escaped_string = \&mark_raw; sub html_builder (&){ my($code_ref) = @_; return sub { my $ret = $code_ref->(@_); return ref($ret) eq 'CODE' ? html_builder(\&{$ret}) : mark_raw($ret); }; } sub hash_with_default { my($hash_ref, $default) = @_; ref($hash_ref) eq 'HASH' or Carp::croak('Usage: hash_with_default(\%vars, $default)'); require 'Text/Xslate/HashWithDefault.pm'; my %vars; tie %vars, 'Text::Xslate::HashWithDefault', $hash_ref, $default; return \%vars; } # for internals sub neat { my($s) = @_; if ( defined $s ) { if ( ref($s) || Scalar::Util::looks_like_number($s) ) { return $s; } else { return "'$s'"; } } else { return 'nil'; } } sub is_int { my($s) = @_; # XXX: '+1', '1.0', '00', must NOT be interpreted as an integer return defined($s) && $s =~ /\A -? [0-9]+ \z/xms && int($s) eq $s && abs(int($s)) < 0x7FFF_FFFF; # fits int32_t } sub any_in { my $value = shift; if(defined $value) { return scalar grep { defined($_) && $value eq $_ } @_; } else { return scalar grep { not defined($_) } @_; } } my %esc2char = ( 't' => "\t", 'n' => "\n", 'r' => "\r", ); sub literal_to_value { my($value) = @_; return $value if not defined $value; if($value =~ s/\A "(.*)" \z/$1/xms){ $value =~ s/\\(.)/$esc2char{$1} || $1/xmseg; } elsif($value =~ s/\A '(.*)' \z/$1/xms) { $value =~ s/\\(['\\])/$1/xmsg; # ' for poor editors } elsif($value =~ /\A [+-]? $NUMBER \z/xmso) { if($value =~ s/\A ([+-]?) (?= 0[0-7xb])//xms) { $value = ($1 eq '-' ? -1 : +1) * oct($value); # also grok hex and binary } else { $value =~ s/_//xmsg; } } return $value; } my %char2esc = ( "\\" => '\\\\', "\n" => '\\n', "\r" => '\\r', '"' => '\\"', '$' => '\\$', '@' => '\\@', ); my $value_chars = join '|', map { quotemeta } keys %char2esc; sub value_to_literal { my($value) = @_; return 'undef' if not defined $value; if(is_int($value)){ return $value; } else { $value =~ s/($value_chars)/$char2esc{$1}/xmsgeo; return qq{"$value"}; } } sub import_from { my $code = "# Text::Xslate::Util::import_from()\n" . "package " . "Text::Xslate::Util::_import;\n" . "use warnings FATAL => 'all';\n" . 'my @args;' . "\n"; for(my $i = 0; $i < @_; $i++) { my $module = $_[$i]; if($module =~ /[^a-zA-Z0-9_:]/) { Carp::confess("Xslate: Invalid module name: $module"); } my $commands; if(ref $_[$i+1]){ require 'Data/Dumper.pm'; my @args = ($_[++$i]); my @protos = ('*data'); $commands = Data::Dumper->new(\@args, \@protos)->Terse(1)->Dump(); } $code .= "use $module ();\n" if !$module->can('export_into_xslate'); if(!defined($commands) or $commands ne '') { $code .= sprintf <<'END_IMPORT', $module, $commands || '()'; @args = %2$s; %1$s->can('export_into_xslate') ? %1$s->export_into_xslate(\@funcs, @args) # bridge modules : %1$s->import(@args); # function-based modules END_IMPORT } } local $Text::Xslate::Util::{'_import::'}; #print STDERR $code; my @funcs; my $e = do { local $@; eval qq{package} . qq{ Text::Xslate::Util::_import;\n} . $code; $@; }; Carp::confess("Xslate: Failed to import:\n" . $e) if $e; push @funcs, map { my $entity_ref = \$Text::Xslate::Util::_import::{$_}; my $c; if(ref($entity_ref) eq 'GLOB') { # normal symbols $c = *{$entity_ref}{CODE}; } elsif(ref($entity_ref) eq 'REF') { # special constants no strict 'refs'; $c = \&{ 'Text::Xslate::Util::_import::' . $_ }; } defined($c) ? ($_ => $c) : (); } keys %Text::Xslate::Util::_import::; return {@funcs}; } sub make_error { my($self, $message, $file, $line, @extra) = @_; if(ref $message eq 'SCALAR') { # re-thrown form virtual machines return ${$message}; } my $lines = read_around($file, $line, 1, $self->input_layer); if($lines) { $lines .= "\n" if $lines !~ /\n\z/xms; $lines = '-' x $DisplayWidth . "\n" . $lines . '-' x $DisplayWidth . "\n"; } local $Carp::CarpLevel = $Carp::CarpLevel + 1; my $class = ref($self) || $self; $message =~ s/\A \Q$class: \E//xms and $message .= "\t..."; if(defined $file) { if(defined $line) { unshift @extra, $line; } unshift @extra, ref($file) ? '' : $file; } if(@extra) { $message = Carp::shortmess(sprintf '%s (%s)', $message, join(':', @extra)); } else { $message = Carp::shortmess($message); } return sprintf "%s: %s%s", $class, $message, $lines; } sub read_around { # for error messages my($file, $line, $around, $input_layer) = @_; defined($file) && defined($line) or return ''; $around = 1 if not defined $around; $input_layer = '' if not defined $input_layer; open my $in, '<' . $input_layer, $file or return ''; local $/ = "\n"; local $. = 0; my $s = ''; while(defined(my $l = <$in>)) { if($. >= ($line - $around)) { $s .= $l; } if($. >= ($line + $around)) { last; } } return $s; } sub p { # for debugging, the guts of dump() require 'Data/Dumper.pm'; # we don't want to create its namespace my $dd = Data::Dumper->new(\@_); $dd->Indent(1); $dd->Sortkeys(1); $dd->Quotekeys(0); $dd->Terse(1); return $dd->Dump() if defined wantarray; print $dd->Dump(); } sub dump :method { goto &p } 1; __END__ =head1 NAME Text::Xslate::Util - A set of utilities for Xslate =head1 SYNOPSIS use Text::Xslate::Util qw( mark_raw unmark_raw html_escape uri_escape p html_builder hash_with_default ); =head1 DESCRIPTION This module provides utilities for Xslate. =head1 INTERFACE =head2 Exportable functions =head3 C This is the entity of the C filter. =head3 C This is the entity of the C filter. =head3 C This is the entity of the C filter. =head3 C This is the entity of the C filter. =head3 C / C Displays the contents of I<$any> using C. This is the entity of the C filter, useful for debugging. =head3 C<< html_builder { block } | \&function :CodeRef >> Wraps a block or I<&function> with C so that the new subroutine will return a raw string. This function is the same as what Text::Xslate exports. =head3 C<< hash_with_default \%hash, $default :Any >> Set a default value I<$default> to I<%hash> and returns a HashRef. This is provided for debugging. =head1 SEE ALSO L =cut