Text-MicroMason-2.13/000755 002015 000024 00000000000 11513636117 014500 5ustar00alanstaff000000 000000 Text-MicroMason-2.13/t/000755 002015 000024 00000000000 11513636117 014743 5ustar00alanstaff000000 000000 Text-MicroMason-2.13/MicroMason/000755 002015 000024 00000000000 11513636117 016547 5ustar00alanstaff000000 000000 Text-MicroMason-2.13/samples/000755 002015 000024 00000000000 11513636117 016144 5ustar00alanstaff000000 000000 Text-MicroMason-2.13/MANIFEST000644 002015 000024 00000003673 11513636117 015642 0ustar00alanstaff000000 000000 Makefile.PL MANIFEST This list of files MANIFEST.SKIP MicroMason.pm MicroMason/AllowGlobals.pm MicroMason/ApacheHandler.pm MicroMason/Base.pm MicroMason/Cache/File.pm MicroMason/Cache/Null.pm MicroMason/Cache/Simple.pm MicroMason/CatchErrors.pm MicroMason/CompileCache.pm MicroMason/Debug.pm MicroMason/Docs/Changes.pod MicroMason/Docs/ReadMe.pod MicroMason/Docs/Related.pod MicroMason/Docs/ToDo.pod MicroMason/DoubleQuote.pm MicroMason/Embperl.pm MicroMason/ExecuteCache.pm MicroMason/Filters.pm MicroMason/Functions.pm MicroMason/HasParams.pm MicroMason/HTMLMason.pm MicroMason/HTMLTemplate.pm MicroMason/LineNumbers.pm MicroMason/ParseInfo.pm MicroMason/PassVariables.pm MicroMason/PLP.pm MicroMason/PostProcess.pm MicroMason/QuickTemplate.pm MicroMason/Safe.pm MicroMason/ServerPages.pm MicroMason/Sprintf.pm MicroMason/StoreOne.pm MicroMason/TemplateDir.pm MicroMason/TemplatePath.pm MicroMason/TextTemplate.pm samples/die.msn samples/hello_world.msp samples/if.tmpl samples/loop-context.tmpl samples/loop-simple.tmpl samples/simple.tmpl samples/subdir/test.msn samples/t-counter.msn samples/test-filter.msn samples/test-recur.msn samples/test-relative.msn samples/test.msn samples/uninitialized.msn t/00-startup.t t/01-syntax.t t/02-perl.t t/03-args.t t/04-blocks.t t/05-file.t t/06-masonobj.t t/07-class.t t/08-errors.t t/09-regression.t t/31-catch_errors.t t/32-safe.t t/33-filters.t t/34-compile_cache.t t/35-execute_cache.t t/36-template_dir.t t/37-post_process.t t/38-allow_globals.t t/39-debug.t t/40-pass_variables.t t/41-line_numbers.t t/51-server_pages.t t/52-text_template.t t/53-html_template.t t/54-embperl.t t/55-doublequote.t t/56-sprintf.t t/57-plp.t t/58-quicktemplate.t t/81-func-basics.t t/82-func-perl.t t/83-func-blocks.t t/84-func-errors.t t/85-func-file.t t/86-func-safe.t t/89-func-regression.t t/90-cache-dir-conflict.t t/91-template_path.t t/92-template_path-cache.t META.yml Module meta-data (added by MakeMaker) Text-MicroMason-2.13/MicroMason.pm000644 002015 000024 00000040703 11513636074 017113 0ustar00alanstaff000000 000000 package Text::MicroMason; $VERSION = '2.13'; # The #line directive requires Perl 5.6 to work correctly the way we use # it in Base. require 5.006; use strict; require Text::MicroMason::Base; ###################################################################### sub import { shift; return unless ( @_ ); require Exporter; require Text::MicroMason::Functions; unshift @_, 'Text::MicroMason::Functions'; goto &Exporter::import } ###################################################################### sub class { shift; Text::MicroMason::Base->class( @_, 'HTMLMason' ); } sub new { shift; Text::MicroMason::Base->new( @_, '-HTMLMason' ) } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason - Simple and Extensible Templating =head1 SYNOPSIS Mason syntax provides several ways to mix Perl into a text template: <%args> $name % if ( $name eq 'Dave' ) { I'm sorry <% $name %>, I'm afraid I can't do that right now. % } else { <%perl> my $hour = (localtime)[2]; my $daypart = ( $hour > 11 ) ? 'afternoon' : 'morning'; Good <% $daypart %>, <% $name %>! % } Create a MicroMason object to interpret the templates: use Text::MicroMason; $mason = Text::MicroMason->new(); Use the compile method to convert templates into a subroutines: $coderef = $mason->compile( text=>$template ); print $coderef->('name'=>'Alice'); Or use the execute method to parse and evalute in one call: print $mason->execute( text=>$template, 'name'=>'Bob' ); Templates stored in files can be run directly or included in others: print $mason->execute( file=>"./greeting.msn", 'name'=>'Charles'); For additional features, select mixin classes to add to your MicroMason object: $mason = Text::MicroMason->new( qw( -CatchErrors -Safe -Filters ) ); You can import various functions if you prefer to avoid method calls: use Text::MicroMason::Functions qw( compile execute ); print execute($template, 'name'=>'Dave'); $coderef = compile($template); print $coderef->('name'=>'Bob'); =head1 DESCRIPTION Text::MicroMason interpolates blocks of Perl code embedded into text strings. Each MicroMason object acts as a "template compiler," which converts templates from text-with-embedded-code formats into ready-to-execute Perl subroutines. =head2 MicroMason Initialization Use the new() method to create a Text::MicroMason object with the appropriate mixins and attributes. $mason = Text::MicroMason->new( %attribs ); You may pass attributes as key-value pairs to the new() method to save various options for later use by the compile() method. =head2 Template Compilation To compile a text template, pass it to the compile() method to produce a new Perl subroutine to be returned as a code reference: $code_ref = $mason->compile( $type => $source, %attribs ); Any attributes provided to compile() will temporarily override the persistent options defined by new(), for that template only. You can provide the template as a text string, a file name, or an open file handle: $code_ref = $mason->compile( text => $template ); $code_ref = $mason->compile( text => \$template ); $code_ref = $mason->compile( file => $filename ); $code_ref = $mason->compile( handle => $fh ); $code_ref = $mason->compile( handle => \*FILE ); Template files are just plain text files that contains the string to be parsed. The files may have any name and extension you wish. The filename specified can either be absolute or relative to the program's current directory. =head2 Template Execution To execute the template and obtain the output, call a compiled function: $result = $code_ref->( @arguments ); (Note that the $code_ref->() syntax is unavailable in older versions of Perl; use the equivalent &$code_ref() syntax instead.) As a shortcut, the execute method compiles and runs the template one time: $result = $mason->execute( $type => $source, @arguments ); $result = $mason->execute( $type => $source, \%attribs, @arguments ); =head2 Argument Passing You can pass arguments to a template subroutine using positional or named arguments. For positional arguments, pass the argument list and read from @_ as usual: $mason->compile( text=>'Hello <% shift(@_) %>.' )->( 'Dave' ); For named arguments, pass in a hash of key-value pairs to be made accessible in an C<%ARGS> hash within the template subroutine: $mason->compile( text=>'Hello <% $ARGS{name} %>.' )->( name=>'Dave' ); Additionally, you can use named arguments with the %args block syntax: $mason->compile( text=>'<%args>$nameHello <% $name %>.' )->( name=>'Dave' ); =head2 Mixin Selection Arguments passed to new() that begin with a dash will be added as mixin classes. $mason = Text::MicroMason->new( -Mixin1, %attribs, -Mixin2 ); Every MicroMason object inherits from an abstract Base class and some set of mixin classes. By combining mixins you can create subclasses with the desired combination of features. See L for documentation of the base class, including private methods and extension mechanisms. If you call the new method on Text::MicroMason, it automatically includes the HTMLMason mixin, which provides the standard template syntax. If you want to create an object without the default HTMLMason functionality, call Text::MicroMason::Base->new() instead. Some mixins define the syntax for a particular template format. You will generally need to select one, and only one, of the mixins listed in L. Other mixins provide optional functionality. Those mixins may define additional public methods, and may support or require values for various additional attributes. For a list of such mixin classes, see L. =head1 TEMPLATE SYNTAXES Templates contain a mix of literal text to be output with some type of markup syntax which specifies more complex behaviors. The Text::MicroMason::HTMLMason mixin is selected by default. To enable an alternative, pass its name to Text::MicroMason::Base->new( - MixinName ). =head2 HTMLMason The HTMLMason mixin provides lexer and assembler methods that handle most elements of HTML::Mason's template syntax. my $mason = Text::MicroMason::Base->new( -HTMLMason ); my $output = $mason->execute( text => $template, name => 'Bob' ); <%args> $name => 'Guest' % if ( $name eq 'Dave' ) { I'm sorry <% $name %>, I'm afraid I can't do that right now. % } else { <%perl> my $hour = (localtime)[2]; my $daypart = ( $hour > 11 ) ? 'afternoon' : 'morning'; Good <% $daypart %>, <% $name %>! % } <& "includes/standard_footer.msn" &> <%doc> Here's a private developr comment describing this template. For a definition of the template syntax, see L. =head2 DoubleQuote The DoubleQuote mixin uses Perl's double-quoting interpolation as a minimalist syntax for templating. my $mason = Text::MicroMason::Base->new( -DoubleQuote ); my $output = $mason->execute( text => $template, name => 'Bob' ); ${ $::hour = (localtime)[2]; $::daypart = ( $::hour > 11 ) ? 'afternoon' : 'morning'; \'' } Good $::daypart, $ARGS{name}! For more information see L. =head2 Embperl The Embperl mixin support a template syntax similar to that used by the HTML::Embperl module. my $mason = Text::MicroMason::Base->new( -Embperl ); my $output = $mason->execute( text => $template, name => 'Bob' ); [- my $name = $ARGS{name}; -] [$ if $name eq 'Dave' $] I'm sorry [+ $name +], I'm afraid I can't do that right now. [$ else $] [- my $hour = (localtime)[2]; my $daypart = ( $hour > 11 ) ? 'afternoon' : 'morning'; -] Good [+ $daypart +], [+ $name +]! [$ endif $] For more information see L. =head2 HTMLTemplate The HTMLTemplate mixin supports a syntax similar to that used by the HTML::Template module. my $mason = Text::MicroMason::Base->new( -HTMLTemplate ); my $output = $mason->execute( text => $template, name => 'Bob' ); I'm sorry , I'm afraid I can't do that right now. Good morning, ! Good afternoon, ! For more information see L. =head2 ServerPages The ServerPages mixin supports a syntax similar to that used by the Apache::ASP module. my $mason = Text::MicroMason::Base->new( -ServerPages ); my $output = $mason->execute( text => $template, name => 'Bob' ); <% my $name = $ARGS{name}; if ( $name eq 'Dave' ) { %> I'm sorry <%= $name %>, I'm afraid I can't do that right now. <% } else { my $hour = (localtime)[2]; my $daypart = ( $hour > 11 ) ? 'afternoon' : 'morning'; %> Good <%= $daypart %>, <%= $name %>! <% } %> For more information see L. =head2 Sprintf The Sprintf mixin uses Perl's sprintf formatting syntax for templating. my $mason = Text::MicroMason::Base->new( -Sprintf ); my $output = $mason->execute( text => $template, 'morning', 'Bob' ); Good %s, %s! For more information see L. =head2 TextTemplate The TextTemplate mixin supports a syntax similar to that used by the Text::Template module. my $mason = Text::MicroMason::Base->new( -TextTemplate ); my $output = $mason->execute( text => $template, name => 'Bob' ); { $hour = (localtime)[2]; $daypart = ( $hour > 11 ) ? 'afternoon' : 'morning'; '' } Good { $daypart }, { $name }! For more information see L. =head1 MIXIN FEATURES The following mixin classes can be layered on to your MicroMason object to provide additional functionality. To add a mixin's functionality, pass it's name with a dash to the new() method: $mason = Text::MicroMason->new( -CatchErrors, -PostProcess ); =head2 AllowGlobals Enables access to a set of package variables to be shared with templates. For details see L. =head2 CatchErrors Both compilation and run-time errors in your template are handled as fatal exceptions. To prevent a template error from ending your program, enclose it in an eval block: my $result = eval { $mason->execute( text => $template ) }; if ( $@ ) { print "Unable to execute template: $@"; } else { print $result; } To transparently add this functionality to your MicroMason object, see L. =head2 CompileCache Calling execute repeatedly will be slower than compiling once and calling the template function repeatedly, unless you enable compilation caching. For details see L. =head2 Debug When trying to debug a template problem, it can be helpful to watch the internal processes of template compilation. This mixin adds controllable warning messages that show the intermediate parse information. For details see L. =head2 LineNumbers Provide better line numbers when compilation fails, at the cost of potentially slower compilation and execution. For details see L. =head2 ExecuteCache Each time you execute the template all of the logic will be re- evaluated, unless you enable execution caching, which stores the output of each template for each given set of arguments. For details see L. =head2 Filters HTML::Mason provides an expression filtering mechanism which is typically used for applying HTML and URL escaping functions to output. Text::MicroMason->new(-Filters)->compile( text => $template );

Hello <% $name |h %>! The Filters mixin provides this capability for Text::MicroMason templates. To select it, add its name to your Mason initialization call: my $mason = Text::MicroMason->new( -Filters ); Output expressions may then be followed by "|h" or "|u" escapes; for example this line would convert any ampersands in the output to the equivalent HTML entity: Welcome to <% $company_name |h %> For more information see L. =head2 PassVariables Allows you to pass arguments to templates as variables instead of the basic argument list. For details see L. =head2 PostProcess Allows you to specify one or more functions through which all template output should be passed before it is returned. For details see L. =head2 Safe By default, the code embedded in a template has accss to all of the capabilities of your Perl process, and could potentially perform dangerous activities such as accessing or modifying files and starting other programs. If you need to execute untrusted templates, use the Safe module, which can restrict the operations and data structures that template code can access. To add this functionality to your MicroMason object, see L. =head2 TemplateDir The filenames passed to the compile() or execute() methods can be looked up relative to a base directory path or the current template file. To add this functionality to your MicroMason object, see L. =head2 TemplatePath The filenames passed to the compile() or execute() methods are looked up relative to a list of multiple base directory paths, in order. It tries as hard as possible to maintain compatibility with caching and <& &> template includes. To add this functionality to your MicroMason object, see L. =head1 OTHER INTERFACES =head2 Function Exporter Importable functions are provided for users who prefer a procedural interface. The supported functions are listed in L. (For backwards compatibility, those functions can also be imported from the main Text::MicroMason package.) =head2 Template Frameworks Adaptor modules are available to use MicroMason from within other frameworks. For more information, see L and L. =head2 Inline MicroMason templates can be embbeded within your source code using Inline. For more information, see L. =head1 EXCEPTIONS Text::MicroMason croaks on error, with an appropriate error string. Some commonly occurring error messages are described below (where %s indicates variable message text). See also the pod for each mixin class, for additional exception strings that may be thrown. =over 4 =item * MicroMason parsing halted at %s Indicates that the parser was unable to finish tokenising the source text. Generally this means that there is a bug somewhere in the regular expressions used by lex(). (If you encounter this error, please feel free to file a bug report or send an example of the error to the author using the addresses below, and I'll attempt to correct it in a future release.) =item * MicroMason compilation failed: %s The template was parsed successfully, but the Perl subroutine declaration it was converted to failed to compile. This is generally a result of a syntax error in one of the Perl expressions used within the template. =item * Error in template subroutine: %s Additional diagnostic for compilation errors, showing the text of the subroutine which failed to compile. =item * Error in template file %s, interpreted as: %s Additional diagnostic for compilation errors in external files, showing the filename and the text of the subroutine which failed to compile. =item * MicroMason execution failed: %s After parsing and compiling the template successfully, the subroutine was run and caused a fatal exception, generally because that some Perl code used within the template caused die() to be called (or an equivalent function like croak or confess). =item * MicroMason: filename is missing or empty One of the compile or execute methods was called with an empty or undefined filename, or one of the compile_file or execute_file methods was called with no arguments. =item * MicroMason can't read from %s: %s One of the compile_file or execute_file functions was called but we were unable to read the requested file, because the file path is incorrect or we have insufficient priveleges to read that file. =back =head1 SEE ALSO For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MANIFEST.SKIP000644 002015 000024 00000000161 10732530655 016376 0ustar00alanstaff000000 000000 (^|/)\. ^MANIFEST\.bak ^Makefile$ ^Makefile\.old ^blib/ \.tar\.gz$ ^pm_to_blib cover_db blibdirs CVS Build.PL ~$ Text-MicroMason-2.13/Makefile.PL000644 002015 000024 00000003322 11513635576 016462 0ustar00alanstaff000000 000000 # $Id: Makefile.PL,v 1.8 2010/09/07 20:25:48 alan Exp $ use ExtUtils::MakeMaker; ######################################################################## WriteMakefile( NAME => 'Text::MicroMason', VERSION_FROM => 'MicroMason.pm', PREREQ_PM => { 'Class::MixinFactory' => 0.9, 'File::Spec' => 0.9, 'Cwd' => 2.21, 'Test::More' => 0.48, 'Safe' => 0, }, MIN_PERL_VERSION => 5.006, ABSTRACT_FROM => 'MicroMason.pm', AUTHOR => 'Alan Ferrency ', LICENSE => 'perl', ); ######################################################################## sub MY::postamble { q{ fresh: realclean FORCE perl Makefile.PL again: realclean FORCE perl Makefile.PL; make pm_to_blib cleanmanifest: realclean FORCE touch MANIFEST ; rm MANIFEST ; perl Makefile.PL; touch MANIFEST; make manifest %.t: pm_to_blib FORCE make; perl -Iblib/lib $@ cover: FORCE cover -delete; HARNESS_PERL_SWITCHES=-MDevel::Cover make test; cover docs : README CHANGES TODO README: MicroMason/Docs/ReadMe.pod pod2text MicroMason/Docs/ReadMe.pod > README CHANGES: MicroMason/Docs/Changes.pod pod2text MicroMason/Docs/Changes.pod > CHANGES TODO: MicroMason/Docs/ToDo.pod pod2text MicroMason/Docs/ToDo.pod > TODO }; } #### # Notes, building a distribution # # Update version in: MicroMason.pm, MicroMason/Docs/ReadMe.pod # Update pod in: MicroMason/Docs/Changes.pod # # perl Makefile.PL # make docs # make cleanmanifest # make disttest # make dist # Text-MicroMason-2.13/META.yml000644 002015 000024 00000001315 11513636117 015751 0ustar00alanstaff000000 000000 --- #YAML:1.0 name: Text-MicroMason version: 2.13 abstract: Simple and Extensible Templating author: - Alan Ferrency license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Class::MixinFactory: 0.9 Cwd: 2.21 File::Spec: 0.9 perl: 5.006 Safe: 0 Test::More: 0.48 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.5601 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Text-MicroMason-2.13/samples/test-relative.msn000644 002015 000024 00000000100 10557447465 021457 0ustar00alanstaff000000 000000 Test greeting: <& 'test.msn', hour => 15, name => $ARGS{name} &>Text-MicroMason-2.13/samples/t-counter.msn000644 002015 000024 00000000137 10557447465 020621 0ustar00alanstaff000000 000000 <%once> ++ $::sub_count; my $count; <%perl> ++ $::local_count; <% ++ $count; %>Text-MicroMason-2.13/samples/test-recur.msn000644 002015 000024 00000000135 10557447465 020774 0ustar00alanstaff000000 000000 % # Begin mason file Test greeting: <& 'samples/test.msn', hour => 15, name => $ARGS{name} &>Text-MicroMason-2.13/samples/if.tmpl000644 002015 000024 00000000160 10557447465 017452 0ustar00alanstaff000000 000000 This is a line outside the if. INSIDE the if unless Text-MicroMason-2.13/samples/loop-context.tmpl000644 002015 000024 00000000253 10557447465 021512 0ustar00alanstaff000000 000000 Simple Template I am a simple loop template. Text-MicroMason-2.13/samples/simple.tmpl000644 002015 000024 00000000206 10557447465 020346 0ustar00alanstaff000000 000000 Simple Template IIII am a simple template. Text-MicroMason-2.13/samples/die.msn000644 002015 000024 00000000030 10557447465 017432 0ustar00alanstaff000000 000000 Hello <% die('Foo!') %>!Text-MicroMason-2.13/samples/uninitialized.msn000644 002015 000024 00000000213 11356441167 021533 0ustar00alanstaff000000 000000 % my $x; Hello Mr. <% $x %>! % # another line % sub stuff { 1 } % do { stuff() }; % my %h; Hello, <% $h{not_defined} %>! And, then end. Text-MicroMason-2.13/samples/loop-simple.tmpl000644 002015 000024 00000000253 10557447465 021317 0ustar00alanstaff000000 000000 Simple Template I am a simple loop template. Text-MicroMason-2.13/samples/test.msn000644 002015 000024 00000000174 10557447465 017661 0ustar00alanstaff000000 000000 <%perl> my $greeting = ( $ARGS{hour} > 11 ) ? 'afternoon' : 'morning'; Good <% $greeting %>, <% $ARGS{name} %>! Text-MicroMason-2.13/samples/hello_world.msp000644 002015 000024 00000000071 10557447465 021212 0ustar00alanstaff000000 000000 <% my $noun = 'World'; %>Hello <%= $noun %>! How are ya? Text-MicroMason-2.13/samples/subdir/000755 002015 000024 00000000000 11513636117 017434 5ustar00alanstaff000000 000000 Text-MicroMason-2.13/samples/test-filter.msn000644 002015 000024 00000000022 10737007135 021116 0ustar00alanstaff000000 000000 <% $ARGS{msg}|u %>Text-MicroMason-2.13/samples/subdir/test.msn000644 002015 000024 00000000170 10557452503 021132 0ustar00alanstaff000000 000000 <%perl> my $greeting = ( $ARGS{hour} > 11 ) ? 'Tag' : 'Morgen'; Guten <% $greeting %>, <% $ARGS{name} %>! Text-MicroMason-2.13/MicroMason/PostProcess.pm000644 002015 000024 00000006470 10557447465 021415 0ustar00alanstaff000000 000000 package Text::MicroMason::PostProcess; use strict; use Carp; ###################################################################### sub assembler_rules { my $self = shift; my %rules = $self->NEXT('assembler_rules', @_); $rules{return_output} = "\$m->post_process( $rules{return_output} )"; %rules; } sub post_processors { my $self = shift; my $funcs = $self->{post_process}; my @funcs = ref($funcs) eq 'ARRAY' ? @$funcs : $funcs ? $funcs : (); if ( scalar @_ ) { @funcs = ( $#_ == 0 and ref($_[0]) eq 'ARRAY' ) ? @{ $_[0] } : (@funcs, @_); $self->{post_process} = [ @funcs ]; } return @funcs; } sub post_process { my $self = shift; local $_ = shift; foreach my $func ( $self->post_processors ) { my $p = prototype($func); if ( defined $p and ! length $p ) { &$func; } else { $_ = &$func( $_ ); } } $_; } ###################################################################### 1; __END__ =head1 NAME Text::MicroMason::PostProcess - Apply Filters to All Template Output =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason->new( -PostProcess ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( text=>$template )->( @%args ); print $mason->execute( text=>$template, @args ); You can define output filters at creation or subsequently: $mason = Text::MicroMason->new( -PostProcess, post_process => $func ); $mason->post_processors( $func ); $mason->compile( text => $template, post_process => $func ); $mason->execute( text => $template, { post_process => $func }, @args ); =head1 DESCRIPTION This mixin class adds filtering of all template output to any MicroMason class. Filter functions can accept the string to be output and return a filtered version: $mason->post_process( sub { my $foo = shift; $foo =~ s/a-Z/A-Z/; return $foo; } ); If a filter function has an empty prototype, it's assumed to work on $_: $mason->post_process( sub () { s/a-Z/A-Z/ } ); =head2 Public Methods =over 4 =item post_processors() Gets and sets the functions to be used for output filtering. Called with no arguments, returns the list of filter functions: my @functions = $mason->post_processors(); Called with one array-ref argument, sets the list of filter functions: $mason->post_processors( \@functions ); Called with one or more function-ref arguments, appends to the list: $mason->post_processors( $filter1, $filter2 ); =back =head2 Supported Attributes =over 4 =item post_process Stores a reference to a function or an array of functions to be used: $mason->{post_process} = $function; $mason->{post_process} = [ $function1, $function2 ]; You can set this attribute when you create your mason object, or in calls to the compile and execute methods. =back =head2 Private Methods =over 4 =item post_process() $mason->post_process( $output ) : $filtered_output Applies the post-processing filter. =back =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/PLP.pm000644 002015 000024 00000010671 10733010714 017535 0ustar00alanstaff000000 000000 package Text::MicroMason::PLP; use strict; use Carp; use Safe; ###################################################################### sub lex_token { # Blocks in <: ... :> tags. /\G \< \: (\=)? ( .*? ) \: \> /gcxs ? ( ($1 ? 'expr' : 'perl') => $2 ) : # Blocks in <( ... )> tags. /\G \< \( ( .*? ) \) \> /gcxs ? ( 'include' => $1 ) : # Things that don't match the above /\G ( (?: [^\<]+ | \<(?![\:\(]) )? ) /gcxs ? ( 'text' => $1 ) : # Lexer error () } # $perl_code = $mason->assemble( @tokens ); sub assemble { my $self = shift; my @tokens = @_; for ( my $position = 0; $position <= int( $#tokens / 2 ); $position ++ ) { if ( $tokens[$position * 2] eq 'include' ) { my $token = $tokens[$position * 2 + 1]; splice @tokens, $position * 2, 2, $self->lex( $self->read_file( $token ) ) } } $self->NEXT('assemble', @tokens ); } ###################################################################### package Text::MicroMason::Commands; # Trick PAUSE into indexing us properly: this package used to be in # MicroMason.pm, so it gained version 1.07 on PAUSE, and the new ones # won't be reindexed unless they have a greater version. our $VERSION = "1.9"; use vars qw( $m ); sub include { $m->execute( file => @_ ) } sub Include { $m->execute( file => @_ ) } sub ReadFile { $m->read_file( @_ ) } sub Entity { eval { require HTML::Entities; no strict; *Entity = \&HTML::Entities::encode } ? goto &HTML::Entities::encode : die "Can't load HTML::Entities"; } sub EncodeURI { eval { require URI::Escape; no strict; *Entity = \&URI::Escape::uri_escape } ? goto &URI::Escape::uri_escape : die "Can't load HTML::Entities"; } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::PLP - Alternate Syntax like PLP Templates =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason::Base->new( -PLP ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( text=>$template )->( @%args ); print $mason->execute( text=>$template, @args ); The PLP syntax provides another way to mix Perl into a text template: <: my $name = $ARGS{name}; if ( $name eq 'Dave' ) { :> I'm sorry <:= $name :>, I'm afraid I can't do that right now. <: } else { my $hour = (localtime)[2]; my $daypart = ( $hour > 11 ) ? 'afternoon' : 'morning'; :> Good <:= $daypart :>, <:= $name :>! <: } :> =head1 DESCRIPTION This subclass replaces MicroMason's normal lexer with one that supports a syntax similar to that provided by the PLP module. =head2 Compatibility with PLP PLP is a web-oriented system with many fatures, of which only the templating functionality is emulated. This is not a drop-in replacement for PLP, as the implementation is quite different, but it should be able to process some existing templates without major changes. The following features of EmbPerl syntax are supported: =over 4 =item * Basic markup tags =back The following syntax features of are B supported: =over 4 =item * Emulation of functions defined in PLP::Functions is incomplete. =item * Web server interface with tied =back =head2 Template Syntax The following elements are recognized by the PLP lexer: =over 4 =item * E: perl statements :E Arbitrary Perl code to be executed at this point in the template. =item * E:= perl expression :E A Perl expression to be evaluated and included in the output. =item * E( file, arguments )E Includes an external template file. =back =head2 Private Methods =over 4 =item lex_token ( $type, $value ) = $mason->lex_token(); Lexer for <: ... :> and <( ... )> tags. Attempts to parse a token from the template text stored in the global $_ and returns a token type and value. Returns an empty list if unable to parse further due to an error. =item assemble Performs compile-time file includes for any include tokens found by lex_token. =back =cut =head1 SEE ALSO The interface being emulated is described in L. For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/LineNumbers.pm000644 002015 000024 00000011744 11276617164 021346 0ustar00alanstaff000000 000000 package Text::MicroMason::LineNumbers; use strict; ###################################################################### sub read { my ( $self, $src_type, $src_data ) = @_; $self->{ last_read_file } = "unrecognized source $src_type"; $self->{ last_read_line } = 1; $self->NEXT( 'read', $src_type, $src_data ) } sub read_file { my ( $self, $file ) = @_; $self->{ last_read_file } = $file; $self->NEXT( 'read_file', $file ) } sub read_handle { my ( $self, $handle ) = @_; my ( $caller_file, $caller_line ) = $self->_get_external_caller(); $self->{ last_read_file } = "file handle template (compiled at $caller_file line $caller_line)"; $self->NEXT( 'read_handle', $handle ) } sub read_text { my ( $self, $text ) = @_; my ( $caller_file, $caller_line ) = $self->_get_external_caller(); $self->{ last_read_file } = "text template (compiled at $caller_file line $caller_line)"; $self->NEXT( 'read_text', $text ) } sub read_inline { my ( $self, $text ) = @_; my ( $caller_file, $caller_line ) = $self->_get_external_caller(); $self->{ last_read_file } = $caller_file; $self->{ last_read_line } = $caller_line; $self->NEXT( 'read_text', $text ) } sub _get_external_caller { my ( $self ) = @_; my ( @caller, $call_level ); do { @caller = caller( ++ $call_level ) } while ( $caller[0] =~ /^Text::MicroMason/ or $self->isa($caller[0]) ); return ( $caller[1] || $0, $caller[2] ); } ###################################################################### sub lex { my $self = shift; local $_ = "$_[0]"; my $lexer = $self->can('lex_token') or $self->croak_msg('Unable to lex_token(); must select a syntax mixin'); my $filename = $self->{ last_read_file } || 'unknown source'; my $linenum = $self->{ last_read_line } || 1; my $last_pos = 0; my @tokens; until ( /\G\z/gc ) { my @parsed = &$lexer( $self ) or /\G ( .{0,20} ) /gcxs && die "MicroMason parsing halted at '$1'\n"; push @tokens, 'line_num' => ( $linenum - 1 ) . qq{ "$filename"}; push @tokens, @parsed; # Update the current line number by counting newlines in the text # we've parsed since the last time through the loop. my $new_pos = pos($_) || 0; $linenum += ( substr($_, $last_pos, $new_pos - $last_pos) =~ tr[\n][] ); $last_pos = $new_pos; } return @tokens; } sub assembler_rules { my $self = shift; ( $self->NEXT('assembler_rules', @_), line_num_token => 'perl # line TOKEN', ) } ###################################################################### 1; ###################################################################### =head1 NAME Text::MicroMason::LineNumbers - Report errors at correct source code line numbers =head1 DESCRIPTION This mixin class associates each token in a template with the line number on which it was found, and then inserts special comments in the generated Perl code that preserve that original source file and line number information. This should facilitate debugging, by making it easier to match up run- time errors with the template code that produced them. To turn this behavior on, just add "-LineNumbers" to your MicroMason creation call: my $mason = Text::MicroMason->new( qw( -LineNumbers ) ); =head2 Public Methods These methods are called from within the normal flow of MicroMason functionality, and you do not need to invoke them directly. =over 4 =item read() Clears the variables used to store the file name and first line of a template, so that they can be set by the methods below. =item read_file() Saves the source file name before invoking the standard behavior for this method. $mason->compile( file => $filename ); =item read_handle() Saves the caller's file name before invoking the standard behavior for this method. $mason->compile( handle => $filename ); =item read_text() Saves the caller's file name before invoking the standard behavior for this method. $mason->compile( text => $filename ); =item read_inline() This is similar to read_text, except it adjusts the line numbering to reflect a template that's embdded as a literal text in the Perl code. $mason->compile( inline => q{ My template text goes here. } ); =item lex() Identical to the lex() method provided by the Base class, except that it also inserts a stream of line-number-setting comments into the to-be- compiled Perl code that attempt to re-synchronize the =item assembler_rules() Maps the "line_num" token to a perl line number comment. =back =head2 Private Methods =over 4 =item _get_external_caller() Returns the source file and line number of the first item in the function call stack that is not a Text::MicroMason package. =back =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/HTMLTemplate.pm000644 002015 000024 00000022017 10557447465 021364 0ustar00alanstaff000000 000000 package Text::MicroMason::HTMLTemplate; require Text::MicroMason::Base; require Text::MicroMason::TemplateDir; require Text::MicroMason::StoreOne; require Text::MicroMason::HasParams; push @ISA, map "Text::MicroMason::$_", qw( TemplateDir StoreOne HasParams ); use strict; ###################################################################### my %param_mapping = ( ### <<== INCOMPLETE ### global_vars => 'loop_global_vars', cache => '-CompileCache', path => '-TemplatePaths', ); ###################################################################### sub output { (shift)->execute_again( @_ ) } ###################################################################### my $prefix_re = '[tT][mM][pP][lL]_'; sub lex_token { # warn " Lexer: " . pos($_) . " of " . length($_) . "\n"; # Tags in format "", "", or "" /\G \<(\/?)($prefix_re\w+)\s*(.*?)\> /gcxs ? ( ( $1 ? "tmpl_end" : lc($2) ) => { $_[0]->parse_args($3) } ) : # Things that don't match the above /\G ( (?: [^<] | <(?!\/?$prefix_re) )+ ) /gcxs ? ( 'text' => $1 ) : # Lexer error () } sub parse_args { my $self = shift; my $args = "$_[0]"; return () unless length($args); return ( name => $args ) unless ( $args =~ /=/ ); my @tokens; until ( $args =~ /\G\z/gc ) { push ( @tokens, $args =~ /\G \s* (\w+) \= (?: \"([^\"]+)\" | ( \w+ ) ) (?= \s | \z ) /gcxs ? ( lc($1) => ( defined($2) ? $2 : $3 ) ) : $args =~ /\G ( .{0,20} ) /gcxs && die "Couldn't find applicable parsing rule at '$1'\n" ); } @tokens; } ###################################################################### sub assemble_tmpl_var { my ($self, $args) = @_; my $output = "\$m->param( '$args->{name}' )"; if ( defined $args->{default} ) { $output = "local \$_ = $output; defined ? \$_ : '$args->{default}'" } if ( $args->{escape} ) { $output = "\$m->filter( $output, '$args->{escape}' )" } expr => "$output;" } sub assemble_tmpl_include { my ($self, $args) = @_; file => $args->{name} } sub assemble_tmpl_loop { my ($self, $args) = @_; if ( ! $self->{loop_context_vars} ) { perl => q/foreach my $args ( $m->param( '/ . $args->{name} . q/' ) ) { local $m->{params} = [ $args, $m->{loop_global_vars} ? @{$m->{params}} : () ];/ } else { perl => q/my @loop = $m->param( '/ . $args->{name} . q/' ); foreach my $count ( 0 .. $#loop ) { my $args = $loop[ $count ]; my %loop_context = ( __counter__ => $count, __odd__ => ( $count % 2 ), __first__ => ( $count == 0 ), __inner__ => ( $count > 0 and $count < $#loop ), __last__ => ( $count == $#loop ), ); local $m->{params} = [ $args, \%loop_context, $m->{loop_global_vars} ? @{$m->{params}} : () ]; / } } sub assemble_tmpl_if { my ($self, $args) = @_; perl => q/if ( $m->param( '/ . $args->{name} . q/' ) ) { / } sub assemble_tmpl_unless { my ($self, $args) = @_; perl => q/if ( ! $m->param( '/ . $args->{name} . q/' ) ) { / } sub assemble_tmpl_else { perl => "} else {" } sub assemble_tmpl_end { perl => "}" } ###################################################################### use vars qw( %Filters ); sub defaults { (shift)->NEXT('defaults'), filters => \%Filters, } # Output filtering $Filters{1} = $Filters{html} = \&HTML::Entities::encode if eval { require HTML::Entities}; $Filters{url} = \&URI::Escape::uri_escape if eval { require URI::Escape }; # $result = $mason->filter( @filters, $content ); sub filter { my $self = shift; my $content = pop; foreach my $filter ( @_ ) { my $function = ( ref $filter eq 'CODE' ) ? $filter : $self->{filters}{ $filter } || $self->croak_msg("No definition for a filter named '$filter'" ); $content = &$function($content) } $content } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::HTMLTemplate - Alternate Syntax like HTML::Template =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason::Base->new( -HTMLTemplate ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( text=>$template )->( @%args ); print $mason->execute( text=>$template, @args ); Or use HTML::Template's calling conventions: $template = Text::MicroMason->new( -HTMLTemplate, filename=>'simple.tmpl' ); $template->param( %arguments ); print $template->output(); HTML::Template provides a syntax to embed values into a text template: I'm sorry , I'm afraid I can't do that right now. Good morning, ! Good afternoon, ! =head1 DESCRIPTION This mixin class overrides several methods to allow MicroMason to emulate the template syntax and some of the other features of HTML::Template. This class automatically includes the following other mixins: TemplateDir, HasParams, and StoreOne. =head2 Compatibility with HTML::Template This is not a drop-in replacement for HTML::Template, as the implementation is quite different, but it should be able to process most existing templates without major changes. This should allow current HTML::Template users to take advantage of MicroMason's one-time compilation feature, which in theory could be faster than HTML::Template's run-time interpretation. (No benchmarking yet.) The following features of HTML::Template are not supported yet: =over 4 =item * Search path for files. (Candidate for separate mixin class or addition to TemplateDir.) =item * Many HTML::Template options are either unsupported or have different names and need to be mapped to equivalent sets of attributes. (Transform these in the new() method or croak if they're unsupported.) =back The following features of HTML::Template will likely never be supported due to fundamental differences in implementation: =over 4 =item * query() method =back Contributed patches to more closely support the behavior of HTML::Template would be welcomed by the author. =head2 Template Syntax The following elements are recognized by the HTMLTemplate lexer: =over 4 =item * I Anything not specifically parsed by the below rule is interpreted as literal text. =item * ETMPL_IE A template tag with no attributes. =item * ETMPL_I IE A template tag with a name attribute. =item * ETMPL_I NAME=I I

We've Got Items!

% my $draw_item = sub {

<% $_[0] %>:
See more about <% $_[0] %>.

% }; <%perl> foreach my $item ( qw( Foo Bar Baz ) ) { $draw_item->( $item ); } =head2 Returning Text from Perl Blocks To append to the result from within Perl code, call $_out->(I). (The $_out->() syntax is unavailable in older versions of Perl; use the equivalent &$_out() syntax instead.) For example, the below template text will return '123456789' when it is evaluated: <%perl> foreach my $digit ( 1 .. 9 ) { $_out->( $digit ) } You can also directly manipulate the value @OUT, which contains the accumulating result. For example, the below template text will return an altered version of its message if a true value for 'minor' is passed as an argument when the template is executed: This is a funny joke. % if ( $ARGS{minor} ) { foreach ( @OUT ) { tr[a-z][n-za-m] } } =head1 SEE ALSO For a full-featured web application system using this template syntax, see L. For an overview of this distribution, see L. This is a subclass intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Cache/000755 002015 000024 00000000000 11513636117 017552 5ustar00alanstaff000000 000000 Text-MicroMason-2.13/MicroMason/Sprintf.pm000644 002015 000024 00000003127 10557447465 020552 0ustar00alanstaff000000 000000 package Text::MicroMason::Sprintf; use strict; ###################################################################### # ( $type, $value ) = $mason->lex_token(); sub lex_token { / (.*) /xcogs ? ( expr => do { my $x = $1; $x =~ s/\|/\\|/g; "sprintf(qq|$x|, \@_)" } ) : () } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::Sprintf - Formatted Interpolation Engine =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason::Base->new( -Sprintf ); Templates can be written using Perl's sprintf interpolation syntax: $coderef = $mason->compile( text => 'Hello %s' ); print $coderef->( 'World' ); =head1 DESCRIPTION Text::MicroMason::Sprintf uses Perl's sprintf formatting syntax for templating. Of course you don't need this module for simple cases of interpolation, but if you're already using the MicroMason framework to process template files from disk, this module should allow you to make your simplest templates run even faster. Perl's sprintf function supports traditional Unix-style sprintf() formatting as well as a number of very useful extensions. Consult L for more details. =head1 SEE ALSO For an overview of this distribution, see L. This is a subclass intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Base.pm000644 002015 000024 00000044771 11325361524 017772 0ustar00alanstaff000000 000000 package Text::MicroMason::Base; use strict; require Carp; ###################################################################### ###################################################################### use Class::MixinFactory -hasafactory; for my $factory ( (__PACKAGE__)->mixin_factory ) { $factory->base_class( "Text::MicroMason::Base" ); $factory->mixin_prefix( "Text::MicroMason" ); } ###################################################################### ###################################################################### sub new { my $callee = shift; my ( @traits, @attribs ); while ( scalar @_ ) { if ( $_[0] =~ /^\-(\w+)$/ ) { push @traits, $1; shift; } else { push @attribs, splice(@_, 0, 2); } } if ( scalar @traits ) { die("Adding moxins to an existing class not supported yet!") unless ( $callee eq __PACKAGE__ ); $callee->class( @traits )->create( @attribs ) } else { $callee->create( @attribs ) } } ###################################################################### # $mason = $class->create( %options ); # $clone = $object->create( %options ); sub create { my $referent = shift; if ( ! ref $referent ) { bless { $referent->defaults(), @_ }, $referent; } else { bless { $referent->defaults(), %$referent, @_ }, ref $referent; } } sub defaults { return () } ###################################################################### ###################################################################### # $code_ref = $mason->compile( text => $template, %options ); # $code_ref = $mason->compile( file => $filename, %options ); # $code_ref = $mason->compile( handle => $filehandle, %options ); sub compile { my ( $self, $src_type, $src_data, %options ) = @_; ($self, $src_type, $src_data) = $self->prepare($src_type, $src_data,%options); my $code = $self->interpret( $src_type, $src_data ); $self->eval_sub( $code ) or $self->croak_msg( "MicroMason compilation failed: $@\n". _number_lines($code)."\n" ); } # Internal helper to number the lines in the compiled template when compilation croaks sub _number_lines { my $code = shift; my $n = 0; return join("\n", map { sprintf("%4d %s", $n++, $_) } split(/\n/, $code)). "\n** Please use Text::MicroMason->new\(-LineNumbers\) for better diagnostics!"; } ###################################################################### # $result = $mason->execute( code => $subref, @arguments ); # $result = $mason->execute( $src_type, $src_data, @arguments ); # $result = $mason->execute( $src_type, $src_data, \%options, @arguments ); sub execute { my $self = shift; my $sub = ( $_[0] eq 'code' ) ? do { shift; shift } : $self->compile( shift, shift, ref($_[0]) ? %{ shift() } : () ) or $self->croak_msg("MicroMason compilation failed: $@"); &$sub( @_ ); } ###################################################################### ###################################################################### # ($self, $src_type, $src_data) = $self->prepare($src_type, $src_data, %options) sub prepare { my ( $self, $src_type, $src_data, %options ) = @_; $self = $self->create( %options ) if ( scalar keys %options ); return ( $self, $src_type, $src_data ); } ###################################################################### # $perl_code = $mason->interpret( $src_type, $src_data ); sub interpret { my ( $self, $src_type, $src_data ) = @_; my $template = $self->read( $src_type, $src_data ); my @tokens = $self->lex( $template ); my $code = $self->assemble( @tokens ); # Source file and line number my $source_line = $self->source_file_line_label( $src_type, $src_data ); return $source_line . "\n" . $code; } # $line_number_comment = $mason->source_file_line_label( $src_type, $src_data ); sub source_file_line_label { my ( $self, $src_type, $src_data ) = @_; if ( $src_type eq 'file' ) { return qq(# line 1 "$src_data"); } my @caller; my $call_level; do { @caller = caller( ++ $call_level ) } while ( $caller[0] =~ /^Text::MicroMason/ or $self->isa($caller[0]) ); my $package = ( $caller[1] || $0 ); qq{# line 1 "text template (compiled at $package line $caller[2])"} } ###################################################################### # $code_ref = $mason->eval_sub( $perl_code ); sub eval_sub { my $m = shift; package Text::MicroMason::Commands; eval( shift ) } ###################################################################### ###################################################################### # $template = $mason->read( $src_type, $src_data ); sub read { my ( $self, $src_type, $src_data ) = @_; my $src_method = "read_$src_type"; $self->can($src_method) or $self->croak_msg("Unsupported source type '$src_type'"); $self->$src_method( $src_data ); } # $template = $mason->read_text( $template ); sub read_text { ref($_[1]) ? $$_[1] : $_[1]; } # $contents = $mason->read_file( $filename ); sub read_file { my ( $self, $file ) = @_; local *FILE; open FILE, "$file" or $self->croak_msg("MicroMason can't open $file: $!"); local $/ = undef; local $_ = ; close FILE or $self->croak_msg("MicroMason can't close $file: $!");; return $_; } # $contents = $mason->read_handle( $filehandle ); sub read_handle { my ( $self, $handle ) = @_; my $fh = (ref $handle eq 'GLOB') ? $handle : $$handle; local $/ = undef; <$fh> } ###################################################################### # @token_pairs = $mason->lex( $template ); sub lex { my $self = shift; local $_ = "$_[0]"; my @tokens; my $lexer = $self->can('lex_token') or $self->croak_msg('Unable to lex_token(); must select a syntax mixin'); # warn "Lexing: " . pos($_) . " of " . length($_) . "\n"; until ( /\G\z/gc ) { my @parsed = &$lexer( $self ) or /\G ( .{0,20} ) /gcxs && die "MicroMason parsing halted at '$1'\n"; push @tokens, @parsed; } return @tokens; } # ( $type, $value ) = $mason->lex_token(); sub lex_token { die "The lex_token() method is abstract and must be provided by a subclass"; } ###################################################################### ###################################################################### # Text elements used for subroutine assembly sub assembler_rules { template => [ qw( $sub_start $init_errs $init_output $init_args @perl $return_output $sub_end ) ], # Subroutine scafolding sub_start => 'sub { ', sub_end => '}', init_errs => 'local $SIG{__DIE__} = sub { die "MicroMason execution failed: ", @_ };', # Argument processing elements init_args => 'my %ARGS = @_ if ($#_ % 2);', # Output generation init_output => sub { my $m = shift; my $sub = $m->{output_sub} ? '$m->{output_sub}' : 'sub {push @OUT, @_}'; 'my @OUT; my $_out = ' . $sub . ';' }, add_output => sub { my $m = shift; $m->{output_sub} ? '&$_out' : 'push @OUT,' }, return_output => 'join("", @OUT)', # Mapping between token types text_token => 'perl OUT( QUOTED );', expr_token => "perl OUT( \"\".do{\nTOKEN\n} );", # the "". here forces string context, and should hopefully make # 'uninitialized' warnings appear closer to their source, rather # than at the big join "", @OUT; at the end file_token => "perl OUT( \$m->execute( file => do {\nTOKEN\n} ) );", # Note that we need newline after TOKEN here in case it ends with a comment. } sub assembler_vars { my $self = shift; my %assembler = $self->assembler_rules(); my @assembly = @{ delete $assembler{ template } }; my %token_map = map { ( /^(.*?)_token$/ )[0] => delete $assembler{$_} } grep { /_token$/ } keys %assembler; my %fragments = map { $_ => map { ref($_) ? &{$_}( $self ) : $_ } $assembler{$_} } keys %assembler; return( \@assembly, \%fragments, \%token_map ); } # $perl_code = $mason->assemble( @tokens ); sub assemble { my $self = shift; my @tokens = @_; my ( $order, $fragments, $token_map ) = $self->assembler_vars(); my %token_streams = map { $_ => [] } map { ( /^\W?\@(\w+)$/ ) } @$order; while ( scalar @tokens ) { my ( $type, $token ) = splice( @tokens, 0, 2 ); unless ( $token_streams{$type} or $token_map->{$type} ) { my $method = "assemble_$type"; my $sub = $self->can( $method ) or $self->croak_msg( "Unexpected token type '$type': '$token'" ); ($type, $token) = &$sub( $self, $token ); } if ( my $typedef = $token_map->{ $type } ) { # Perform token map substitution in a single pass so that uses of # OUT in the token text are not improperly converted to output calls. # -- Simon, 2009-11-14 my %substitution_map = ( 'OUT' => $fragments->{add_output}, 'TOKEN' => $token, 'QUOTED' => "qq(\Q$token\E)", ); $typedef =~ s/\b(OUT|TOKEN|QUOTED)\b/$substitution_map{$1}/g; ( $type, $token ) = split ' ', $typedef, 2; } my $ary = $token_streams{$type} or $self->croak_msg( "Unexpected token type '$type': '$token'" ); push @$ary, $token } join( "\n", map { /^(\W+)(\w+)$/ or $self->croak_msg("Can't assemble $_"); if ( $1 eq '$' ) { $fragments->{ $2 } } elsif ( $1 eq '@' ) { @{ $token_streams{ $2 } } } elsif ( $1 eq '!@' ) { reverse @{ $token_streams{ $2 } } } elsif ( $1 eq '-@' ) { () } else { $self->croak_msg("Can't assemble $_"); } } @$order ); } ###################################################################### ###################################################################### sub croak_msg { local $Carp::CarpLevel = 2; shift and Carp::croak( ( @_ == 1 ) ? $_[0] : join(' ', map _printable(), @_) ) } my %Escape = ( ( map { chr($_), unpack('H2', chr($_)) } (0..255) ), "\\"=>'\\', "\r"=>'r', "\n"=>'n', "\t"=>'t', "\""=>'"' ); # $special_characters_escaped = _printable( $source_string ); sub _printable { local $_ = scalar(@_) ? (shift) : $_; return "(undef)" unless defined; s/([\r\n\t\"\\\x00-\x1f\x7F-\xFF])/\\$Escape{$1}/sgo; /[^\w\d\-\:\.\']/ ? "q($_)" : $_; } ###################################################################### sub cache_key { my $self = shift; my ($src_type, $src_data, %options) = @_; return $src_data; } 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::Base - Abstract Template Compiler =head1 SYNOPSIS Create a MicroMason object to interpret the templates: use Text::MicroMason; my $mason = Text::MicroMason->new(); Use the execute method to parse and evalute a template: print $mason->execute( text=>$template, 'name'=>'Dave' ); Or compile it into a subroutine, and evaluate repeatedly: $coderef = $mason->compile( text=>$template ); print $coderef->('name'=>'Dave'); print $coderef->('name'=>'Bob'); Templates stored in files can be run directly or included in others: print $mason->execute( file=>"./greeting.msn", 'name'=>'Charles'); =head1 DESCRIPTION Text::MicroMason::Base is an abstract superclass that provides a parser and execution environment for an extensible templating system. =head2 Public Methods =over 4 =item new() $mason = Text::MicroMason::Base->new( -Mixin1, -Mixin2, %attribs ); Creates a new Text::MicroMason object with mixins and attributes. Arguments beginning with a dash will be added as mixin classes. Other arguments are added to the hash of attributes. =item compile() $code_ref = $mason->compile( text => $template, %options ); $code_ref = $mason->compile( file => $filename, %options ); Parses the provided template and converts it into a new Perl subroutine. =item execute() $result = $mason->execute( text => $template, @arguments ); $result = $mason->execute( file => $filename, @arguments ); $result = $mason->execute( code => $code_ref, @arguments ); $result = $mason->execute( $type => $source, \%options, @arguments ); Returns the results produced by the template, given the provided arguments. =back =head2 Attributes Attributes can be set in a call to new() and locally overridden in a call to compile(). =over 4 =item output_sub Optional reference to a subroutine to call with each piece of template output. If this is enabled, template subroutines will return an empty string. =back =head2 Private Methods The following internal methods are used to implement the public interface described above, and may be overridden by subclasses and mixins. =over 4 =item class() $class = Text::MicroMason::Base->class( @Mixins ); Creates a subclass of this package that also inherits from the other classes named. Provided by Class::MixinFactory::HasAFactory. =item create() $mason = $class->create( %options ); $clone = $mason->create( %options ); Creates a new instance with the provided key value pairs. To obtain the functionality of one of the supported mixin classes, use the class method to generate the mixed class before calling create(), as is done by new(). =item defaults() This class method is called by new() to provide key-value pairs to be included in the new instance. =item prepare() ($self, $src_type, $src_data) = $self->prepare($src_type, $src_data, %options) Called by compile(), the prepare method allows for single-use attributes and provides a hook for mixin functionality. The prepare method provides a hook for mixins to normalize or resolve the template source type and value arguments in various ways before the template is read using one of the read_type() methods. It returns an object reference that may be a clone of the original mason object with various compile-time attributes applied. The cloning is a shallow copy performed by the create() method. This means that the $m object visible to a template may not be the same as the MicroMason object on which compile() was originally called. Please note that this clone-on-prepare behavior is subject to change in future releases. =item interpret $perl_code = $mason->interpret( $src_type, $src_data ); Called by compile(), the interpret method then calls the read(), lex(), and assemble() methods. =item read $template = $mason->read( $src_type, $src_data ); Called by interpret(). Calls one of the below read_* methods. =item read_text $template = $mason->read_text( $template ); Called by read() when the template source type is "text", this method simply returns the value of the text string passed to it. =item read_file ( $contents, %path_info ) = $mason->read_file( $filename ); Called by read() when the template source type is "file", this method reads and returns the contents of the named file. =item read_handle $template = $mason->read_handle( $filehandle ); Called by read() when the template source type is "handle", this method reads and returns the contents of the filehandle passed to it. =item lex @token_pairs = $mason->lex( $template ); Called by interpret(). Parses the source text and returns a list of pairs of token types and values. Loops through repeated calls to lex_token(). =item lex_token ( $type, $value ) = $mason->lex_token(); Attempts to parse a token from the template text stored in the global $_ and returns a token type and value. Returns an empty list if unable to parse further due to an error. Abstract method; must be implemented by subclasses. =item assemble $perl_code = $mason->assemble( @tokens ); Called by interpret(). Assembles the parsed token series into the source code for the equivalent Perl subroutine. =item assembler_rules() Returns a hash of text elements used for Perl subroutine assembly. Used by assemble(). The assembly template defines the types of blocks supported and the order they appear in, as well as where other standard elements should go. Those other elements also appear in the assembler hash. =item eval_sub $code_ref = $mason->eval_sub( $perl_code ); Called by compile(). Compiles the Perl source code for a template using eval(), and returns a code reference. =item croak_msg Called when a fatal exception has occurred. =item NEXT Enhanced superclass method dispatch for use inside mixin class methods. Allows mixin classes to redispatch to other classes in the inheritance tree without themselves inheriting from anything. Provided by Class::MixinFactory::NEXT. =back =head2 Private Functions =over 4 =item _printable $special_characters_escaped = _printable( $source_string ); Converts non-printable characters to readable form using the standard backslash notation, such as "\n" for newline. =back =head1 EXTENDING You can add functionality to this module by creating subclasses or mixin classes. To create a subclass, just inherit from the base class or some dynamically-assembled class. To create your own mixin classes which can be combined with other mixin features, examine the operation of the class() and NEXT() methods. Key areas for subclass writers are: =over 4 =item prepare You can intercept and re-write template source arguments by overriding this method. =item read_* You can support a new template source type by creating a method with a corresponding name prefixed by "read_". It is passed the template source value and should return the raw text to be lexed. For example, if a subclass defined a method named read_from_db, callers could compile templates by calling C<-Ecompile( from_db =E 'welcome-page' )>. =item lex_token Replace this to parse a new template syntax. Is receives the text to be parsed in $_ and should match from the current position to return the next token type and its contents. =item assembler_rules The assembler data structure is used to construct the Perl subroutine for a parsed template. =item assemble_* You can support a new token type be creating a method with a corresponding name prefixed by "assemble_". It is passed the token value or contents, and should return a new token pair that is supported by the assembler template. For example, if a subclass defined a method named assemble_sqlquery, callers could compile templates that contained a C%sqlqueryE ... E/%sqlqueryE> block. The assemble_sqlquery method could return a C<< perl => $statements >> pair with Perl code that performed some appropriate action. =item compile You can wrap or cache the results of this method, which is the primary public interface. =item execute You typically should not depend on overriding this method because callers can invoke the compiled subroutines directly without calling execute. =back =head1 SEE ALSO For an overview of this templating framework, see L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/QuickTemplate.pm000644 002015 000024 00000006142 10557447465 021675 0ustar00alanstaff000000 000000 package Text::MicroMason::QuickTemplate; require Text::MicroMason::Base; require Text::MicroMason::StoreOne; require Text::MicroMason::HasParams; push @ISA, map "Text::MicroMason::$_", qw( StoreOne HasParams ); require Exporter; $DONTSET = \""; sub import { @EXPORT = '$DONTSET'; goto &Exporter::import } ###################################################################### sub defaults { (shift)->NEXT('defaults'), delimiters => [ '{{', '}}' ], } ###################################################################### sub lex_token { my $self = shift; my ($l_delim, $r_delim) = @{ $self->{'delimiters'} }; /\G \Q$l_delim\E (.*?) \Q$r_delim\E/gcxs ? ( expr => 'my @param = $m->param(' . "'\Q$1\E'" . '); scalar @param or die "could not resolve the following symbol: ' . $1 . '"; ( $param[0] eq "' . $DONTSET . '" ) ? "{{' . $1 . '}}" : $param[0]' ) : # Things that don't match the above /\G ( (?: [^\{] | \{(?!\{) )+ ) /gcxs ? ( 'text' => $1 ) : () } ###################################################################### sub fill { (shift)->execute_again( @_ ) } sub pre_fill { unshift @{ (shift)->{params} }, { @_ } } sub clear_values { @{ (shift)->{params} } = () } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::QuickTemplate - Alternate Syntax like Text::QuickTemplate =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason::Base->new( -QuickTemplate ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( text=>$template )->( @%args ); print $mason->execute( text=>$template, @args ); Or use Text::QuickTemplate's calling conventions: $template = Text::MicroMason->new( -HTMLTemplate, text=>'simple.tmpl' ); print $template->fill( %arguments ); Text::QuickTemplate provides a syntax to embed values into a text template: Good {{timeofday}}, {{name}}! =head1 DESCRIPTION This mixin class overrides several methods to allow MicroMason to emulate the template syntax and some of the other features of Text::QuickTemplate. This class automatically includes the following other mixins: TemplateDir, HasParams, and StoreOne. =head2 Compatibility with Text::QuickTemplate This is not a drop-in replacement for Text::QuickTemplate, as the implementation is quite different, but it should be able to process most existing templates without major changes. The following features of EmbPerl syntax are supported: =over 4 =item * Curly bracketed tags with parameter names. =item * Array of parameters hashes. =item * Special $DONTSET variable. =back =head1 SEE ALSO The interface being emulated is described in L. For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/ParseInfo.pm000644 002015 000024 00000003232 10557447465 021010 0ustar00alanstaff000000 000000 package Text::MicroMason::ParseInfo; use strict; use Carp; ###################################################################### # Each time we compile a new template, make sure we create a private clone of # the MicroMason object and store some local information in a "parse_info" hash. # ($self, $src_type, $src_data) = $self->prepare($src_type, $src_data, %options) sub prepare { my $self = shift; $self->NEXT('prepare', @_, parse_info => {}) } ###################################################################### # When compiling a template, we first lex() the source code into tokens, then # we assemble() it into a Perl subroutine. Mixins can hook into this sequence # to fiddle around with the template while it's still in a "chunked" format. # In this case we just store information about tokens in our private hash. # $perl_code = $mason->assemble( @tokens ); sub assemble { my $self = shift; my @tokens = @_; my $parse_info = ( $self->{parse_info} ||= {} ); for ( my $position = 0; $position <= $#tokens; $position += 2 ) { my ( $token_type, $token_value ) = @tokens[$position, $position + 1]; if ( $token_type eq 'args' ) { while ( $token_value =~ /^\s*([\$\@\%])(\w+)(?:\s*=>\s*([^\r\n]+))?/g ) { push $parse_info->{'args'}->{ "$1$2" } = $3 } } elsif ( $token_type eq 'file' ) { push @{ $parse_info->{'file'} }, $token_value; } elsif ( $token_type eq 'doc' ) { push @{ $parse_info->{'doc'} }, $token_value; } } $self->NEXT('assemble', @tokens ); } ###################################################################### 1; ###################################################################### Text-MicroMason-2.13/MicroMason/PassVariables.pm000644 002015 000024 00000007522 11344277460 021656 0ustar00alanstaff000000 000000 package Text::MicroMason::PassVariables; use strict; ###################################################################### my $seqno = 0; sub prepare { my $self = shift; $self->NEXT('prepare', @_, ( $self->{package} ? () : ( package => __PACKAGE__ . '::GEN' . $seqno++ ) ) ) } ###################################################################### # Text elements used for subroutine assembly sub assembler_rules { my %rules = ((shift)->NEXT('assembler_rules', @_), eval_start => 'package __PACKAGE__;', no_strict => 'no strict;', init_args => 'local %__PACKAGE__:: = %__PACKAGE__::;' . "\n" . 'my %ARGS = @_;' . "\n" . '$m->install_args_hash( "__PACKAGE__", \%ARGS );', ); $rules{template} = ['$eval_start', '$no_strict', @{$rules{template}}]; return %rules; } sub assemble { my $self = shift; my $code = $self->NEXT('assemble', @_); my $package = $self->{package} || 'Text::MicroMason::Commands'; $code =~ s/(\S)__PACKAGE__/$1$package/g; $code =~ s/__PACKAGE__(\S)/$package$1/g; return $code; } ###################################################################### # $mason->install_args_hash( $package, $hash_ref ) sub install_args_hash { my ($self, $dest, $hash) = @_; foreach my $name (keys %$hash) { my $val = $hash->{$name}; my $sym = $dest . "::" . $name; no strict 'refs'; # This code is cloned from Text::Template local *SYM = *{$sym}; if (! defined $val) { delete ${"${dest}::"}{$name}; } elsif (ref $val) { *SYM = $val; } else { *SYM = \$val; } } } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::PassVariables - Pass template data as variables =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason->new( -PassVariables ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( text=>$template )->( 'name'=>'Dave' ); print $mason->execute( text=>$template, 'name'=>'Dave' ); Templates can now access their arguments as global variables: Welcome, <% $name %>! =head1 DESCRIPTION Like Text::Template, this package passes in template arguments as package variables. For example, if you pass in an argument list of C 23>, it will set the variable $foo in the package your template is compiled in. This allows template code to refer to $name rather than $ARGS{name}. The strict pragma is disabled to facilitate these variable references. B Please note that this approach has some drawbacks, including the risk of clobbering global variables used for other purposes. It is included primarily to allow the TextTemplate module to emulate the behavior of Text::Template, and for quick-and-dirty simple templates where succinctness is more important than robustness. =head2 Supported Attributes =over 4 =item package Target package namespace. Defaults to Text::MicroMason::Commands. =back =head2 Private Methods =over 4 =item assembler_rules() Adds Perl fragments to handle package and symbol table munging. =item assemble() Modifies Perl subroutine to embed the target package namespace. =item install_args_hash() Performs symbol table munging to transfer the contents of an arguments hash into variables in a target namespace. =back =head1 SEE ALSO The interface being emulated is described in L. For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/ApacheHandler.pm000644 002015 000024 00000006731 10557447465 021610 0ustar00alanstaff000000 000000 package Text::MicroMason::ApacheHandler; use Apache::Constants; use Apache::Request; use Text::MicroMason::Base; ###################################################################### my %configs; sub handler ($$) { my ($package, $r) = @_; my $apache = Apache::Request->instance( $r ); my $file = $apache->filename; # $apache->document_root; my $syntax = $apache->dir_config('MicroMasonSyntax') || 'HTMLMason'; my @mixins = $apache->dir_config->get('MicroMasonMixins'); my @attrs = $apache->dir_config->get('MicroMasonAttribs'); my %seen; unshift @attrs, ( map "-$_", grep { ! $seen{$_} ++ } ( @mixins, $syntax ) ); my $config = join ' ', @attrs; my $mason = ( $configs{$config} ||= Text::MicroMason::Base->new( @attrs ) ); my $template = $mason->compile( file => $file ); $apache->content_type( 'text/html' ); # $apache->header_out(); local $Text::MicroMason::Commands::r = $apache; print $template->( $apache->param() ); return Apache::Constants::OK(); } sub configure { my $apache = Apache::Request->instance( shift ); my $file = $apache->filename; # $apache->document_root; my $syntax = $apache->dir_config('MicroMasonSyntax') || 'HTMLMason'; my @mixins = $apache->dir_config->get('MicroMasonMixins'); my @attrs = $apache->dir_config->get('MicroMasonAttribs'); my %seen; unshift @attrs, ( map "-$_", grep { ! $seen{$_} ++ } ( @mixins, $syntax ) ); my $config = join ' ', @attrs; my $mason = ( $configs{$config} ||= Text::MicroMason::Base->new( @attrs ) ); } ###################################################################### sub translate_params { MasonAllowGlobals => [ -AllowGlobals, allow_globals => \$1 ], MasonCompRoot => [ -TemplateDir, template_root => \$1 ], } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::ApacheHandler - Use MicroMason from mod_perl =head1 SYNOPSIS In your httpd.conf or equivalent Apache configuration file: PerlModule Text::MicroMason::ApacheHandler SetHandler perl-script PerlHandler Text::MicroMason::ApacheHandler In your document root or other web-accessible directory: <% my $visitor = $r->connection->remote_host(); %> Hello there <%= $visitor %>! The time is now <%= localtime() %>. =head1 DESCRIPTION B This module is new, experimental, and incomplete. Not intended for production use. Interface subject to change. If you're interested in this capability, your feedback would be appreciated. =head2 Configuration The following configuration parameters are supported: =over 4 =item MicroMasonSyntax PerlSetVar MicroMasonSyntax HTMLMason Name of the syntax class that will compile the templates. Defaults to HTMLMason. =item MicroMasonMixins PerlAddVar MicroMasonMixins Safe PerlAddVar MicroMasonMixins CatchErrors List of additional mixin classes to be enabled. =item MicroMasonAttribs PerlAddVar MicroMasonAttribs "-AllowGlobals, allow_globals => '$r'" Allows for any set of attributes to be defined. Mixin names prefaced with a dash can also be included. =back =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Safe.pm000644 002015 000024 00000016620 11513635576 020000 0ustar00alanstaff000000 000000 package Text::MicroMason::Safe; use strict; use Carp; use Safe; ###################################################################### sub eval_sub { my ( $self, $code ) = @_; my $safe = $self->safe_compartment(); local $Text::MicroMason::Commands::m = $self->safe_facade(); $safe->share_from( 'Text::MicroMason::Commands' => [ '$m' ] ); $safe->reval( "my \$m = \$m; $code", 1 ) } # $self_or_safe = $mason->safe_compartment(); sub safe_compartment { my $self = shift; if ( ! $self->{safe} or $self->{safe} eq '1' ) { return Safe->new() } elsif ( UNIVERSAL::can( $self->{safe}, 'reval' ) ) { return $self->{safe} } else { $self->croak_msg("Inappropriate Safe compartment:", $self->{safe}); } } sub safe_facade { my $self = shift; our @CARP_NOT = qw(Text::MicroMason::Base); carp("* WARNING: safe_methods is deprecated; please see the pod") if $self->{safe_methods}; Text::MicroMason::Safe::Facade->new( map { my $method = $_; $_ => sub { $self->$method( @_ ) } } map { ! $_ ? () : ref($_) ? @$_ : split ' ' } $self->{safe_methods} ) } ###################################################################### package Text::MicroMason::Safe::Facade; sub new { my $class = shift; bless { @_ }, $class } sub facade_method { my ( $self, $method, @args ) = @_; my $sub = $self->{$method} or die "Can't call \$m->$method() in this compartment"; &$sub( @args ) } sub AUTOLOAD { my $sym = $Text::MicroMason::Safe::Facade::AUTOLOAD; my ($package, $func) = ($sym =~ /(.*)::([^:]+)$/); return unless ( $func =~ /^[a-z\_]+$/ ); no strict; my $sub = *{$func} = sub { (shift)->facade_method($func, @_ ) }; goto &$sub; } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::Safe - Compile all Templates in a Safe Compartment =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason->new( -Safe ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( text=>$template )->( @%args ); print $mason->execute( text=>$template, @args ); Safe usage restricts templates from accessing your files or data: print $mason->execute( text=>"<% qx! cat /etc/passwd ! %>" ); # dies print $mason->execute( text=>"The time is <% time() %>." ); # dies =head1 DESCRIPTION This package adds support for Safe compartments to MicroMason, allowing you to restrict the operations that a template can perform. By default, these safe calls prevent the code in a template from performing any system activity or accessing any of your other Perl code. Violations may result in either compile-time or run-time errors, so make sure you are using an eval block or the CatchErrors trait to catch exceptions. use Text::MicroMason; my $mason = Text::MicroMason->new( -Safe ); $result = eval { $mason->execute( text => $template ) }; B Although this appears to provide a significant amount of security for untrusted templates, please take this with a grain of salt. A bug in either this module or in the core Safe module could allow a clever attacker to defeat the protection. At least one bug in the Safe module has been found and fixed in years past, and there could be others. =head2 Supported Attributes =over 4 =item safe Optional reference to a Safe compartment. If you do not provide this, one is generated for you. To enable some operations or share variables or functions with the template code, create a Safe compartment and configure it before passing it in as the value of the "safe" attribute: $safe = Safe->new(); $safe->permit('time'); $safe->share('$foo'); $mason = Text::MicroMason->new( -Safe, safe => $safe ); $result = eval { $mason->execute( text => $template ) }; =item safe_methods B The C parameter is deprecated and will be removed in future versions of Text::MicroMason (unless a Safe and future-proof implementation can be found). If you use this parameter, you will receive a warning via carp: "* WARNING: safe_methods is deprecated; please see the pod" This parameter works correctly with sufficiently old versions of the Safe module (prior to the release of perl 5.12.1), but modern versions of Safe make it impossible for a Safe compartment to run any code outside the compartment. Even with the object shared within the Safe compartment, there is currently no known way to call methods on it without defining the whole class within the compartment (which isn't safe). If anyone has an appropriately safe solution that will allow C to work, please submit a patch to the module maintainer. Also see t/32-safe.t for tests related to C that are currently being skipped. The following pod is provided for legacy purposes only. It is strongly recommended that you do not use this method. It is no longer allowed to call methods from within a "Safe" template, because it isn't actually safe. A space-separated string of methods names to be supported by the Safe::Facade. To control which Mason methods are available within the template, pass a C argument to new() followed by the method names in a space-separated string. For example, to allow templates to include other templates, using $m->execute or the "<& file &>" include syntax, you would need to allow the execute method. We'll also load the TemplateDir mixin with strict_root on to prevent inclusion of templates from outside the current directory. # safe_methods is DEPRECATED, please see above $mason = Text::MicroMason->new( -Safe, safe_methods => 'execute', -TemplateDir, strict_root => 1 ); If you're combining this with the Filters mixin, you'll also need to allow calls to the filter method; to allow multiple methods, join their names with spaces: # safe_methods is DEPRECATED, please see above $mason = Text::MicroMason->new( -Safe, safe_methods => 'execute filter', -TemplateDir, strict_root => 1, -Filters ); =back =head2 Private Methods =over 4 =item eval_sub() Instead of the eval() used by the base class, this calls reval() on a Safe compartment. =item safe_compartment() Returns the Safe compartment passed by the user or generates a new one. =item safe_facade() Generates an instance of the Safe::Facade equipped with only the methods listed in the safe_methods attribute. =back =head2 Private Safe::Facade class Code compiled in a Safe compartment only has access to a limited version of the template compiler in the $m variable, and can not make changes to the attributes of the real MicroMason object. This limited object is an instance of the Text::MicroMason::Safe::Facade class and can only perform certain pre-defined methods. =over 4 =item new() Creates a new hash-based instance mapping method names to subroutine references. =item facade_method() Calls a named method by looking up the corresponding subroutine and calling it. =item AUTOLOAD() Generates wrapper methods that call the facade_method() for any lowercase method name. =back =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/HasParams.pm000644 002015 000024 00000005656 11513635576 021010 0ustar00alanstaff000000 000000 package Text::MicroMason::HasParams; ###################################################################### sub defaults { (shift)->NEXT('defaults'), params => [ {} ] } ###################################################################### sub assembler_rules { my $self = shift; $self->NEXT('assembler_rules', @_), init_args => 'local $m->{params} = [ ( @_ == 1 ) ? $_[0] : scalar(@_) ? { @_ } : (), $m->{params} ? @{$m->{params}} : () ];'; } ###################################################################### sub param { my $self = shift; my @params = $self->{params} ? @{$self->{params}} : (); if ( scalar @_ == 0 ) { return map( keys(%$_), @params ), $self->{associate} ? $self->{associate}->param() : () } elsif ( scalar @_ > 1 ) { if ( my $associate = $self->{associate} ) { return $associate->param( @_ ); } $self->{params} ||= [ {} ]; $self->{params}[0] ||= {}; my $target = $self->{params}[0]; if ( $self->{case_sensitive} ) { %$target = ( %$target, @_ ); } else { my %hash = @_; %$target = ( %$target, map { lc($_) => $hash{$_} } keys %hash ); # warn "set params $self->{params}[0]: " , %{ $self->{params}[0] }; } } elsif ( scalar @_ == 1 and ref( $_[0] ) ) { push @{$self->{params}}, shift(); } else { my $key = $self->{case_sensitive} ? shift : lc( shift ); # warn "get params $key: $#params\n"; foreach my $param ( @params ) { # warn "get params $param: $key\n"; my $case_key = ( exists $param->{ $key } ) ? $key : ( ! $self->{case_sensitive} ) ? ( grep { lc eq $key } keys %$param )[0] : undef; next unless defined $case_key; my $value = $param->{ $case_key }; # warn "get params $param: $key ($case_key) = $value\n"; return( ( ref($value) eq 'ARRAY' ) ? @$value : $value ) } if ( my $associate = $self->{associate} ) { my $case_key = ( $self->{case_sensitive} ) ? $key : ( grep { lc eq $key } $associate->param() )[0]; return $associate->param( $case_key ); } return; } } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::HasParams - mixin class intended for use with Text::MicroMason::Base =head1 DESCRIPTION This mixin class ... ' =head2 Public Methods =over 4 =item param() Gets and sets parameter arguments. Similar to the param() method provied by HTML::Template and the CGI module. =back =head2 Private Methods =over 4 =item assembler_rules() Adds initialization for param() at the beginning of each subroutine to be compiled. =back =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/CompileCache.pm000644 002015 000024 00000005474 10557452256 021442 0ustar00alanstaff000000 000000 package Text::MicroMason::CompileCache; use strict; use Carp; require Text::MicroMason::Cache::Simple; require Text::MicroMason::Cache::File; ###################################################################### # What cache class should we use for each src_type? my %CACHE_CLASS = ( file => 'Text::MicroMason::Cache::File', text => 'Text::MicroMason::Cache::Simple', ); ###################################################################### # $code_ref = compile( file => $filename ); sub compile { my $self = shift; my ( $src_type, $src_data, %options ) = @_; my $cache = $self->_compile_cache( $src_type ) or return $self->NEXT('compile', @_); my $key = $self->cache_key(@_); $cache->get( $key ) or $cache->set( $key, $self->NEXT('compile', @_), ); } sub _compile_cache { my ($self, $type) = @_; $CACHE_CLASS{$type} or return; $self->{compile_cache}{$type} ||= $CACHE_CLASS{$type}->new(); } ###################################################################### 1; __END__ =head1 NAME Text::MicroMason::CompileCache - Use a Cache for Template Compilation =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason->new( -CompileCache ); Use the standard compile and execute methods to parse and evalute templates: print $mason->execute( text=>$template, 'name'=>'Dave' ); The template does not have to be parsed the second time because it's cached: print $mason->execute( text=>$template, 'name'=>'Bob' ); Templates stored in files are also cached, until the file changes: print $mason->execute( file=>"./greeting.msn", 'name'=>'Charles'); =head1 DESCRIPTION =head2 Public Methods =over 4 =item compile() Caching wrapper around normal compile() behavior. =back =head2 Supported Attributes =over 4 =item compile_cache_text Defaults to an instance of Text::MicroMason::Cache::Simple. You may pass in your own cache object. =item compile_cache_file Defaults to an instance of Text::MicroMason::Cache::File. You may pass in your own cache object. =back This module uses a simple cache interface that is widely supported: the only methods required are C and C. You can use the simple cache classes provided in the Text::MicroMason::Cache:: namespace, or select other caching modules on CPAN that support the interface described in L. =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/TemplateDir.pm000644 002015 000024 00000011007 11276562361 021323 0ustar00alanstaff000000 000000 package Text::MicroMason::TemplateDir; use strict; use File::Spec; use Cwd; ###################################################################### sub prepare { my ( $self, $src_type, $src_data ) = @_; return $self->NEXT('prepare', $src_type, $src_data ) unless $src_type eq 'file'; my $path = $self->resolve_path($src_data); return $self->NEXT('prepare', 'file' => $path, source_file => $path ); } sub resolve_path { my ($self, $src_data) = @_; my $current = $self->{source_file}; my $rootdir = $self->template_root(); my $base = File::Spec->file_name_is_absolute($src_data) || ! $current ? $rootdir : ( File::Spec->splitpath( $current ) )[1]; return File::Spec->catfile( $base, $src_data ); } sub template_root { my $self = shift; return $self->{template_root} || '.' unless @_; $self->{template_root} = shift; } sub cache_key { my $self = shift; my ($src_type, $src_data, %options) = @_; return $self->NEXT('cache_key', @_) unless $src_type eq 'file'; return $self->resolve_path($src_data); } # $contents = $mason->read_file( $filename ); sub read_file { my ( $self, $file ) = @_; if ( my $root = $self->{strict_root} ) { $root = $self->template_root if $root eq '1'; my $path = Cwd::abs_path($file); my $root_path = Cwd::abs_path($root) or $self->croak_msg("Text::MicroMason::TemplateDir: Strict root '$root' doesn't seem to exist"); # warn "Checking for '$root_path' in '$path' (file $file)\n"; ( $path =~ /\A\Q$root_path\E/) or $self->croak_msg("Text::MicroMason::TemplateDir: Template '$path' not in required base path '$root_path'"); } return $self->NEXT('read_file', $file ); } ###################################################################### 1; ###################################################################### =head1 NAME Text::MicroMason::TemplateDir - Use Base Directory and Relative Paths =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason->new( -TemplateDir, template_root=>'/foo' ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( file=>$filepath )->( 'name'=>'Dave' ); print $mason->execute( file=>$filepath, 'name'=>'Dave' ); Templates stored in files are looked up relative to the template root: print $mason->execute( file=>"includes/greeting.msn", 'name'=>'Charles'); When including other files into a template you can use relative paths: <& ../includes/greeting.msn, name => 'Alice' &> =head1 DESCRIPTION This module changes the resolution of files passed to compile() and execute() to be relative to a base directory path or to the currently executing template. =head2 Supported Attributes =over 4 =item template_root Base directory from which to find templates. =item strict_root Optional directory beyond which not to read files. If set to 1, uses template_root, Causes read_file to croak if any filename outside of the root is provided. (Note that this is not a chroot jail and only affects attempts to load a file as a template; for greater security see the chroot() builtin and L.) =back =head2 Private Methods =over 4 =item prepare Intercepts uses of file templates and applies the base-path adjustment. =item read_file Intercepts file access to check for strict_root. =back =head2 EXCEPTIONS The following additional exceptions are generated by Text::MicroMason::TemplateDir when appropriate: =over 4 =item * Text::MicroMason::TemplateDir: Strict root '%s' doesn't seem to exist The strict_root directory (or template_root if strict_root is '1') doesn't seem to exist. Strict root checking uses Cwd's abs_path(), and requires the strict_root directory to exist at the time the check is performed. =item * Text::MicroMason::TemplatePath: Template '%s' not in required base path '%s' The template found in the configured template path was not within the configured strict_root directory. This may be caused by requesting an absolute template filename not within strict_root, or by specifying a strict_root which does not match the configured template path. =back =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/ServerPages.pm000644 002015 000024 00000010016 10557447465 021346 0ustar00alanstaff000000 000000 package Text::MicroMason::ServerPages; use strict; use Carp; use Safe; ###################################################################### my %block_types = ( '' => 'perl', # <% perl statements %> '=' => 'expr', # <%= perl expression %> '--' => 'doc', # <%-- this text will not appear in the output --%> '&' => 'file', # <%& filename argument %> ); my $re_eol = "(?:\\r\\n|\\r|\\n|\\z)"; my $re_tag = "perl|args|once|init|cleanup|doc|text|expr|file"; sub lex_token { # Blocks in <%word> ... <%word> tags. /\G \<\%($re_tag)\> (.*?) \<\/\%\1\> $re_eol? /xcogs ? ( $1 => $2 ) : # Blocks in <% ... %> tags. /\G \<\% (\=|\&)? ( .*? ) \%\> /gcxs ? ( $block_types{$1 || ''} => $2 ) : # Blocks in <%-- ... --%> tags. /\G \<\% \-\- ( .*? ) \-\- \%\> /gcxs ? ( 'doc' => $1 ) : # Things that don't match the above /\G ( (?: [^\<]+ | \<(?!\%) )? ) /gcxs ? ( 'text' => $1 ) : # Lexer error () } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::ServerPages - Alternate Syntax like ASP/JSP Templates =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason::Base->new( -ServerPages ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( text=>$template )->( @%args ); print $mason->execute( text=>$template, @args ); Server Pages syntax provides another way to mix Perl into a text template: <% my $name = $ARGS{name}; if ( $name eq 'Dave' ) { %> I'm sorry <%= $name %>, I'm afraid I can't do that right now. <% } else { my $hour = (localtime)[2]; my $daypart = ( $hour > 11 ) ? 'afternoon' : 'morning'; %> Good <%= $daypart %>, <%= $name %>! <% } %> =head1 DESCRIPTION This subclass replaces MicroMason's normal lexer with one that supports a syntax similar to Active Server Pages and Java Server Pages. =head2 Compatibility with Apache::ASP Apache::ASP is a full-featured application server toolkit with many fatures, of which only the templating functionality is emulated. This is not a drop-in replacement for Apache::ASP, as the implementation is quite different, but it should be able to process some existing templates without major changes. The following features of EmbPerl syntax are supported: =over 4 =item * Angle-bracket markup tags =back The following syntax features of are B supported: =over 4 =item * Dynamic XML/XSL processing. =item * Web server objects such as $Session, $Request, $Response, and $Application. =item * Application events such as Application_OnStart, Script_OnStart, and other gloga.asa features. =back =head2 Template Syntax The following elements are recognized by the ServerPages lexer: =over 4 =item * E% perl statements %E Arbitrary Perl code to be executed at this point in the template. =item * E%= perl expression %E A Perl expression to be evaluated and included in the output. =item * E%& file, arguments %E Includes an external template file. =item * E%-- comment --%E Documentation or inactive code to be skipped over silently. Can also be used to quickly comment out part of a template. =item * E%IE ... E/%IE Supported block names are: 'perl', 'args', 'once', 'init', 'cleanup', and 'doc'. =back =head2 Private Methods =over 4 =item lex_token ( $type, $value ) = $mason->lex_token(); Lexer for <% ... %> tags. Attempts to parse a token from the template text stored in the global $_ and returns a token type and value. Returns an empty list if unable to parse further due to an error. =back =cut =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Filters.pm000644 002015 000024 00000016021 10737007170 020513 0ustar00alanstaff000000 000000 package Text::MicroMason::Filters; use strict; use Carp; use Safe; ###################################################################### # Output filtering use vars qw( %Filters ); $Filters{p} = \&Text::MicroMason::Base::_printable; $Filters{h} = eval { require HTML::Entities; sub { HTML::Entities::encode( $_[0], q[<>&'"] ) } } || eval { require CGI; \&CGI::escapeHTML }; $Filters{u} = eval { require URI::Escape; \&URI::Escape::uri_escape }; sub defaults { (shift)->NEXT('defaults'), filters => \%Filters, default_filters => '' } ###################################################################### # $perl_code = $mason->assemble( @tokens ); sub assemble { my $self = shift; my @tokens = @_; # warn "Filter assemble"; foreach my $position ( 0 .. int( $#tokens / 2 ) ) { if ( $tokens[$position * 2] eq 'expr' ) { my $token = $tokens[$position * 2 + 1]; my $filt_flags = ($token =~ s/(?parse_filters($self->{default_filters}, $filt_flags)) { $token = '$m->filter( ' . join(', ', map "'$_'", @filters ) . ', ' . 'join "", do { ' . $token . '} )'; } $tokens[$position * 2 + 1] = $token; } } $self->NEXT('assemble', @tokens ); } # @flags = $mason->parse_filters( @filter_strings ); sub parse_filters { my $self = shift; my $no_ns; my $short = join '', 'n', grep { length($_) == 1 } keys %{ $self->{filters} }; reverse grep { not $no_ns ||= /^n$/ } reverse map { /^[$short]{2,5}$/ ? split('') : split(/[\s\,]+/) } @_; } ###################################################################### # %functions = $mason->filter_functions(); # $function = $mason->filter_functions( $flag ); # @functions = $mason->filter_functions( \@flags ); # $mason->filter_functions( $flag => $function, ... ); sub filter_functions { my $self = shift; my $filters = ( ref $self ) ? $self->{filters} : \%Filters; if ( scalar @_ == 0 ) { %$filters } elsif ( scalar @_ == 1 ) { my $key = shift; if ( ! ref $key ) { $filters->{ $key } } else { @{ $filters }{ @$key } } } else { %$filters = ( %$filters, @_ ); } } # @functions = $mason->get_filter_functions( @flags_or_functions ); sub get_filter_functions { my $self = shift; map { ( ref $_ eq 'CODE' ) ? $_ : $self->{filters}{ $_ } or $self->croak_msg("No definition for a filter named '$_'" ); } @_ } # $result = $mason->filter( @filters, $content ); sub filter { my $self = shift; local $_ = pop; foreach my $function ( $self->get_filter_functions( @_ ) ) { $_ = &$function($_) } $_ } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::Filters - Add Output Filters like "|h" and "|u" =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason->new( -Filters ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( text=>$template )->( @%args ); print $mason->execute( text=>$template, @args ); Enables filtering of template expressions using HTML::Mason's conventions: <%args> $name Welcome, <% $name |h %>! Click for More You can set a default filter and override it with the "n" flag: my $mason = Text::MicroMason->new( -Filters, default_filters => 'h' ); <%args> $name Welcome, <% $name %>! Click for More You can define additional filters and stack them: my $mason = Text::MicroMason->new( -Filters ); $mason->filter_functions( myfilter => \&function ); $mason->filter_functions( uc => sub { return uc( shift ) } ); <%args> $name Welcome, <% $name |uc,myfilter %>! =head1 DESCRIPTION This module enables the filtering of expressions before they are output, using HTML::Mason's "|hun" syntax. If you have HTML::Entities and URI::Escape available they are loaded to provide the default "h" and "u" filters. If those modules can not be loaded, no error message is produced but any subsequent use of them will fail. Attempted use of an unknown filter name will croak with a message stating "No definition for a filter named 'h'". =head2 Public Methods =over 4 =item filter_functions Gets and sets values from the hash mapping filter flags to functions. If called with no arguments, returns a hash of all available filter flags and functions: %functions = $mason->filter_functions(); If called with a filter flag returns the associated function, or if provided with a reference to an array of flag names returns a list of the functions: $function = $mason->filter_functions( $flag ); @functions = $mason->filter_functions( \@flags ); If called with one or more pairs of filter flags and associated functions, adds them to the hash. (Any filter that might have existed with the same flag name is overwritten.) $mason->filter_functions( $flag => $function, ... ); =back =head2 Supported Attributes =over 4 =item default_filters Optional comma-separated string of filter flags to be applied to all output expressions unless overridden by the "n" flag. =back =head2 Private Methods =over 4 =item assemble() This method goes through the lexed template tokens looking for uses of filter flags, which it then rewrites as appropriate method calls before passing the tokens on to the superclass. =item parse_filters Parses one or more strings containing any number of filter flags and returns a list of flags to be used. @flags = $mason->parse_filters( @filter_strings ); Flags should be separated by commas, except that the commas may be omitted when using a combination of single-letter flags. Flags are applied from left to right. Any use of the "n" flag wipes out all flags defined to the left of it. =item get_filter_functions Accepts filter flags or function references and returns a list of the corresponding functions. Dies if an unknown filter flag is used. @functions = $mason->get_filter_functions( @flags_or_functions ); =item filter Applies one or more filters to the provided content string. $result = $mason->filter( @flags_or_functions, $content ); =back =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/AllowGlobals.pm000644 002015 000024 00000006131 10557447465 021505 0ustar00alanstaff000000 000000 package Text::MicroMason::AllowGlobals; use strict; use Carp; ###################################################################### sub allow_globals { my $self = shift; my $globals = $self->{allow_globals}; my @current = ref( $globals ) ? @$globals : ! defined( $globals ) ? () : split ' ' , $globals; if ( scalar @_ ) { my %once_each; @current = grep { ! ( $once_each{$_} ++ ) } @current, @_; $self->{allow_globals} = \@current; } wantarray ? @current : join(' ', @current); } ###################################################################### sub set_globals { my ( $self, %globals ) = @_; my @globals = keys %globals; $self->allow_globals( @globals ); my $sub = join( "\n", $self->allow_globals_statement(), " sub { ", map( { my $var = $_; $var =~ s/^[\@\%]/*/; $var =~ s/^(\w)/\$$1/; "$var = \$_[0]{'$_'};" } @globals ), " }" ); $self->eval_sub( $sub )->( \%globals ) } ###################################################################### sub allow_globals_statement { my $self = shift; "use vars qw(" . $self->allow_globals() . ");" } sub assemble { my $self = shift; $self->NEXT('assemble', once => $self->allow_globals_statement(), @_); } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::AllowGlobals - Share package vars between templates =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason->new( -AllowGlobals ); Share package variables: $mason->set_globals( '$name' => 'Bob' ); Use the standard compile and execute methods to parse and evalute templates: print $mason->compile( text=>$template )->(); print $mason->execute( text=>$template ); Then, in a template, you can refer to those globals: Welcome, <% $name %>! =head1 DESCRIPTION =head2 Public Methods =over 4 =item set_globals() Accepts a list of pairs of global variable names and corresponding values. Adds each variable name to the allowed list and sets it to the initial value. =item allow_globals() Gets or sets the variables names to be allowed. If called with arguments, adds them to the list. Returns the variables to be allowed as a list, or as a space-separated string in scalar context. =back =head2 Supported Attributes =over 4 =item allow_globals Optional array or space-separated string of global variable names to be allowed. =back =head2 Private Methods =over 4 =item assemble() Adds the allow_globals_statement to each token stream before assembling it. =item allow_globals_statement() This method prepends the "use vars" statement needed for the template subroutines to compile. =back =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/ExecuteCache.pm000644 002015 000024 00000005324 10557452256 021446 0ustar00alanstaff000000 000000 package Text::MicroMason::ExecuteCache; use strict; use Carp; require Text::MicroMason::Base; require Text::MicroMason::Cache::Simple; ###################################################################### # $code_ref = compile( text => $template ); sub compile { my $self = shift; my $code_ref = $self->NEXT('compile', @_); my $cache = $self->_execute_cache() or return $code_ref; sub { my $key = join("|", $code_ref, @_); $cache->get( $key ) or $cache->set( $key, $code_ref->( @_ ) ); } } sub _execute_cache { my $self = shift; $self->{execute_cache} ||= Text::MicroMason::Cache::Simple->new(); } ###################################################################### 1; __END__ =head1 NAME Text::MicroMason::ExecuteCache - Use a Cache for Template Results =head1 SYNOPSIS Instead of using this class directly, pass its name to be mixed in: use Text::MicroMason; my $mason = Text::MicroMason->new( -ExecuteCache ); Use the standard compile method to parse a template into a subroutine: my $subref = $mason->compile( text=>$template ); print $subref->( 'name'=>'Dave' ); The template does not have to be interpreted the second time because the results are cached: print $subref->( 'name'=>'Dave' ); # fast second time When run with different arguments, the template is re-interpreted and the results stored: print $subref->( 'name'=>'Bob' ); # first time for Bob print $subref->( 'name'=>'Bob' ); # fast second time for Bob =head1 DESCRIPTION Caches the output of templates. Note that you should not use this feature if your template code interacts with any external state, such as making changes to an external data source or obtaining values that will change in the future. (However, you can still use the caching provided by L.) =head2 Public Methods =over 4 =item compile() Wraps each template that is compiled into a Perl subroutine in a memoizing closure. =back =head2 Supported Attributes =over 4 =item execute_cache Defaults to an instance of Text::MicroMason::Cache::Simple. =back This module uses a simple cache interface that is widely supported: the only methods required are C and C. You can use the simple cache classes provided in the Text::MicroMason::Cache:: namespace, or select other caching modules on CPAN that support the interface described in L. =head1 SEE ALSO For an overview of this templating framework, see L. This is a mixin class intended for use with L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Cache/Simple.pm000644 002015 000024 00000003000 10557447465 021347 0ustar00alanstaff000000 000000 package Text::MicroMason::Cache::Simple; use strict; ###################################################################### sub new { my $class = shift; bless { @_ }, $class } sub get { $_[0]->{ $_[1] } } sub set { $_[0]->{ $_[1] } = $_[2] } sub clear { %{ $_[0] } = () } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::Cache::Simple - Basic Cache with Minimal Interface =head1 DESCRIPTION This trivial cache class just stores values in a hash. It does not perform any of the following functions: expiration, cache size limiting, flatening of complex keys, or deep copying of complex values. =head2 Public Methods =over 4 =item new() $cache = Text::MicroMason::Cache::Simple->new(); =item get() $value = $cache->get( $key ); Retrieves the value associated with this key, or undef if there is no value. =item set() $cache->set( $key, $value ); Stores the provided value in association with this key. =item clear() $cache->clear(); Removes all data from the cache. =back =head1 SEE ALSO For uses of this cache class, see L. Additional cache classes are available in the Text::MicroMason::Cache:: namespace, or select other caching modules on CPAN that support the interface described in L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Cache/Null.pm000644 002015 000024 00000002400 10557447465 021033 0ustar00alanstaff000000 000000 package Text::MicroMason::Cache::Null; use strict; ###################################################################### sub new { my $class = shift; bless { @_ }, $class } sub get { return } sub set { return $_[2] } sub clear { return } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::Cache::Null - Trivial Cache with No Data Storage =head1 DESCRIPTION This trivial cache class supports the cache interface but doesn't store or retrieve any values. =head2 Public Methods =over 4 =item new() $cache = Text::MicroMason::Cache::Null->new(); =item get() undef = $cache->get( $key ); Does nothing. =item set() $cache->set( $key, $value ); Returns the provided value. =item clear() $cache->clear(); Does nothing. =back =head1 SEE ALSO For uses of this cache class, see L. Additional cache classes are available in the Text::MicroMason::Cache:: namespace, or select other caching modules on CPAN that support the interface described in L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Cache/File.pm000644 002015 000024 00000004571 10733022504 020766 0ustar00alanstaff000000 000000 package Text::MicroMason::Cache::File; @ISA = 'Text::MicroMason::Cache::Simple'; use strict; # Array field names use constant LAST_CHECK => 0; use constant AGE => 1; use constant VALUE => 2; ###################################################################### sub get { my ( $self, $file ) = @_; my $entry = $self->SUPER::get( $file ) or return; unless (ref($entry) eq 'ARRAY' and @$entry == 3 ) { Carp::croak("MicroMason: cache '$self' data corrupted; " . "value for '$file' should not be '$entry'"); } my $time = time(); if ( $entry->[LAST_CHECK] < $time ) { # don't check more than once per second my $current_age = -M $file; if ( $entry->[AGE] > $current_age ) { @$entry = ( 0, 0, undef ); # file has changed; cache invalid return; } else { $entry->[LAST_CHECK] = $time; } } return $entry->[VALUE]; } sub set { my ($self, $file, $sub) = @_; $self->SUPER::set( $file => [ time(), -M $file, $sub ] ); return $sub; } ###################################################################### 1; __END__ ###################################################################### =head1 NAME Text::MicroMason::Cache::File - Basic Cache with File-Based Expiration =head1 DESCRIPTION This simple cache class expects the keys provided to it to be file pathnames, and considers the cached value to have expired if the corresponding file is changed. It does not perform the following functions: cache size limiting, or deep copying of complex values. =head2 Public Methods =over 4 =item new() $cache = Text::MicroMason::Cache::File->new(); =item get() $value = $cache->get( $filename ); Retrieves the value associated with this key, or undef if there is no value. =item set() $cache->set( $filename, $value ); Stores the provided value in association with this key. =item clear() $cache->clear(); Removes all data from the cache. =back =head1 SEE ALSO For uses of this cache class, see L. Additional cache classes are available in the Text::MicroMason::Cache:: namespace, or select other caching modules on CPAN that support the interface described in L. For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Docs/Related.pod000644 002015 000024 00000007303 10557447465 021543 0ustar00alanstaff000000 000000 =head1 NAME Text::MicroMason::Docs::Related - A Brief Survey of Templating Modules =head1 RELATED MODULES Text::MicroMason is just one of dozens (or hundreds) of templating distributions on CPAN. This document mentions a few related modules and includes a brief discussion of some similarities and differences among them. =head1 OTHER COMPARISONS For a more authoritative discussion, see Perrin Harkins' classic article at L. For reference, here's a slightly mangled version of the comparison matrix at the conclusion of that article: Scope Style Parsing Language HTML::Mason Framework Callback Compiled Perl HTML::Embperl Framework Callback Compiled Perl Apache::ASP Framework Callback Compiled Perl and XSL AxKit Framework Pipeline Compiled or Perl, XSL and Cached Parse Mini-Languages SSI Templates Callback Repeated Parse Mini-Language Template Tlkit Templates Pipeline Compiled Mini-Language HTML::Template Templates Pipeline Cached Parse Mini-Language Text::Template Templates Pipeline Compiled Perl =head1 POINTS OF COMPARISON There are serveral ways we can differentiate between templating systems: =over 4 =item Perl Syntax vs. Little Languages Some templating systems use Perl syntax for both interpolated expressions and flow control, including L, L, and L. Others use "little languages", including L and L. =item Just Templating vs. Web Application Framework Some templating systems just provide functions to fill in templates, like L. Others are part of full-blown web application frameworks like L, ePerl, L, and L. =item Modular vs Monolithic Some templating systems are not particularly configurable or extensible. Others support various kinds of extensions, including L, L and L. =item Interpreted vs. Compiled Some templating systems repeatedly parse the template from scratch every time it is used. Others parse the template into an intermediate data structure and then iterate over that each time the template is used. Others convert the template into equivalent Perl source code which can be compiled into a directly-executable subroutine and used repeatedly, including L and L. =back =head1 EMULATED MODULES =head2 Apache::ASP For an emulation for L, see L. =head2 Embperl For an emulation for L, see L. =head2 HTML::Template For an emulation for L, see L. See also L. =head2 HTML::Mason For an emulation for L, see L. (If you've already got HTML::Mason installed, configured, and loaded into your process, you're probably better off using it rather than this package. HTML::Mason's C<$interp-Emake_component()> method allows you to parse a text string without saving it to disk first.) =head2 PLP For an emulation for L, see L. =head2 Text::Template For an emulation for L, see L. =head1 SEE ALSO For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Docs/ToDo.pod000644 002015 000024 00000020205 11277073030 021003 0ustar00alanstaff000000 000000 =head1 NAME Text::MicroMason::Docs::ToDo - Development Plans for the MicroMason Distribution =head1 DESCRIPTION This document outlines various development plans and ideas for Text::MicroMason. The TO DO section describes plans which are likely to happen. The WISH LIST section describes a variety of ideas which are likely to be accepted as patches, but which will most likely not be developed with any priority any time soon. If you are interested in a specific feature, whether it is listed here or not, please contact the current maintainer as described in L. =head1 TO DO =head2 Fix all known bugs So, please report them. =head2 Distribution =over 4 =item * Move the module files into a lib/ directory as expected in modern CPAN distributions. =back =head2 New Mixins =over 4 =item * AutoLoad mixin. Using this mixin adds an AUTOLOADER to the mason object, which interprets all unknown method calls as template names. =back =head2 New Features =over 4 =item * Support the previously supported but now unsupported compile(lines => ...) source type. This was documented but non- functional, and so the pod was removed. =back =head1 WISH LIST =head2 Distribution =over 4 =item * Use Module::Build instead of ExtUtils::MakeMaker. =item * Consider reorganizing the Text::MicroMason::* modules into a number of subdirectories. There are currently over two dozen of them, and it's bound to get worse as time goes on. Perhaps separate them by intent: Cache::*, Errors::*, Syntax::*, Features::*, etc. =item * Finish and test the ParseInfo module to facilitate template introspection. =item * Rewrite the MOTIVATION section of the ReadMe pod to reflect the shift from an HTML::Mason clone to a more general templating engine that has at least partial compatibilty with quite a few other modules. =back =head2 Interfaces =over 4 =item * Test and improve the ApacheHandler interface. Map user-friendly Apache config directives to mixin and initialization options. Review HTML::Mason::ApacheHandler, HTML::Mason::Params, and HTML::Mason::Admin. Headers need to be constructed as per http://modperlbook.org/html/ch06_11.html and not sent until our first print statement; see PLP::Tie::Print. =item * Review integration with Inline::Mason. Facilitate use of mixins so this can also do inline ServerPages and other syntaxes. =back =head2 Core Syntax =over 4 =item * Determine how to best stack lex_token() method so that multiple syntax plugins can work together. =item * Extract named blocks parsing from HTMLMason to form a separate mixin. =item * Extract variable interpolation syntax to allow it to be stacked with other lexers. =back =head2 Syntax Emulations =over 4 =item * Add TemplateToolkit module with support for the basic TT syntax. The key syntax definition is in Parser.yp, which is used to build Template::Grammar. (L) The Template::Stash dot notation can be handled by Data::DRef. =item * Extend HTMLTemplate module with a hash mapping options that could be passed to HTML::Template's new() into the equivalent behavior, or croak if they're unsupported. =item * Consider extending Embperl module to support dynamic HTML tags. =item * Consider extending ServerPages module to support dynamic XML tags. =back =head2 Template Sources =over 4 =item * Provide a mixin to search for all files matching a given regex to facilitate tree searches and cache pre-fetching. =item * Ensure template inclusion is always handled correctly. Possibly provide the current template's location in %ENV. =item * Add a DHandlers mixin that supports default files. On file requests, if file not found, look for default file. (Attribute dhandler_name controls name of file to look for.) =item * Add an AutoHandlers mixin that supports wrapper files. On file requests, also search hierarchy for autohandler files. (Attribute autohandler_name controls name of file to look for.) Build a stack of autohandlers and store it in a mason attribute. Support ->call_next() to work through the chain. (I've also gotten a user request for "decorator files" which turns out to be roughly equivalent to the AutoHandler system.) =item * Add a TemplateDB mixin which shows how to retrieve templates from a database table. Provides a read_db() method. Accept a DBI connection as an attribute -- or a reference to a function which will return rows from a sql statement. Consider how to support caching for templates drawn from a TemplateDB. Perhaps in addition to the source_file there can be some kind of opaque cache key returned by the prepare method? Maybe cache values for db templates can be abstracted into closures which are run to retrieve the cached value. =back =head2 Caching =over 4 =item * Add a DataCache mixin that provides a pre-configured cache object for use within template code. Requires cache() method and configuration attributes. Cache namespace should be based on source file name or arbitrary instance for text compilation. Alan says: I believe this is intended for use to cache contextual data across template runs? Is this intended to be persistent across multiple templates (in memory/singleton), or across multiple process invocations (in a file)? I use mod_perl, and this sounds at best not useful and at worst, dangerous. =item * Add an InterpretCache mixin that allows caching of the parsed and assembled Perl code for a template file, akin to Mason's var/obj/ directory. (This would also allow visual review when debugging the converted code.) =item * The InterpretCache and CompileCache benefit from using a cache object that checks the keys as filenames to see if the source file has been updated and forces cache expiration; find a way to extract and reuse this capability from Text::MicroMason::Cache::File. =back =head2 Blessing Templates =over 4 =item * Add a BlessSub mixin that blesses the compiled subroutine. This would let us add support for template-specific behaviors and attributes. Override eval_sub() to bless sub before returning. Attribute bless_sub controls initializer arguments passed to BlessedSub class. BlessedSub class is base class for blessed template objects. Provides execute() method. BlessedSub classes may need their own mixin factory... To avoid having to define separate mixins for both packages, perhaps the methods should be delegated from the coderef to the Mason instance? (This becomes particularly attractive if each sub is automatically getting its own cloned mason instance anyway.) =item * Add an AttrBlock mixin, using BlessedSub. Override lexer methods to parse <%attr> blocks. Stores attribute definitions in a %once block. Provides attr() method. =item * Add a MethodBlock mixin, using BlessedSub. Override lexer methods to parse <%method> blocks. Stores method definitions in a %once block. Hooks AUTOLOAD to catch method calls. =back =head2 Internals =over 4 =item * Consider moving output_sub to a new OutputHandle mixin which accepts a handle as an attribute, then prints output to it rather than returning the results as a string. =item * Clarify and document the clone-on-change behavior of prepare() and its effects when making changes to a mason object after compiling a template. Perhaps we should ensure that we clone every time, or at least every time that it matters? =back =head2 Testing =over 4 =item * Set up a benchmarking tool to compare subclasses with other templating solutions. Take an example from ApacheBench but execute templates directly rather than via Apache. Store the expected output in a text file for comparison. Other links to consider when benchmarking: http://www.chamas.com/bench/ http://use.perl.org/~hctif/journal/25211 http://www.gtchat.de/templateengines/templateengines_en.html =item * Set up a compliance test tool that compares the output of the various MicroMason mixins with the other modules they emulate. This should be able to use many of the same data files as the benchmarking tool. =item * Add more templates to samples directory and test them. =back =head1 SEE ALSO For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/MicroMason/Docs/ReadMe.pod000644 002015 000024 00000015417 11513636074 021312 0ustar00alanstaff000000 000000 =head1 NAME Text::MicroMason::Docs::ReadMe - About the MicroMason Distribution =head1 MOTIVATION The HTML::Mason module provides a useful syntax for dynamic template interpretation (sometimes called embedded scripting): plain text (or HTML) containing occasional chunks of Perl code whose results are interpolated into the text when the template is "executed." However, HTML::Mason also provides a full-featured web application framework with numerous other functions, and there are times in which I'd like to use the templating capability without configuring a full Mason installation. Thus, the Text::MicroMason module was born: it supports the core aspects of the HTML::Mason syntax ("<%...%>" expressions, "%...\n" lines and "<%perl>..." blocks, "<& file &>" includes, "%ARGS" and "$_out->()"), and omits the features that are web specific (like autohandlers) or are less widely used (like "<%method>" blocks). You may well be thinking "yet another dynamic templating module? Sheesh!" And you'd have a good point. There certainly are a wide variety of templating toolkits on CPAN already. (For a brief list see L.) Nonetheless, I think this module occupies a useful niche: it provides a reasonable subset of HTML::Mason syntax in a very light-weight fashion. In comparison to the other modules listed, MicroMason aims to be fairly lightweight, using one eval per parse, converting the template to a compiled subroutine reference, and requiring less than five hundred lines of Perl code. Although it notoriously difficult to fairly benchmark competing template frameworks, at least some anecdotal evidence indicates that this module performs reasonably well. http://use.perl.org/~hctif/journal/25211 http://www.gtchat.de/templateengines/templateengines_en.html It is also highly modular, allowing users to select and enable the combination of features they desire. Automatic caching, safe compartments, post-processing and other features are available as mixin classes that are loaded on demand. I've recently added mixin classes that emulate the template syntax used by Apache::ASP, Embperl, HTML::Template, PLP, Text::Template, and Text::QuickTemplate. =head1 DISTRIBUTION STATUS This is version 2.13 of Text::MicroMason. If you encounter any problems, please inform the current maintainer and I'll endeavor to patch them promptly. This module's CPAN registration should read: Name DSLIP Description -------------- ----- --------------------------------------------- Text:: Group 11: Text Processing ::MicroMason Rdpfp Simplified HTML::Mason Templating Please see the CPAN Testers report for a sample of systems this module has been tested successfully on: http://testers.cpan.org/show/Text-MicroMason.html =head1 PREREQUISITES The required version of perl has been increased to 5.6 as of version 1.993_01. It should work with on any standard platform which runs Perl. Although almost all currently existing features work on versions of Perl reaching back to 5.0, it will benefit Text::MicroMason in the long run if supporting legacy versions of Perl was not necessary. Please contact the new maintainer to gripe, if you absolutely need Text::MicroMason on an older version of Perl. There is one pre-requisite module not included with the core distribution which must be installed from CPAN: L. If you want to use the Text::Template compatibility mode, you will also need to install L. Various other mixins included in MicroMason require other modules in order to be useful, but MicroMason installs and tests without them. (I should be more specific here in the future.) =head1 INSTALLATION You should be able to install this module using the CPAN shell interface: perl -MCPAN -e 'install Text::MicroMason' Alternately, you may retrieve this package from CPAN (C). After downloading the distribution, follow the normal procedure to unpack and install it, using the commands shown below or their local equivalents on your system: tar xzf Text-MicroMason-*.tar.gz cd Text-MicroMason-* perl Makefile.PL make test && sudo make install =head1 SUPPORT If you have questions or feedback about this module, please feel free to contact the maintainer or original author at the e-mail address listed below. Although there is no formal support program, I do attempt to answer email promptly. I would be particularly interested in any suggestions towards improving the documentation, correcting any Perl-version or platform dependencies, as well as general feedback and suggested additions. Bug reports that contain a failing test case are greatly appreciated, and suggested patches will be promptly considered for inclusion in future releases. You can report bugs via the CPAN web tracking system, or send mail to C, replacing C<#> with C<@>. http://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-MicroMason =head1 COMMUNITY If you've found this module useful or have feedback about your experience with it, consider sharing your opinion with other Perl users by posting your comment to CPAN's ratings system. http://cpanratings.perl.org/rate/?distribution=Text-MicroMason For more general discussion, you may wish to post a message on the CPAN::Forum, on PerlMonks, or on the comp.lang.perl.modules newsgroup. These are not all monitored by the current maintainer, so if you want a response, please contact me directly. http://www.cpanforum.com/dist/Text-MicroMason http://perlmonks.org/?node=Seekers%20of%20Perl%20Wisdom http://groups.google.com/groups?group=comp.lang.perl.modules =head1 THANKS My sincere thanks to the following people for their feedback and contributions: Pascal Barbedor Mark Hampton Philip King Daniel J. Wright William Kern Tommi Maekitalo Alan Ferrency Jonas Alves Alexander Matthew Simon Cavalletto Jon Warbrick Frank Wiegand Mike Kelly Niko Tyni Ansgar Burchardt vshih =head1 SOURCE MATERIAL Portions based on HTML::Mason by Jonathan Swartz. Portions based on Embperl by Gerald Richter. Portions based on HTML::Template by Sam Tregar. Portions based on PLP by Juerd Waalboer. Portions based on Text::Template by Mark Jason Dominus. Portions based on Text::QuickTemplate by Eric J. Roode. =head1 AUTHOR Developed by Matthew Simon Cavalletto at Evolution Softworks. You may contact the author directly at C or C, replacing C<#> with C<@>. Currently maintained by Alan Ferrency at pair Networks, Inc. =head1 LICENSE Copyright 2002, 2003, 2004, 2005 Matthew Simon Cavalletto. Portions copyright 2001 Evolution Online Systems, Inc. You may use, modify, and distribute this software under the same terms as Perl. =cut Text-MicroMason-2.13/MicroMason/Docs/Changes.pod000644 002015 000024 00000043000 11513636074 021512 0ustar00alanstaff000000 000000 =head1 NAME Text::MicroMason::Docs::Changes - Change History for the MicroMason Distribution =head1 VERSION 2 HISTORY =over 4 =head2 Version 2.13 =item 2011-01-13 [rt.cpan.org #64192] Skip the Safe-related tests more often, since newer versions of Safe.pm mark their own failing tests as TODO instead of changing the module's behavior. =head2 Version 2.12 =item 2010-09-07 Skip more tests that fail due to a bug in Safe.pm. Add a prereq for Safe.pm so CPAN testers will provide more debug info on failure. =head2 Version 2.11 =item 2010-09-07 [rt.cpan.org #61010] Fix spelling errors and pod example bugs. Thanks to vshih at yahoo.com for reporting these problems. =item 2010-09-07 Under Perl 5.13.1 and later with Safe version 2.27, skip failing tests in t/32-safe.t. The regression tests for Safe 2.27 fail in Perl 5.13.1 as well, in a similar way. This bug is not fixable in any reasonable way until Safe.pm is also stable. =item 2010-07-26 [rt.cpan.org #59081] Fix spelling and pod errors. Thanks to Ansgar Burchardt and the Debian project for submitting this bug report along with patches. =head2 Version 2.10 =item 2010-06-29 [rt.cpan.org #57797] Deprecate safe_methods parameter. Unfortunately, Safe.pm version 2.27 patches a bug we were inadvertantly taking advantage of to implement the safe_methods parameter. Unless we can find a working implementation of safe_methods that is smaller than "make everything unsafe" then we can't continue to support safe_methods. Using safe_methods now issues a deprecation warning, but it should work with older versions of Safe. I'm in no hurry to remove the feature, but I don't want anyone to use it who isn't already using it, until we know it can be supported in the future. Thanks to Niko Tyni and the Debian Perl Group for submitting this bug report. =item 2010-04-05 "uninitialized" warnings in templates were being generated at a line number within MicroMason instead of a line number within the template itself. Thanks to Mike Kelly for a patch: by concatenating an empty string to each TOKEN within the template, the warning's line number is shifted to inside the template where the interpolation took place. =head2 Version 2.09 =item 2010-03-24 Fix test that was broken by changes in URI::Escape 1.30. Double quotes aren't reserved characters in URIs but they were previously encoded anyway. Test modified to use reserved single quotes instead, for URI::Escape testing. =head2 Version 2.08 =item 2010-03-08 Fixed PassVariables bug: <%init> failed with -PassVariables plugin. Thanks to William Kern for reporting this. =item 2009-11-19 Fixed [rt.cpan.org #51727] [Patch] POD nit; thanks to Frank Wiegand for reporting this. =back =head2 Version 2.07 =over 4 =item 2009-11-16 Merge patch from Simon Cavalletto: fix bug reported in CPAN forum with "OUT" appearing in the input template stream. Thanks! Update requirement for Test::More 0.48 or later in Makefile.PL. Tests using unlike() failed with Test::More version 0.47. Fix problem in t/08_errors.t which caused test failures in Perl 5.6. The error message isn't as important as the test made it out to be, but the code didn't have a problem. =item 2009-11-12 Remove documentation for unsupported compile(lines => ...) mode. Put it on ToDo instead. =back =head2 Version 2.06 =over 4 =item 2009-11-11 Fix bug reported in CPAN forum: substr() in LineNumbers.pm was being used incorrectly, resulting in incorrect line numbering in some cases. =item 2009-11-12 #51460: Clean up the tarball and resubmit a version that doesn't contain a stray .tgz file. =back =head2 Version 2.05 =over 4 =item 2009-11-10 Modify compilation error reporting: provide line numbers when dumping the compiled template into $@, and change the #line to match the line numbering correctly. =item 2009-11-11 Fix bug reported by CPAN testers on some Windows boxes: use Cwd::abs_path for strict_root checking to avoid literal path separators in TemplateDir.pm. =item 2009-11-11 Add a hint about -LineNumbers in the numbered template dump when a compilation error occurs. =back =head2 Version 2.04 =over 4 =item 2009-11-06 Fixed SKIP count in t/33_filters.t to prevent test failures when URI::Escape isn't installed. =back =head2 Version 2.03 =over 4 =item 2009-10-30 Happy Halloween. Updated tests to use Test::More for better diagnostics via CPAN testers. Tweaked t/34 with a longer sleep() since some linux hosts seemed to be sleeping for less than a second with sleep(1). =back =head2 Version 2.02 =over 4 =item 2009-10-29 Updated Changes.pod. Fixed SKIP count in t/33 which caused test count mismatches when HTML::Entities wasn't installed. =back =head2 Version 2.01 =over 4 =item 2009-10-29 Fix a bug with TemplatePath error messages. If a template name was provided that didn't exist in the path, the error message generated by read_file didn't specify which template was requested. This version now croaks in resolve_path instead of returning undef and letting read_file croak. Updated pod to reflect this change and document previously undocumented exception strings. Modified undocumented exception strings for strict_root violations. =back =head2 Version 2.0 =over 4 =item 2008-01-02 Fix bug with || filter patch: it was erroneously removing the last character of the filtered token, which made it fail if there was no space before the |. Bump version to 2.0 =back =head2 Version 1.993_01 =over 4 =item 2007-12-21 Add LineNumbers mixin and associated tests. =item 2007-12-21 Update TODO: move almost everything into a WISH LIST with a request for contributions, and make the main TODO list bug fixes and a few likely developments. =item 2007-12-21 Merge test and patch from RT bug #21802: cache expiration bug. =item 2007-12-21 Merge changes from RT bug #18435: filter problem with <% $thing || "default" %> =item 2007-12-21 Bump version to 1.993_01 =back =head2 Version 1.993 =over 4 =item 2007-12-20 Merge changes from pair Networks local branch, which have been in testing and production since Q1 2007; bump version to 1.993. This includes: =over 2 =item TemplatePath mixin Template lookups on a search path =item TemplateDir/ Cache patch fix interaction of caching and TemplateDir/TemplatePath =item Additional test files =item Stop creating cache objects unless/until they're used =back =back =head2 Version 1.992_01 =over 4 =item 2007-12-20 Updated pod and makefiles for maintenance transition from Simon to Alan. Thanks for the wonderful module, Simon! I hope I can keep things under control. Bumped version number. =back =head2 Version 1.992 =over 4 =item 2005-11-13 Updated ToDo.pod with a few ideas for upcoming releases. Extended t/58-quicktemplate.t to demonstrate use of the pre_fill method. =item 2005-11-12 Fixed incorrect handling of default values for array or hash variables in an <%args> block. Thanks to Alexander for the bug report. Added extra newlines to the do blocks generated by Base's assemble(), so that <% exprs %> can contain a comment. Problem reported by Alexander. Improved error reporting by changing the file name embedded in the CPP-style line number comment at the top of each stretch of generated Perl code. Based on a problem report from Alexander. This does not fix the line numbering problem, but at least the file name is more helpful than it used to be. =item 2005-08-24 Added RoughDraft of "ParseInfo.pm" based on a reply to a question via email from Alexander. =item 2005-07-30 Fixed return value from Text::MicroMason::Cache::File set() method; thanks to Alan Ferrency for the helpful bug report and test case. =item 2005-07-24 Extracted HasParams and StoreOne mixins from HTMLTemplate. Added QuickTemplate mixin class with emulation for Text::QuickTemplate. =item 2005-07-20 Added reference links to benchmarking section in Docs/ToDo.pod. Added "local $^W;" in two test scripts to silence extra warning on Perl 5.005_04. Bumped version number. =back =head2 Version 1.991 =over 4 =item 2005-07-19 Bumped version number. Added ApacheHandler configuration options and basic documentation. =item 2005-07-18 Added PLP mixin class with emulation for PLP templating package. Added the skeleton for a basic ApacheHandler class. Improved strict_root support in TemplateDir and added documentation for it. Extracted argument passing logic from TextTemplate to create new PassVariables mixin. Added Sprintf syntax mixin and basic tests. =item 2005-07-17 Added DoubleQuote syntax mixin and basic tests. =back =head2 Version 1.99 =over 4 =item 2005-07-09 Added AllowGlobals mixin based on suggestion and patch from Jonas Alves. Reviewed similar functionality in HTML::Mason and added docs and tests. Extracted debug options to separate Debug mixin class. Changed name of internal new() method to create(), while propogating the mixin finding behavior from the Text::MicroMason facade up to Text::MicroMason::Base. Renamed examples directory to samples. Added read_handle method and output_sub attribute. Added assembler_vars method and removed %Assembler global. =item 2004-12-01 Fixed early exit of t/42-text_template.t to skip test if missing Text::Balanced. =item 2004-11-30 Renamed the Mason compatibilty class to HTMLMason to match other syntax classes. Changed it to be a mixin like the other classes, instead of a subclass. Switched to use of Class::MixinFactory and removed old class() and NEXT() methods. Extracted new interpret() method from inside of compile(). Adjusted setting of options and attributes so that this doesn't happen within interpret(). Extracted list of related modules to new Docs::Related POD file. =back =head2 Version 1.98 =over 4 =item 2004-11-29 Fixed unprotected test dependency on Text::Balanced for TextTemplate emulation. Fixed unexpected side-effect of change to parsing for single-character Filter flags. Minor adjustments to POD documentation. =back =head2 Version 1.97 =over 4 =item 2004-11-28 Moved to do list into new pod file. Moved extra pod files into Docs namespace. Added _printable to default set of functions in Filters. Tweaked parse_filters and get_filter_functions methods. Changed internal names for ouput and include token types to expr and file. Corrected typo in one of the assembler token names. Adjusted $Carp::CarpLevel in Base croak_msg(). Fixed test failure in t/33-filters.t reported by William Kern. =item 2004-10-24 Fixed typo in ServerPages example; thanks to William Kern for pointing it out. =item 2004-10-20 Adjustments to documentation in top-level package. =back =head2 Version 1.96 =over 4 =item 2004-10-19 Added PostProcess mixin class at the suggestion of Alan Ferrency. Renamed a few keys in the hash returned by assembler_rules(). Moved syntax documentation to Mason subclass. =back =head2 Version 1.95 =over 4 =item 2004-10-19 Fixed problem with extra semicolons breaking code statements broken onto multiple % code lines; thanks to Alan Ferrency for test code to isolate the problem, now added to regression tests. =item 2004-10-17 Documentation updates. =back =head2 Version 1.94 =over 4 =item 2004-10-17 Factored subclass-specific lex_token() method out from superclass lex() method. Added Embperl mixin class with emulation for HTML::Embperl. Merged Devel.pod back in to other package documentation. =item 2004-10-16 Replaced assembler attribute with assembler_rules() method. Added Mason subclass and moved some functionality to there from Base. Documentation updates. =item 2004-10-15 Added HTMLTemplate mixin class with emulation for HTML::Template. =item 2004-10-13 Added TextTemplate mixin class with emulation for Text::Template. =back =head2 Version 1.93 =over 4 =item 2004-10-12 Instead of run-time eval of @MIXIN to fix SUPER resolution, now using a new SUPER method. =item 2004-10-11 Documentation updates. =back =head2 Version 1.92 =over 4 =item 2004-10-11 Uploaded to CPAN to fix packaging issue with 1.9_1. =back =head2 Version 1.91 =over 4 =item 2004-10-10 Posted description of mixin mechanism to PerlMonks for discussion. Debugged CompileCache and finished ExecuteCache. Added test scripts. Debugged TemplateDir and added test script. Implemented support for one-time options passed to compile that override other attributes. Adjusted Safe facade to prevent this from being done there, in order to avoid escapes from a Safe compartment. =item 2004-10-09 Reorganized t/ directory. =back =head2 Version 1.90 =over 4 =item 2004-10-08 Documentation updates. =item 2004-10-05 Documentation updates. =back =head2 Version 1.55 =over 4 =item 2004-09-23 Documentation updates. =back =head2 Version 1.54 =over 4 =item 2004-09-22 Renamed "interpret" method to "execute" for consistency with function interface. Moved try_ functionality to new ErrorCatching mixin. Generalized behavior of assemble method; moved template elements into %Assembly hash. =back =head2 Version 1.53 =over 4 =item 2004-09-22 Moved Safe functionality to new Safe mixin. Moved filtering functionality to new Filters mixin. =item 2004-09-21 Added mixin inheritance hacking logic based on DBIx::SQLEngine::Record::Class. =back =head2 Version 1.52 =over 4 =item 2004-09-19 Extracted Changes to separate POD document. =item 2004-09-18 Additional work. =back =head2 Version 1.51 =over 4 =item 2004-09-17 Refactoring of method interface to merge compie and interpretation into single subroutines with parameters to indicate whether we're reading text or a file. Added initial support for filtering interpolated expressions based on a patch and extended discussion with Alan Ferrency. Packaged as version 1.51 but not released to CPAN. =item 2004-09-16 Refactored to object-oriented implementation to allow subclassing. Inspired by discussion with Alan Ferrency about how to extend functionality. Started CodeCache subclass based on experimental caching code included in 1.07. Started TemplateDir subclass with base directory and relative path calculations based on a patch from Tommi Maekitalo. Incorporated patch from Tommi Maekitalo to put default values from an <%args> block into the %ARGS variable as well as the separate named variables. Created ServerPages subclass based on feature request from William Kern. =item 2004-09-15 Moved package documentation into separate ReadMe.pod. =back =head1 VERSION 1 HISTORY =head2 Version 1.07 =over 4 =item 2003-09-26 Discard line break after <%perl> block as suggested by Tommi Maekitalo. Note that removing these line breaks may affect the rendering of your current templates! Although I am typically hesitant to change established behavior, this does improve the template output and brings us into line with HTML::Mason's behavior. Added $Debug flag and support for <%args> blocks based on a contribution by Tommi Maekitalo. Adjusted internals to allow block reordering, and added support for <%init> and <%once>. Released as Text-MicroMason-1.07.tar.gz. =back =head2 Version 1.06 =over 4 =item 2003-09-04 Changed the way that subroutines were scoped into the Text::MicroMason::Commands namespace so that Safe compartments with separate namespaces and shared symbols have the visibility that one would expect. Fixed a bug in which an unadorned percent sign halted parsing, as reported by William Kern at PixelGate. Added a test to the end of 6-regression.t that fails under 1.05 but passes under 1.06 to confirm this. Simplified parser regular expressions by using non-greedy matching. Added documentation for *_file() functions. Corrected documentation to reflect the fact that template code is not compiled with "use safe" in effect by default, but that this might change in the future. Released as Text-MicroMason-1.06.tar.gz. =back =head2 Version 1.05 =over 4 =item 2003-08-11 Adjusted regular expression based on parsing problems reported by Philip King and Daniel J. Wright, related to newlines and EOF. Added regression tests that fail under 1.04 but pass under 1.05 to ensure these features keep working as expected. Added non-printing-character escaping to parser failure and debugging messages to better track future reports of whitespace-related bugs. Moved tests from test.pl into t/ subdirectory. Added experimental suppport for file code cache in compile_file_codecache. Released as Text-MicroMason-1.05.tar.gz. =back =head2 Version 1.04 =over 4 =item 2002-06-23 Adjusted regular expression based on parsing problems reported by Mark Hampton. Added file-include support with <& ... &> syntax. Documentation tweaks. Adjusted version number to simpler 0.00 format. Released as Text-MicroMason-1.04.tar.gz. =item 2002-01-14 Documentation tweaks based on feedback from Pascal Barbedor. Updated author's contact information. =back =head2 Version 1.0.3 =over 4 =item 2001-07-01 Renamed from HTML::MicroMason to Text::MicroMason. Documentation tweaks. Released as Text-MicroMason-1.0.3.tar.gz. =back =head2 Version 1.0.2 =over 4 =item 2001-04-10 Munged interface for clarity. Added Safe support. Adjusted docs to reflect feedback from mason-users. Released as HTML-MicroMason-1.0.2.tar.gz. =back =head2 Version 1.0.1 =over 4 =item 2001-03-28 Parser tweakage; additional documentation. Added Exporter support. Released as HTML-MicroMason-1.0.1.tar.gz. =item 2001-03-26 Added try_interpret; documented error messages. =back =head2 Version 1.0.0 =over 4 =item 2001-03-23 Extended documentation; added makefile, test script. Renamed accumulator to $OUT to match Text::Template. Released as HTML-MicroMason-1.0.0.tar.gz. =item 2001-03-22 Created. =back =head1 SEE ALSO For distribution, installation, support, copyright and license information, see L. =cut Text-MicroMason-2.13/t/39-debug.t000644 002015 000024 00000001070 11272642676 016456 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 4; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -Debug, debug => { default => 0 } ); ###################################################################### { my $scr_hello = <<'ENDSCRIPT'; % my $noun = 'World'; Hello <% $noun %>! How are ya? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Hello World! How are ya? ENDSCRIPT ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->(), $res_hello; } ###################################################################### Text-MicroMason-2.13/t/51-server_pages.t000644 002015 000024 00000004004 11272642676 020047 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 112; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -ServerPages ); ###################################################################### my $scr_hello = <<'ENDSCRIPT'; <% my $noun = 'World'; %>Hello <%= $noun %>! How are ya? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Hello World! How are ya? ENDSCRIPT is $m->execute( text => $scr_hello), $res_hello; is $m->compile( text => $scr_hello)->(), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; ###################################################################### my $scr_bold = '<%= $ARGS{label} %>'; is $m->execute( text => $scr_bold, label=>'Foo'), 'Foo'; is $m->compile( text => $scr_bold)->(label=>'Foo'), 'Foo'; ###################################################################### FLOW_CONTROL: { my $scr_rand = <<'ENDSCRIPT'; <% if ( int rand 2 ) { %> Hello World! <% } else { %> Goodbye Cruel World! <% } %> ENDSCRIPT my $scriptlet = $m->compile( text => $scr_rand); for ( 0 .. 99 ) { like $scriptlet->(), qr/^\n (Hello World!|Goodbye Cruel World!)\n$/; } } ###################################################################### PERL_BLOCK: { my $scr_count = <<'ENDSCRIPT'; Counting... <% foreach ( 1 .. 9 ) { $_out->( $_ ) } %> Done! ENDSCRIPT my $res_count = <<'ENDSCRIPT'; Counting... 123456789 Done! ENDSCRIPT is $m->execute( text => $scr_count), $res_count; } SPANNING_PERL: { my $scr_count = <<'ENDSCRIPT'; <% foreach ( 1 .. 9 ) { %> <% } %>
<%= $_ %>
ENDSCRIPT my $res_count = <<'ENDSCRIPT';
1 2 3 4 5 6 7 8 9
ENDSCRIPT is $m->execute( text => $scr_count), $res_count; } Text-MicroMason-2.13/t/32-safe.t000644 002015 000024 00000007503 11513635576 016305 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 24; use Safe; use_ok 'Text::MicroMason', qw( safe_compile safe_execute try_safe_compile try_safe_execute ); ###################################################################### { my $scr_bold = '<% $ARGS{label} %>'; is safe_compile($scr_bold)->(label => 'Foo'), 'Foo'; is safe_execute($scr_bold, label => 'Foo'), 'Foo'; } ###################################################################### { my $scr_time = 'The time is <% time() %>'; ok !try_safe_compile( $scr_time ); ok !try_safe_execute( $scr_time ); } ###################################################################### { my $scr_time = 'The time is <% time() %>'; my $safe = Safe->new(); $safe->permit('time'); ok try_safe_compile( $safe, $scr_time ); ok try_safe_execute( $safe, $scr_time ); ok safe_compile( $safe, $scr_time )->(); ok safe_execute( $safe, $scr_time ); } ###################################################################### { local $^W; # no warnings uninitialized my $variable = 'secret'; my $scr_hidden = '<% $variable %>'; my ($output, $err) = try_safe_execute( $scr_hidden ); is $output, undef; like $err, qr/requires explicit package name/; } { local $^W; $main::variable = $main::variable = 'secret'; my $scr_hidden = '<% $main::variable %>'; unlike try_safe_execute( $scr_hidden ), qr/secret/; } { local $^W; $Foo::variable = $Foo::variable = 'secret'; my $scr_hidden = '<% $Foo::variable %>'; unlike try_safe_execute( $scr_hidden ), qr/secret/; } ###################################################################### { my $scr_mobj = 'You\'ve been compiled by <% ref $m %>.'; like safe_execute( $scr_mobj ), qr/Text::MicroMason::Safe::Facade/; } ###################################################################### SKIP: { skip "Safe doesn't die in Perl >= 5.13.1", 2 if $] >= 5.013001; my $script = qq| <& 'samples/test.msn', %ARGS &> |; my ($output, $err) = try_safe_execute($script, name => 'Sam', hour => 9); is $output, undef; like $err, qr/Can't call .*?execute/; } SKIP: { skip "Safe doesn't die in Perl >= 5.13.1", 2 if $] >= 5.013001; my $m = Text::MicroMason->new( '-Safe' ); my $script = qq| <& 'samples/test.msn', %ARGS &> |; my $output = eval{ $m->execute( text => $script, name => 'Sam', hour => 9)}; is $output, undef; like $@, qr/Can't call .*?execute/; } SKIP: { skip "safe_methods is deprecated because it can't work with modern Safe", 2; my $m = Text::MicroMason->new( '-Safe', safe_methods => 'execute' ); my $script = qq| <& 'samples/test.msn', %ARGS &> |; my $output = eval{ $m->execute( text => $script, name => 'Sam', hour => 9)}; ok length $output; ok !$@, "Execute produced error: $@"; } my $safe_dir_mason = Text::MicroMason->class( 'Safe', 'TemplateDir' ); SKIP: { skip "safe_methods is deprecated because it can't work with modern Safe", 2; my $m = Text::MicroMason->new( -TemplateDir, template_root => 'samples', strict_root => 1, '-Safe', safe_methods => 'execute', ); my $script = qq| <& 'test.msn', %ARGS &> |; my $output = eval{ $m->execute( text => $script, name => 'Sam', hour => 9)}; ok length $output; ok !$@, "Execute produced error: $@"; } SKIP: { skip "safe_methods is deprecated because it can't work with modern Safe", 2; my $m = Text::MicroMason->new( '-Safe', safe_methods => 'execute', -TemplateDir, template_root => 'samples', strict_root => 1 ); my $script = qq| <& '../MicroMason.pm', %ARGS &> |; my $output = eval{ $m->execute( text => $script, name => 'Sam', hour => 9)}; is $output, undef; like $@, qr/required base path/; } ###################################################################### Text-MicroMason-2.13/t/33-filters.t000644 002015 000024 00000010357 11513635576 017041 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 21; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -Filters ); my $res_nofilter = 'Hello <"world">!'; ###################################################################### # Test an expression inside a template using logical or. is $m->execute( text => q(Var is <% $ARGS{foo} || 0 %>) ), "Var is 0"; ###################################################################### # Test h encoding flag if we have HTML::Entities SKIP: { skip "HTML::Entities is not installed", 4 unless HTML::Entities->can('encode'); my $src_h = q(Hello <% '<"world">' |h %>!); my $res_h = 'Hello <"world">!'; is $m->execute(text => $src_h), $res_h, "Execute text with HTML::Entity filter"; # Test h as a default filter { local $m->{default_filters} = 'h'; my $src_h2 = q(Hello <% '<"world">' %>!); is $m->execute( text => $src_h2), $res_h, "Execute text with HTML::Entity default filter"; # Explicitly disable the default filters my $src_h3 = q(Hello <% '<"world">' | n %>!); is $m->execute( text => $src_h3), $res_nofilter, "Execute text with HTML::Entity default turned off"; } my $src_unh = qq(Hello <% '<"world">' |unh %>!); my $res_unh = 'Hello <"world">!'; is $m->execute( text => $src_unh), $res_unh, "Execute text with stacking h filter"; } # SKIP ###################################################################### # Test default u encoding flag if we have URI::Escape SKIP: { skip "URI::Escape is not installed", 8 unless URI::Escape->can('uri_escape'); my $res_u = 'Hello %3C%3Fworld%3F%3E!'; is $m->execute(text => qq(Hello <% "" |u %>!)), $res_u, "Execute text with URI::Escape filter"; ok my $res = eval {$m->execute(text => qq(Hello <% ""|u %>!))}, "Execute text with URI::Escape filter and no space"; is $res, $res_u; # Test |u encoding flag in a file ok $res = eval {$m->execute(file => 'samples/test-filter.msn', msg => "foo")}, "Execute text from file with URI::Escape filter and no space"; is $res, "foo", "Filter execution error: $@"; # Test u as a default filter { local $m->{default_filters} = 'u'; my $src_u2 = qq(Hello <% "" %>!); is $m->execute( text => $src_u2), $res_u, "Execute text with URI::Escape default filter"; # Explicitly disable the default filters my $src_u3 = qq(Hello <% "" | n %>!); my $res_u3 = q(Hello !); is $m->execute( text => $src_u3), "Hello !", "Execute text with URI::Escape default turned off"; } # Test stacking and canceling with n my $res_hnu = 'Hello %3C%3Fworld%3F%3E!'; my $src_hnu = qq(Hello <% "" |hnu %>!); is $m->execute( text => $src_hnu), $res_hnu, "Execute text with stacking u filter"; } ###################################################################### # Test custom filters sub f1 { $_ = shift; tr/elo/apy/; $_; } sub f2 { $_ = shift; s/wyrpd/birthday/; $_; } $m->filter_functions( f1 => \&f1 ); $m->filter_functions( f2 => \&f2 ); # Try one custom filter my $src_custom1 = qq(<% 'hello <"world">' | f1 %>); my $res_custom1 = qq(happy <"wyrpd">); is $m->execute( text => $src_custom1), $res_custom1; # Try two filters in order: they're order dependant, so this will fail # if they execute in the wrong order. my $src_custom2 = qq(<% 'hello <"world">' | f1 , f2 %>); my $res_custom2 = qq(happy <"birthday">); is $m->execute( text => $src_custom2), $res_custom2; # Try both filters as defaults { local $m->{default_filters} = 'f1, f2'; my $src_custom3 = qq(<% 'hello <"world">' %>); is $m->execute( text => $src_custom3), $res_custom2; # Override default filters my $src_custom4 = qq(<% 'hello <"world">' |n, f1 %>); is $m->execute( text => $src_custom4), $res_custom1; } # Try one default filter and one additional filter { local $m->{default_filters} = 'f1'; my $src_custom3 = qq(<% 'hello <"world">' %>); is $m->execute( text => $src_custom3), $res_custom1; my $src_custom4 = qq(<% 'hello <"world">' | f2 %>); is $m->execute( text => $src_custom4), $res_custom2; } Text-MicroMason-2.13/t/84-func-errors.t000644 002015 000024 00000001455 11513635576 017643 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 16; use_ok 'Text::MicroMason', qw( compile execute try_compile try_execute ); ###################################################################### my $scr_syn = '<% if ( 1 ) %>'; is eval { compile($scr_syn) }, undef; like $@, qr/MicroMason compilation failed/; like $@, qr/syntax error/; is try_compile($scr_syn), undef; is try_execute($scr_syn), undef; my $scr_die = '<% die "FooBar" %>'; ok compile($scr_die); is eval { execute($scr_die) }, undef; like $@, qr/MicroMason execution failed/; like $@, qr/FooBar/; isa_ok try_compile($scr_die), 'CODE'; is try_execute($scr_die), undef; # try_execute can return the $@ ok my ($r, $ok) = try_execute($scr_die); is $r, undef; like $ok, qr/MicroMason execution failed/; like $ok, qr/FooBar/; Text-MicroMason-2.13/t/37-post_process.t000644 002015 000024 00000004501 11272642676 020113 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 26; use_ok 'Text::MicroMason'; ###################################################################### LC: { ok my $m = Text::MicroMason->new( -PostProcess ); ok $m->post_processors( sub { lc } ); is $m->execute( text=>'Hello there!'), 'hello there!'; } ###################################################################### UC_NEW: { ok my $m = Text::MicroMason->new( -PostProcess, post_process => sub { uc } ); is $m->execute( text=>'Hello there!' ), 'HELLO THERE!'; } UC_PPMETH: { ok my $m = Text::MicroMason->new( -PostProcess ); ok $m->post_processors( sub { uc } ); is $m->execute( text=>'Hello there!' ), 'HELLO THERE!'; } UC_COMPILE: { ok my $m = Text::MicroMason->new( -PostProcess ); ok my $subdef = $m->compile( text=>'Hello there!', post_process => sub { uc } ); is $subdef->(), 'HELLO THERE!'; } UC_EXECUTE: { ok my $m = Text::MicroMason->new( -PostProcess ); is $m->execute( text=>'Hello there!', { post_process => sub { uc } } ), 'HELLO THERE!'; } ###################################################################### sub f1 { $_ = shift; tr/elo/apy/; $_; } sub f2 { $_ = shift; s/ello/ola/; s/wyrpd/birthday/; $_; } ORDERED_F1: { ok my $m = Text::MicroMason->new( -PostProcess, post_process => \&f1 ); is $m->execute( text=>'Hello world!' ), 'Happy wyrpd!'; } ORDERED_F2: { ok my $m = Text::MicroMason->new( -PostProcess, post_process => \&f2 ); is $m->execute( text=>'Hello world!' ), 'Hola world!'; } ORDERED_F1F2: { ok my $m = Text::MicroMason->new( -PostProcess, post_process => [ \&f1, \&f2 ] ); is $m->execute( text=>'Hello world!' ), 'Happy birthday!'; } ORDERED_F2F1: { ok my $m = Text::MicroMason->new( -PostProcess, post_process => [ \&f2, \&f1 ] ); is $m->execute( text=>'Hello world!' ), 'Hypa wyrpd!'; } ###################################################################### sub naf1 () { tr/elo/apy/; } sub naf2 () { s/ello/ola/; s/wyrpd/birthday/; } EMPTY_PROTOTYPES: { ok my $m = Text::MicroMason->new( -PostProcess ); ok $m->post_processors( \&naf1 ); ok $m->post_processors( \&naf2 ); is $m->execute( text=>'Hello world!' ), 'Happy birthday!'; } ###################################################################### Text-MicroMason-2.13/t/36-template_dir.t000644 002015 000024 00000002041 11272642676 020035 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 6; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -CatchErrors, -TemplateDir, template_root => 'samples/' ); ###################################################################### FILE: { like $m->execute( file=>'test.msn', name=>'Sam', hour => 14), qr/\QGood afternoon, Sam!\E/; } ###################################################################### TAG: { my $scr_hello = "<& 'test-relative.msn', name => 'Dave' &>"; my $res_hello = "Test greeting:\n" . 'Good afternoon, Dave!' . "\n"; is $m->execute(text=>$scr_hello), $res_hello; } ###################################################################### BASE: { ok my $m = Text::MicroMason->new( -CatchErrors, -TemplateDir ); my $scr_hello = "<& 'samples/test-relative.msn', name => 'Dave' &>"; my $res_hello = "Test greeting:\n" . 'Good afternoon, Dave!' . "\n"; is $m->execute(text=>$scr_hello), $res_hello; } ###################################################################### Text-MicroMason-2.13/t/31-catch_errors.t000644 002015 000024 00000001224 11272642676 020037 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 12; use_ok 'Text::MicroMason', qw( compile execute try_compile try_execute ); ###################################################################### my $scr_syn = '<% if ( 1 ) %>'; is eval { compile($scr_syn) }, undef; like $@, qr/MicroMason compilation failed/; like $@, qr/syntax error/; is try_compile($scr_syn), undef; is try_execute($scr_syn), undef; my $scr_die = '<% die "FooBar" %>'; ok compile($scr_die); is eval { execute($scr_die) }, undef; like $@, qr/MicroMason execution failed/; like $@, qr/FooBar/; isa_ok try_compile($scr_die), 'CODE'; is try_execute($scr_die), undef; Text-MicroMason-2.13/t/86-func-safe.t000644 002015 000024 00000001345 11272642676 017246 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 11; use_ok 'Text::MicroMason', qw( safe_compile safe_execute try_safe_compile try_safe_execute ); ###################################################################### my $scr_bold = '<% $ARGS{label} %>'; is (safe_compile($scr_bold)->(label=>'Foo'), 'Foo'); is (safe_execute($scr_bold, label=>'Foo'), 'Foo'); my $scr_time = 'The time is <% time() %>'; is try_safe_compile( $scr_time ), undef; is try_safe_execute( $scr_time ), undef; ok my $safe = Safe->new(); ok $safe->permit('time'); ok (try_safe_compile( $safe, $scr_time )); ok (try_safe_execute( $safe, $scr_time )); ok (safe_compile( $safe, $scr_time )->()); ok (safe_execute( $safe, $scr_time )); Text-MicroMason-2.13/t/83-func-blocks.t000644 002015 000024 00000005175 11272642676 017607 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 22; use_ok 'Text::MicroMason', qw( compile execute ); ###################################################################### SIMPLE_ARGS: { my $scr_bold = '<%args>$label<% $label %>'; is execute($scr_bold, label=>'Foo'), 'Foo'; is compile($scr_bold)->(label=>'Foo'), 'Foo'; is eval { execute($scr_bold); 1 }, undef; ok $@; } ###################################################################### ARGS_BLOCK_WITH_DEFAULT: { my $scr_hello = <<'ENDSCRIPT'; <%args> $name $hour => (localtime)[2] % if ( $name eq 'Dave' ) { I'm sorry <% $name %>, I'm afraid I can't do that right now. % } else { <%perl> my $greeting = ( $hour > 11 ) ? 'afternoon' : 'morning'; Good <% $greeting %>, <% $name %>! % } ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Good afternoon, World! ENDSCRIPT is execute($scr_hello, name => 'World', hour => 13), $res_hello; is compile($scr_hello)->(name => 'World', hour => 13), $res_hello; like execute($scr_hello, name => 'World'), qr/Good (afternoon|morning), World!/; is eval { execute($scr_hello, hour => 13); 1 }, undef; ok $@; is eval { execute($scr_hello); 1 }, undef; ok $@; } ###################################################################### SIMPLE_INIT_BLOCK: { my $scr_hello = <<'ENDSCRIPT'; I'm sorry <% $name %>, I'm afraid I can't do that right now. <%init> my $name = 'Dave'; ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; I'm sorry Dave, I'm afraid I can't do that right now. ENDSCRIPT is execute($scr_hello), $res_hello; is compile($scr_hello)->(), $res_hello; } ###################################################################### SIMPLE_ONCE_BLOCK: { my $scr_hello = <<'ENDSCRIPT'; I'm sorry <% $name %>, I'm afraid I can't do that right now. <%once> my $name = 'Dave'; ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; I'm sorry Dave, I'm afraid I can't do that right now. ENDSCRIPT is execute($scr_hello), $res_hello; is compile($scr_hello)->(), $res_hello; } ###################################################################### ONCE_AND_INIT_BLOCKS: { my $scr_count = <<'ENDSCRIPT'; The count is now <% $count %>. <%once> my $count = 100; <%init> $count ++; ENDSCRIPT is execute($scr_count), "The count is now 101.\n"; is compile($scr_count)->(), "The count is now 101.\n"; ok my $sub_count = compile($scr_count); is $sub_count->(), "The count is now 101.\n"; is $sub_count->(), "The count is now 102.\n"; is $sub_count->(), "The count is now 103.\n"; } Text-MicroMason-2.13/t/82-func-perl.t000644 002015 000024 00000003757 11272642676 017277 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 204; use_ok 'Text::MicroMason', qw( compile execute ); ###################################################################### FLOW_CONTROL: { my $scr_rand = <<'ENDSCRIPT'; % if ( int rand 2 ) { Hello World! % } else { Goodbye Cruel World! % } ENDSCRIPT my $scriptlet = compile($scr_rand); for ( 0 .. 99 ) { ok my $result = $scriptlet->(); like $result, qr/^ (Hello World!|Goodbye Cruel World!)$/; } } ###################################################################### PERL_BLOCK: { my $scr_count = <<'ENDSCRIPT'; Counting... <%perl> foreach ( 1 .. 9 ) { $_out->( $_ ) } Done! ENDSCRIPT my $res_count = <<'ENDSCRIPT'; Counting... 123456789Done! ENDSCRIPT is execute($scr_count), $res_count; } SPANNING_PERL: { my $scr_count = <<'ENDSCRIPT'; <%perl> foreach ( 1 .. 9 ) { <%perl> }
<% $_ %>
ENDSCRIPT my $res_count = <<'ENDSCRIPT';
1 2 3 4 5 6 7 8 9
ENDSCRIPT is execute($scr_count), $res_count; } ###################################################################### SUBTEMPLATE: { my $scr_closure = <<'ENDSCRIPT'; % my $draw_item = sub { % my $item = shift;

<% $item %>
Find out more about <% $item %>.

% };

We've Got Items!

% foreach my $item ( qw( Foo Bar Baz ) ) { % $draw_item->( $item ); % } ENDSCRIPT my $res_closure = <<'ENDSCRIPT';

We've Got Items!

Foo
Find out more about Foo.

Bar
Find out more about Bar.

Baz
Find out more about Baz.

ENDSCRIPT is execute($scr_closure), $res_closure; } Text-MicroMason-2.13/t/34-compile_cache.t000644 002015 000024 00000012276 11272642676 020150 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Text::MicroMason; use Test::More tests => 46; use File::Copy; use Carp; $SIG{__DIE__} = \&Carp::confess; ###################################################################### { ok my $m = Text::MicroMason->new(); use vars qw( $count_sub $sub_count $local_count ); $sub_count = 0; $local_count = 0; my $count_scr = q{<%once> ++ $::sub_count; my $count; <%perl> ++ $::local_count; <% ++ $count; %>}; for ( 1 .. 3 ) { $count_sub = $m->compile( text => $count_scr ); for ( 1 .. 3 ) { $count_sub->($_); } } is $sub_count, 3; is $local_count, 9; is $count_sub->(), 4; } ###################################################################### { ok my $m = Text::MicroMason->new( -CompileCache ); use vars qw( $count_sub $sub_count $local_count ); $sub_count = 0; $local_count = 0; my $count_scr = q{<%once> ++ $::sub_count; my $count; <%perl> ++ $::local_count; <% ++ $count; %>}; for ( 1 .. 3 ) { $count_sub = $m->compile( text => $count_scr ); for ( 1 .. 3 ) { $count_sub->($_); } } is $sub_count, 1; is $local_count, 9; is $count_sub->(), 10; } ###################################################################### { ok my $m = Text::MicroMason->new( -CompileCache, -ExecuteCache ); use vars qw( $count_sub $sub_count $local_count ); $sub_count = 0; $local_count = 0; my $count_scr = q{<%once> ++ $::sub_count; my $count; <%perl> ++ $::local_count; <% ++ $count; %>}; for ( 1 .. 3 ) { $count_sub = $m->compile( text => $count_scr ); for ( 1 .. 3 ) { $count_sub->($_); } } is $sub_count, 1; is $local_count, 3; is $count_sub->(), 4; } ###################################################################### { ok my $m = Text::MicroMason->new( -ExecuteCache, -CompileCache ); use vars qw( $count_sub $sub_count $local_count ); $sub_count = 0; $local_count = 0; my $count_scr = q{<%once> ++ $::sub_count; my $count; <%perl> ++ $::local_count; <% ++ $count; %>}; for ( 1 .. 3 ) { $count_sub = $m->compile( text => $count_scr ); for ( 1 .. 3 ) { $count_sub->($_); } } is $sub_count, 1; is $local_count, 3; is $count_sub->(), 4; } ###################################################################### # Test using $m->execute directly: This should compile and run it # properly. Running execute 10 times is like running compile once, # then calling the resulting sub 10 times. { ok my $m = Text::MicroMason->new( -CompileCache ); use vars qw( $count_sub $sub_count $local_count ); $sub_count = 0; $local_count = 0; my $count_scr = q{<%once> ++ $::sub_count; my $count; <%perl> ++ $::local_count; <% ++ $count; %>}; for ( 1 .. 10 ) { $m->execute( text => $count_scr ); } is $sub_count, 1; is $local_count, 10; } ###################################################################### # Test using $m->execute directly, on a file. { ok my $m = Text::MicroMason->new( -CompileCache ); use vars qw( $count_sub $sub_count $local_count ); $sub_count = 0; $local_count = 0; for ( 1 .. 10 ) { ok $m->execute( file => "samples/t-counter.msn" ); } is $sub_count, 1; is $local_count, 10; } ###################################################################### # Testss submitted via rt.cpan.org by Jon Warbrick on #21802 copy('samples/t-counter.msn','samples/t34a.msn'); ###################################################################### # Test cache expiration using $m->execute directly on a file { ok my $m = Text::MicroMason->new( -CompileCache ); use vars qw( $count_sub $sub_count $local_count ); $sub_count = 0; $local_count = 0; my $time = time-5; utime $time, $time, "samples/t34a.msn"; for ( 1 .. 2 ) { ok $m->execute( file => "samples/t34a.msn" ); } $time = time; utime $time, $time, "samples/t34a.msn"; sleep 2; # to defeat not checking more than once per second for ( 1 .. 2 ) { ok $m->execute( file => "samples/t34a.msn" ); } is $sub_count, 2; is $local_count, 4; } ###################################################################### # Test cache expiration using $m->execute directly on a file, using -TemplateDir { ok my $m = Text::MicroMason->new( -CompileCache, -TemplateDir, template_root => 'samples' ); use vars qw( $count_sub $sub_count $local_count ); $sub_count = 0; $local_count = 0; my $time = time-5; utime $time, $time, "samples/t34a.msn"; for ( 1 .. 2 ) { ok $m->execute( file => "t34a.msn" ); } $time = time; utime $time, $time, "samples/t34a.msn"; sleep 2; # to defeat not checking more than once per second; sleep 1 triggered false cpants fail for ( 1 .. 2 ) { ok $m->execute( file => "t34a.msn" ); } is $sub_count, 2; is $local_count, 4; } ###################################################################### unlink('samples/t34a.msn'); Text-MicroMason-2.13/t/00-startup.t000644 002015 000024 00000000157 11272642676 017063 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 1; use_ok 'Text::MicroMason', qw( compile execute ); Text-MicroMason-2.13/t/04-blocks.t000644 002015 000024 00000003232 11272642676 016637 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 12; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new(); ###################################################################### SIMPLE_INIT_BLOCK: { my $scr_hello = <<'ENDSCRIPT'; I'm sorry <% $name %>, I'm afraid I can't do that right now. <%init> my $name = 'Dave'; ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; I'm sorry Dave, I'm afraid I can't do that right now. ENDSCRIPT is $m->execute( text => $scr_hello), $res_hello; is $m->compile( text => $scr_hello)->(), $res_hello; } ###################################################################### SIMPLE_ONCE_BLOCK: { my $scr_hello = <<'ENDSCRIPT'; I'm sorry <% $name %>, I'm afraid I can't do that right now. <%once> my $name = 'Dave'; ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; I'm sorry Dave, I'm afraid I can't do that right now. ENDSCRIPT is $m->execute( text => $scr_hello), $res_hello; is $m->compile( text => $scr_hello)->(), $res_hello; } ###################################################################### ONCE_AND_INIT_BLOCKS: { my $scr_count = <<'ENDSCRIPT'; The count is now <% $count %>. <%once> my $count = 100; <%init> $count ++; ENDSCRIPT is $m->execute( text => $scr_count), "The count is now 101.\n"; is $m->compile( text => $scr_count)->(), "The count is now 101.\n"; ok my $sub_count = $m->compile(text => $scr_count); is $sub_count->(), "The count is now 101.\n"; is $sub_count->(), "The count is now 102.\n"; is $sub_count->(), "The count is now 103.\n"; } ###################################################################### Text-MicroMason-2.13/t/02-perl.t000644 002015 000024 00000004112 11272642676 016320 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 105; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new(); ###################################################################### FLOW_CONTROL: { my $scr_rand = <<'ENDSCRIPT'; % if ( int rand 2 ) { Hello World! % } else { Goodbye Cruel World! % } ENDSCRIPT my $scriptlet = $m->compile( text => $scr_rand); for ( 0 .. 99 ) { like $scriptlet->(), qr/^ (Hello|Goodbye Cruel) World!\n$/; } } ###################################################################### PERL_BLOCK: { my $scr_count = <<'ENDSCRIPT'; Counting... <%perl> foreach ( 1 .. 9 ) { $_out->( $_ ) } Done! ENDSCRIPT my $res_count = <<'ENDSCRIPT'; Counting... 123456789Done! ENDSCRIPT is $m->execute( text => $scr_count), $res_count; } SPANNING_PERL: { my $scr_count = <<'ENDSCRIPT'; <%perl> foreach ( 1 .. 9 ) { <%perl> }
<% $_ %>
ENDSCRIPT my $res_count = <<'ENDSCRIPT';
1 2 3 4 5 6 7 8 9
ENDSCRIPT is $m->execute( text => $scr_count), $res_count; } ###################################################################### SUBTEMPLATE: { my $scr_closure = <<'ENDSCRIPT'; % my $draw_item = sub { % my $item = shift;

<% $item %>
Find out more about <% $item %>.

% };

We've Got Items!

% foreach my $item ( qw( Foo Bar Baz ) ) { % $draw_item->( $item ); % } ENDSCRIPT my $res_closure = <<'ENDSCRIPT';

We've Got Items!

Foo
Find out more about Foo.

Bar
Find out more about Bar.

Baz
Find out more about Baz.

ENDSCRIPT ok( $m->execute( text => $scr_closure), $res_closure ); } ###################################################################### Text-MicroMason-2.13/t/38-allow_globals.t000644 002015 000024 00000001702 11272642676 020212 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 13; use_ok 'Text::MicroMason'; ###################################################################### { ok my $m = Text::MicroMason->new( -AllowGlobals ); ok $m->allow_globals( '$name' ); is $m->execute( text=>'Hello <% $name || "" %>!' ), 'Hello !'; } ###################################################################### { ok my $m = Text::MicroMason->new( -AllowGlobals ); ok $m->allow_globals( '$name' ); ok $m->set_globals( '$name' => 'Bob' ); is $m->execute( text=>'Hello <% $name %>!' ), 'Hello Bob!'; } ###################################################################### { ok my $m = Text::MicroMason->new( -AllowGlobals ); ok $m->allow_globals( '$count' ); ok my $sub = $m->compile( text=>'Item <% ++ $count %>.' ); is $sub->(), 'Item 1.'; is $sub->(), 'Item 2.'; } ###################################################################### Text-MicroMason-2.13/t/06-masonobj.t000644 002015 000024 00000000715 11272642676 017177 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 3; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new(); ###################################################################### { my $scr_mobj = 'You\'ve been compiled by <% ref $m %>.'; my $res_mobj = 'You\'ve been compiled by Text::MicroMason'; like $m->execute( text => $scr_mobj), qr/^\Q$res_mobj\E/; } ###################################################################### Text-MicroMason-2.13/t/53-html_template.t000644 002015 000024 00000003240 11272642676 020224 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 24; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -HTMLTemplate, template_root => 'samples', 'debug' => 0 ); ###################################################################### # test a simple template ok my $template = $m->new(filename => 'simple.tmpl'); ok $template->param( 'ADJECTIVE', 'very' ); ok my $output = $template->output(); unlike $output, qr/ADJECTIVE/; is $template->param('ADJECTIVE'), 'very'; ###################################################################### # test a simple loop template ok $template = $m->new( filename => 'loop-simple.tmpl' ); ok $template->param('ADJECTIVE_LOOP', [ { ADJECTIVE => 'really' }, { ADJECTIVE => 'very' } ] ); ok $output = $template->output(); unlike $output, qr/ADJECTIVE_LOOP/; like $output, qr/really.*very/s; ###################################################################### # test a loop template with context ok $template = $m->new( filename => 'loop-context.tmpl', loop_context_vars => 1 ); ok $template->param('ADJECTIVE_LOOP', [ { ADJECTIVE => 'really' }, { ADJECTIVE => 'very' } ] ); ok $output = $template->output(); unlike $output, qr/ADJECTIVE_LOOP/; like $output, qr/really.*very/s; ###################################################################### # test a simple if template ok $template = $m->new( filename => 'if.tmpl' ); ok $output = $template->output(); unlike $output, qr/INSIDE/; # test a simple if template ok $template = $m->new( filename => 'if.tmpl' ); ok $template->param(BOOL => 1); ok $output = $template->output(); like $output, qr/INSIDE/; ###################################################################### Text-MicroMason-2.13/t/92-template_path-cache.t000644 002015 000024 00000002214 11272642676 021260 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 9; use_ok 'Text::MicroMason'; # Test TemplatePath with CompileCache ###################################################################### # # Compile and cache test-relative.msn with one path. Executing it again # with a different path should get us different results. my $m1 = Text::MicroMason->new( -CompileCache, -TemplatePath, template_path => [ qw(samples/subdir/ samples/) ]); PATH1: { ok (my $scr_hello = $m1->execute( file => 'test-relative.msn', name => 'Dave')); ok (my $res_hello = "Test greeting:\nGuten Tag, Dave!\n"); like ($scr_hello, qr/\Q$res_hello\E/); like ($m1->execute(text => $scr_hello), qr/\Q$res_hello\E/); } my $m2 = Text::MicroMason->new( -CompileCache, -TemplatePath, template_path => [ qw(samples/ samples/subdir/) ]); PATH2: { ok (my $scr_hello = $m2->execute( file => 'test-relative.msn', name => 'Dave')); ok (my $res_hello = "Test greeting:\nGood afternoon, Dave!\n"); like ($scr_hello, qr/\Q$res_hello\E/); like ($m2->execute(text => $scr_hello), qr/\Q$res_hello\E/); } Text-MicroMason-2.13/t/52-text_template.t000644 002015 000024 00000004045 11272642676 020247 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More; if (eval { require Text::Balanced }) { plan tests => 18; } else { plan skip_all => 'Text::Template emulator requires Text::Balanced'; } use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -TextTemplate ); ###################################################################### my $scr_hello = <<'ENDSCRIPT'; Dear {$recipient}, Pay me at once. Love, G.V. ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Dear King, Pay me at once. Love, G.V. ENDSCRIPT is $m->execute( text => $scr_hello, recipient => 'King' ), $res_hello; is $m->compile( text => $scr_hello)->( recipient => 'King' ), $res_hello; ###################################################################### { no strict; $source = 'We will put value of $v (which is "good") here -> {$v}'; $v = 'oops (main)'; $Q::v = 'oops (Q)'; $vars = { 'v' => \'good' }; # (1) Build template from string ok $template = $m->compile( 'text' => $source ); ok ref $template; # (2) Fill in template in anonymous package $result2 = 'We will put value of $v (which is "good") here -> good'; ok $text = $template->(%$vars); is $text, $result2; # (3) Did we clobber the main variable? ok($v, 'oops (main)'); # (4) Fill in same template again $result4 = 'We will put value of $v (which is "good") here -> good'; ok $text = $template->(%$vars); is $text, $result4; # (5) Now with a package $result5 = 'We will put value of $v (which is "good") here -> good'; ok $template = $m->new(package => 'Q')->compile( 'text' => $source ); ok $text = $template->(%$vars); is $text, $result5; # (6) We expect to have clobbered the Q variable. is $Q::v, 'good'; # (7) Now let's try it without a package $result7 = 'We will put value of $v (which is "good") here -> good'; ok $template = $m->new()->compile( 'text' => $source ); ok $text = $template->(%$vars); is $text, $result7; } ###################################################################### Text-MicroMason-2.13/t/89-func-regression.t000644 002015 000024 00000011624 11272642676 020514 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 25; use_ok 'Text::MicroMason', qw(compile execute); ###################################################################### MINIMAL_CASES: { is (execute(''), '' ); is (execute(' '), ' ' ); is (execute("0"), "0" ); is (execute("\n"), "\n" ); } ###################################################################### EMPTY_PERL_LINE: { my $scr_re = "x\n%\nx"; my $res_re = "x\nx"; is (execute($scr_re), $res_re); } ###################################################################### SINGLE_PERL_LINE: { my $scr_re = '% $_out->("Potato"); '; my $res_re = "Potato"; is (execute($scr_re), $res_re); } ###################################################################### EMPTY_PERL_BLOCK: { my $scr_re = '<%perl>'; is (execute($scr_re), ''); } ###################################################################### SINGLE_PERL_BLOCK: { my $scr_re = '<%perl> my $x = time(); '; is (execute($scr_re), ''); } ###################################################################### MULTISTATEMENT_EXPR_BLOCK: { my $scr_re = '<% my $x = time(); $x %>'; is (execute($scr_re), time()); } ###################################################################### MULTIPLE_PERL_BLOCKS: { my $scr_re = '<%perl> my $x = time(); if (0) { <%perl> } '; is (execute($scr_re), ''); } ###################################################################### SINGLE_PERL_LINE_NEWLINES: { my $scr_re = "\n" . '% $_out->("Potato"); ' . "\n\n"; my $res_re = "\nPotato\n"; is (execute($scr_re), $res_re); } ###################################################################### NEWLINES_AND_PERL_LINES: { my $scr_hello = <<'ENDSCRIPT'; % if (1) { <% "Does this work" %> % } correctly? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Does this work correctly? ENDSCRIPT is (execute($scr_hello), $res_hello); } ###################################################################### NEWLINES_AND_PERL_LINES: { my $scr_hello = <<'ENDSCRIPT'; % if ( $ARGS{name} eq 'Dave' ){ I'm sorry <% $ARGS{name} %>, I'm afraid I can't do that right now. % } else { Good afternoon, <% $ARGS{name} %>! % } ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Good afternoon, Bob! ENDSCRIPT is (execute($scr_hello, name => 'Bob'), $res_hello); is (compile($scr_hello)->( name => 'Bob' ), $res_hello); } ###################################################################### PERL_BLOCK_AT_EOF: { my $scr_hello = 'Hello World<%perl>my $x = time();'; my $res_hello = 'Hello World'; is (execute($scr_hello), $res_hello); } ###################################################################### ANGLE_PERCENT_BLOCK_AT_EOF: { my $scr_hello = '% my $noun = "World";' . "\n" . 'Hello <% $noun %>'; my $res_hello = 'Hello World'; is (execute($scr_hello), $res_hello); } ###################################################################### FILE_BLOCK_AT_EOF: { my $scr_hello = "<& 'samples/test-recur.msn', name => 'Dave' &>"; my $res_hello = "Test greeting:\n" . 'Good afternoon, Dave!' . "\n"; is (execute($scr_hello), $res_hello); } ###################################################################### LOOKS_LIKE_HTML: { my $scr_hello = '
Hi
'; is (execute($scr_hello), $scr_hello); } ###################################################################### STRICT_VARS: { my $scr_re = '% $foo ++; '; is eval { execute($scr_re); 1 }, undef; ok $@; } ###################################################################### MULTILINE_STATEMENT_BLOCK: { my $scr_hash = <<'ENDSCRIPT'; <%perl> my %thing = ( name => "disturbance", rank => "major", serial => "2" ); % foreach my $key (sort keys %thing) { % }
<% $key %> <% $thing{$key} %>
ENDSCRIPT my $res_hash = <<'ENDSCRIPT';
name disturbance
rank major
serial 2
ENDSCRIPT ok my $test_result = execute($scr_hash); is $test_result, $res_hash; } ###################################################################### MULTILINE_STATEMENT: { my $scr_hash = <<'ENDSCRIPT'; % my %thing = ( % name => "mills", % rank => "general", % serial => "1" % ); % foreach my $key (sort keys %thing) { % }
<% $key %> <% $thing{$key} %>
ENDSCRIPT my $res_hash = <<'ENDSCRIPT';
name mills
rank general
serial 1
ENDSCRIPT ok my $test_result = execute($scr_hash); is $test_result, $res_hash; } ###################################################################### Text-MicroMason-2.13/t/55-doublequote.t000644 002015 000024 00000003763 11272642676 017731 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 20; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason::Base->new( -DoubleQuote ); ###################################################################### { my $scr_hello = 'Hello $ARGS{noun}!'; my $res_hello = 'Hello World!'; is $m->execute( text => $scr_hello, noun => 'World'), $res_hello; is $m->compile( text => $scr_hello)->(noun => 'World'), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->(noun => 'World'), $res_hello; is $scriptlet->(noun => 'World'), $res_hello; } ###################################################################### { my $scr_hello = <<'ENDSCRIPT'; ${ $::noun = 'World'; \( "" ) }Hello $::noun! How are ya? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Hello World! How are ya? ENDSCRIPT is $m->execute( text => $scr_hello, noun => 'World'), $res_hello; is $m->compile( text => $scr_hello)->(noun => 'World'), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->(noun => 'World'), $res_hello; is $scriptlet->(noun => 'World'), $res_hello; } ###################################################################### { ok my $m = Text::MicroMason::Base->new( -DoubleQuote, -PassVariables ); my $scr_hello = 'Hello $noun!'; my $res_hello = 'Hello World!'; is $m->execute( text => $scr_hello, noun => 'World'), $res_hello; is $m->compile( text => $scr_hello)->(noun => 'World'), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->(noun => 'World'), $res_hello; is $scriptlet->(noun => 'World'), $res_hello; } ###################################################################### { ok my $m = Text::MicroMason::Base->new( -DoubleQuote, -PassVariables ); my $res_hello = "Hello World!\n"; is $m->execute( handle => \*DATA, noun => 'World'), $res_hello; } ###################################################################### __DATA__ Hello $noun! Text-MicroMason-2.13/t/41-line_numbers.t000644 002015 000024 00000005725 11513635576 020055 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 37; use_ok 'Text::MicroMason'; ###################################################################### { ok my $m = Text::MicroMason->new( -LineNumbers ); ok my $output = eval { $m->execute( text=>'Hello <% $_[0] %>!', 'world' ) }; is $@, ''; is $output, 'Hello world!'; } ###################################################################### { ok my $m = Text::MicroMason->new( -LineNumbers ); ok my $output = eval { $m->interpret( text=>'1' ) }; is $@, ''; like $output, qr{# line 0 "text template [(]compiled at \S+line_numbers.t line \d+[)]"}; } ###################################################################### { ok my $m = Text::MicroMason->new( -LineNumbers ); is eval { $m->execute( text=>'Hello <% $__[] %>!', 'world' ) }, undef; like $@, qr{requires explicit package name at text template [(]compiled at \S+.t line \d+[)] line 1}; } { ok my $m = Text::MicroMason->new( -LineNumbers ); is eval { $m->execute( text=> "\n\n" . 'Hello <% $__[] %>!', 'world' ) }, undef; like $@, qr{requires explicit package name at text template [(]compiled at \S+.t line \d+[)] line 3}; } ###################################################################### { ok my $m = Text::MicroMason->new( -LineNumbers ); ok my $output = eval { $m->execute( inline=>'Hello <% $_[0] %>!', 'world' ) }; is $@, ''; is $output, 'Hello world!'; } { ok my $m = Text::MicroMason->new( -LineNumbers ); ok my $output = eval { $m->interpret( inline=>'1' ) }; is $@, ''; like $output, qr{# line \d+ "\S+line_numbers.t"}; } { ok my $m = Text::MicroMason->new( -LineNumbers ); is eval { $m->execute( inline => 'Hello <% $__[] %>!', 'world' ) }, undef; my $line = __LINE__; like $@, qr{requires explicit package name at \S+.t line \Q$line\E}; } ###################################################################### { ok my $m = Text::MicroMason->new( -LineNumbers ); ok my $output = eval { $m->execute( file=>'samples/test.msn', name=>'Sam', hour=>14 ) }; is $@, ''; like $output, qr/\QGood afternoon, Sam!\E/; } { ok my $m = Text::MicroMason->new( -LineNumbers ); is eval { $m->execute( file=>'samples/die.msn' ) }, undef; is $@, "MicroMason execution failed: Foo! at samples/die.msn line 1.\n"; } ###################################################################### SKIP: { skip "Test::Warn is not installed", 4 unless eval { require Test::Warn; }; use warnings; ok my $m = Text::MicroMason->new( -LineNumbers ); Test::Warn::warnings_like(sub { ok my $output = eval { $m->execute( file => 'samples/uninitialized.msn' ) }; is $@, ''; }, [ qr/^Use of uninitialized value.*at samples\/uninitialized\.msn line 1/, qr/^Use of uninitialized value.*at samples\/uninitialized\.msn line 8/, ]); } Text-MicroMason-2.13/t/09-regression.t000644 002015 000024 00000011425 11300341372 017527 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 25; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new(); ###################################################################### MINIMAL_CASES: { is $m->execute( text => ''), ''; is $m->execute( text => ' '), ' '; is $m->execute( text => "0"), "0"; is $m->execute( text => "\n"), "\n"; } ###################################################################### COMMENT_EXPR: { my $scr_re = 'Hello <% # foo %> World!'; my $res_re = "Hello World!"; is $m->execute( text => $scr_re), $res_re; } ###################################################################### EMPTY_PERL_LINE: { my $scr_re = "x\n%\nx"; my $res_re = "x\nx"; is $m->execute( text => $scr_re), $res_re; } ###################################################################### COMMENT_PERL_LINE: { my $scr_re = "x\n% # \nx"; my $res_re = "x\nx"; is $m->execute( text => $scr_re), $res_re; } ###################################################################### SINGLE_PERL_LINE: { my $scr_re = '% $_out->("Potato"); '; my $res_re = "Potato"; is $m->execute( text => $scr_re), $res_re; } ###################################################################### EMPTY_PERL_BLOCK: { my $scr_re = '<%perl>'; is $m->execute( text => $scr_re), ''; } ###################################################################### SINGLE_PERL_BLOCK: { my $scr_re = '<%perl> my $x = time(); '; is $m->execute( text => $scr_re), ''; } ###################################################################### MULTISTATEMENT_EXPR_BLOCK: { my $scr_re = '<% my $x = time(); $x %>'; is $m->execute( text => $scr_re), time(); } ###################################################################### MULTIPLE_PERL_BLOCKS: { my $scr_re = '<%perl> my $x = time(); if (0) { <%perl> } '; is $m->execute( text => $scr_re), ''; } ###################################################################### SINGLE_PERL_LINE_NEWLINES: { my $scr_re = "\n" . '% $_out->("Potato"); ' . "\n\n"; my $res_re = "\nPotato\n"; is $m->execute( text => $scr_re), $res_re; } ###################################################################### NEWLINES_AND_PERL_LINES: { my $scr_hello = <<'ENDSCRIPT'; % if (1) { <% "Does this work" %> % } correctly? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Does this work correctly? ENDSCRIPT is $m->execute( text => $scr_hello), $res_hello; } ###################################################################### NEWLINES_AND_PERL_LINES: { my $scr_hello = <<'ENDSCRIPT'; % if ( $ARGS{name} eq 'Dave' ){ I'm sorry <% $ARGS{name} %>, I'm afraid I can't do that right now. % } else { Good afternoon, <% $ARGS{name} %>! % } ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Good afternoon, Bob! ENDSCRIPT is $m->execute( text => $scr_hello, name => 'Bob'), $res_hello; is $m->compile( text => $scr_hello)->( name => 'Bob' ), $res_hello; } ###################################################################### PERL_BLOCK_AT_EOF: { my $scr_hello = 'Hello World<%perl>my $x = time();'; my $res_hello = 'Hello World'; is $m->execute( text => $scr_hello), $res_hello; } ###################################################################### ANGLE_PERCENT_BLOCK_AT_EOF: { my $scr_hello = '% my $noun = "World";' . "\n" . 'Hello <% $noun %>'; my $res_hello = 'Hello World'; is $m->execute( text => $scr_hello), $res_hello; } ###################################################################### FILE_BLOCK_AT_EOF: { my $scr_hello = "<& 'samples/test-recur.msn', name => 'Dave' &>"; my $res_hello = "Test greeting:\n" . 'Good afternoon, Dave!' . "\n"; is $m->execute( text => $scr_hello), $res_hello; } ###################################################################### LOOKS_LIKE_HTML: { my $scr_hello = '
Hi
'; is $m->execute( text => $scr_hello), $scr_hello; } ###################################################################### STRICT_VARS: { my $scr_re = '% $foo ++; '; is eval { $m->execute( text => $scr_re); 1 }, undef; } ###################################################################### FILE_BLOCK_MULTILINE: { my $scr_hello = "<& \n 'samples/test-recur.msn', name => 'Dave' \n &>"; my $res_hello = "Test greeting:\n" . 'Good afternoon, Dave!' . "\n"; is $m->execute( text => $scr_hello), $res_hello; } ###################################################################### TEXT_CONTAINS_OUT: { my $scr_inout = 'IN <% "and" %> OUT burger'; my $res_inout = 'IN and OUT burger'; is $m->execute( text => $scr_inout), $res_inout; } ###################################################################### Text-MicroMason-2.13/t/56-sprintf.t000644 002015 000024 00000002475 11272642676 017066 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 13; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason::Base->new( -Sprintf ); ###################################################################### { my $scr_hello = 'Hello %s!'; my $res_hello = 'Hello World!'; is $m->execute( text => $scr_hello, 'World'), $res_hello; is $m->compile( text => $scr_hello)->('World'), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->('World'), $res_hello; is $scriptlet->('World'), $res_hello; } ###################################################################### { my $scr_hello = <<'ENDSCRIPT'; Hello %s! How are ya? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Hello World! How are ya? ENDSCRIPT is $m->execute( text => $scr_hello, 'World'), $res_hello; is $m->compile( text => $scr_hello)->('World'), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->('World'), $res_hello; is $scriptlet->('World'), $res_hello; } ###################################################################### { my $m = Text::MicroMason::Base->new( -Sprintf ); my $res_hello = "Hello World!\n"; is $m->execute( handle => \*DATA, 'World'), $res_hello; } ###################################################################### __DATA__ Hello %s! Text-MicroMason-2.13/t/90-cache-dir-conflict.t000644 002015 000024 00000002567 11272642676 021017 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 12; # Test the potential conflict between CompileCache and # TemplateDir options use_ok 'Text::MicroMason'; my $m1 = Text::MicroMason->new( -CompileCache, -TemplateDir, template_root => 'samples/' ); my $m2 = Text::MicroMason->new( -CompileCache, -TemplateDir, template_root => 'samples/subdir' ); ###################################################################### # # In the m2 object, using the samples/subdir, we should get an answer in German. SUBDIR: { ok my $output = $m2->execute( file=>'test.msn', name=>'Sam', hour=>14); like ($output, qr/\QGuten Tag, Sam!\E/ ); ok $output = $m2->execute( file=>'test.msn', name=>'Sam', hour=>10); like ($output, qr/\QGuten Morgen, Sam!\E/ ); } # And, if we execute test.msn in m1, we should get an answer in English. FILE: { ok my $output = $m1->execute( file=>'test.msn', name=>'Sam', hour=>14); like ($output, qr/\QGood afternoon, Sam!\E/ ); ok $output = $m1->execute( file=>'test.msn', name=>'Sam', hour=>10); like ($output, qr/\QGood morning, Sam!\E/ ); } my $m = Text::MicroMason->new( -TemplateDir, template_root => 'samples/' ); RELATIVE: { ok my $scr_hello = $m->execute( file => 'test-relative.msn', name => 'Dave'); ok my $res_hello = "Test greeting:\nGood afternoon, Dave!\n"; is ($m->execute(text=>$scr_hello), $res_hello ); } Text-MicroMason-2.13/t/07-class.t000644 002015 000024 00000002304 11272642676 016471 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 10; use_ok 'Text::MicroMason'; ok my $mason_class = Text::MicroMason->class(); ok my $m = $mason_class->new(); ###################################################################### { my $scr_hello = <<'ENDSCRIPT'; % my $noun = 'World'; Hello <% $noun %>! How are ya? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Hello World! How are ya? ENDSCRIPT is $m->execute( text => $scr_hello), $res_hello; is $m->compile( text => $scr_hello)->(), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->(), $res_hello; } ###################################################################### { my $scr_bold = '<% $ARGS{label} %>'; is $m->execute( text => $scr_bold, label=>'Foo'), 'Foo'; is $m->compile( text => $scr_bold)->(label=>'Foo'), 'Foo'; } ###################################################################### { my $scr_mobj = 'You\'ve been compiled by <% ref $m %>.'; my $res_mobj = 'You\'ve been compiled by Text::MicroMason'; like $m->execute( text => $scr_mobj), qr/^\Q$res_mobj\E/; } ###################################################################### Text-MicroMason-2.13/t/81-func-basics.t000644 002015 000024 00000001475 11272642676 017573 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 9; use_ok 'Text::MicroMason', qw( compile execute ); ###################################################################### { my $scr_hello = <<'ENDSCRIPT'; % my $noun = 'World'; Hello <% $noun %>! How are ya? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Hello World! How are ya? ENDSCRIPT is execute($scr_hello), $res_hello; is compile($scr_hello)->(), $res_hello; ok my $scriptlet = compile($scr_hello); is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; } ###################################################################### { my $scr_bold = '<% $ARGS{label} %>'; is execute($scr_bold, label=>'Foo'), 'Foo'; is compile($scr_bold)->(label=>'Foo'), 'Foo'; } Text-MicroMason-2.13/t/57-plp.t000644 002015 000024 00000003766 11272642676 016201 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 112; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -PLP ); ###################################################################### my $scr_hello = <<'ENDSCRIPT'; <: my $noun = 'World'; :>Hello <:= $noun :>! How are ya? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Hello World! How are ya? ENDSCRIPT is $m->execute( text => $scr_hello), $res_hello; is $m->compile( text => $scr_hello)->(), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; ###################################################################### my $scr_bold = '<:= $ARGS{label} :>'; is $m->execute( text => $scr_bold, label=>'Foo'), 'Foo'; is $m->compile( text => $scr_bold)->(label=>'Foo'), 'Foo'; ###################################################################### FLOW_CONTROL: { my $scr_rand = <<'ENDSCRIPT'; <: if ( int rand 2 ) { :> Hello World! <: } else { :> Goodbye Cruel World! <: } :> ENDSCRIPT my $scriptlet = $m->compile(text => $scr_rand); for (0 .. 99) { like $scriptlet->(), qr/^\n (Hello World!|Goodbye Cruel World!)\n$/; } } ###################################################################### PERL_BLOCK: { my $scr_count = <<'ENDSCRIPT'; Counting... <: foreach ( 1 .. 9 ) { $_out->( $_ ) } :> Done! ENDSCRIPT my $res_count = <<'ENDSCRIPT'; Counting... 123456789 Done! ENDSCRIPT is $m->execute( text => $scr_count), $res_count; } SPANNING_PERL: { my $scr_count = <<'ENDSCRIPT'; <: foreach ( 1 .. 9 ) { :> <: } :>
<:= $_ :>
ENDSCRIPT my $res_count = <<'ENDSCRIPT';
1 2 3 4 5 6 7 8 9
ENDSCRIPT is $m->execute( text => $scr_count), $res_count; } Text-MicroMason-2.13/t/03-args.t000644 002015 000024 00000006160 11272642676 016320 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 23; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new(); ###################################################################### { my $scr_hello = "Hello <% shift(@_) %>!"; my $res_hello = "Hello World!"; is $m->execute( text => $scr_hello, 'World' ), $res_hello; is $m->compile( text => $scr_hello)->( 'World' ), $res_hello; } ###################################################################### { my $scr_bold = '<% $ARGS{label} %>'; is $m->execute( text => $scr_bold, label=>'Foo'), 'Foo'; is $m->compile( text => $scr_bold)->(label=>'Foo'), 'Foo'; } ###################################################################### SIMPLE_ARGS: { my $scr_bold = '<%args>$label<% $label %>'; is $m->execute( text => $scr_bold, label=>'Foo'), 'Foo'; is $m->compile( text => $scr_bold)->(label=>'Foo'), 'Foo'; is eval { $m->execute( text => $scr_bold); 1 }, undef; ok $@; } ###################################################################### ARGS_BLOCK_WITH_DEFAULT: { my $scr_hello = <<'ENDSCRIPT'; <%args> $name $hour => (localtime)[2] % if ( $name eq 'Dave' ) { I'm sorry <% $name %>, I'm afraid I can't do that right now. % } else { <%perl> my $greeting = ( $hour > 11 ) ? 'afternoon' : 'morning'; Good <% $greeting %>, <% $name %>! % } ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Good afternoon, World! ENDSCRIPT is $m->execute( text => $scr_hello, name => 'World', hour => 13), $res_hello; is $m->compile( text => $scr_hello)->(name => 'World', hour => 13), $res_hello; like $m->execute( text => $scr_hello, name => 'World'), qr/Good (afternoon|morning), World!/; is eval { $m->execute( text => $scr_hello, hour => 13); 1 }, undef; is eval { $m->execute( text => $scr_hello); 1 }, undef; } ###################################################################### ARGS_BLOCK_WITH_DEFAULT_LIST: { my $scr_count = <<'ENDSCRIPT'; <%args> @data => () Count: <% scalar @data %> ENDSCRIPT my $res_count_0 = "Count: 0\n"; my $res_count_1 = "Count: 1\n"; my $res_count_2 = "Count: 2\n"; is $m->execute( text => $scr_count ), $res_count_0; is $m->execute( text => $scr_count, data => [] ), $res_count_0; is $m->execute( text => $scr_count, data => [ 1 ] ), $res_count_1; is $m->execute( text => $scr_count, data => [ 1 .. 2 ] ), $res_count_2; } ###################################################################### ARGS_BLOCK_WITH_DEFAULT_LIST: { my $scr_count = <<'ENDSCRIPT'; <%args> @data => ( 1 ) Count: <% scalar @data %> ENDSCRIPT my $res_count_0 = "Count: 0\n"; my $res_count_1 = "Count: 1\n"; my $res_count_2 = "Count: 2\n"; is $m->execute( text => $scr_count ), $res_count_1; is $m->execute( text => $scr_count, data => [] ), $res_count_0; is $m->execute( text => $scr_count, data => [ 1 ] ), $res_count_1; is $m->execute( text => $scr_count, data => [ 1 .. 2 ] ), $res_count_2; } ###################################################################### Text-MicroMason-2.13/t/35-execute_cache.t000644 002015 000024 00000004346 11272642676 020162 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 17; use_ok 'Text::MicroMason'; ###################################################################### { ok my $m = Text::MicroMason->new(); use vars qw( $sub_fib $count_fib ); $count_fib = 0; my $scr_fib = q{<% my $x = shift; ++ $::count_fib; $x < 3 ? 1 : &$::sub_fib( $x - 1 ) + &$::sub_fib( $x - 2 ) %>}; ok $sub_fib = $m->compile( text => $scr_fib ); is $sub_fib->(10), 55; # Fibonaci calculation works is $count_fib, 109; # Without caching we need to do this a lot } ###################################################################### { ok my $m = Text::MicroMason->new( -ExecuteCache ); use vars qw( $sub_fib $count_fib ); $count_fib = 0; my $scr_fib = q{<% my $x = shift; ++ $::count_fib; $x < 3 ? 1 : &$::sub_fib( $x - 1 ) + &$::sub_fib( $x - 2 ) %>}; ok $sub_fib = $m->compile( text => $scr_fib ); is $sub_fib->(10), 55; # Fibonaci calculation works is $count_fib, 10; # With caching we only do this a few times } ###################################################################### { require Text::MicroMason::Cache::Null; ok my $m = Text::MicroMason->new( -ExecuteCache, execute_cache => Text::MicroMason::Cache::Null->new ); use vars qw( $sub_fib $count_fib ); $count_fib = 0; my $scr_fib = q{<% my $x = shift; ++ $::count_fib; $x < 3 ? 1 : &$::sub_fib( $x - 1 ) + &$::sub_fib( $x - 2 ) %>}; ok $sub_fib = $m->compile( text => $scr_fib ); is $sub_fib->(10), 55; # Fibonaci calculation works is $count_fib, 109; # Without caching we need to do this a lot } ###################################################################### { ok my $m = Text::MicroMason->new( -ExecuteCache, -CompileCache ); use vars qw( $sub_fib $count_fib ); $count_fib = 0; my $scr_fib = q{<% my $x = shift; ++ $::count_fib; $x < 3 ? 1 : &$::sub_fib( $x - 1 ) + &$::sub_fib( $x - 2 ) %>}; ok $sub_fib = sub { $m->execute( text => $scr_fib, @_ ) }; is $sub_fib->(10), 55; # Fibonaci calculation works is $count_fib, 10; # With caching we only do this a few times } ###################################################################### Text-MicroMason-2.13/t/54-embperl.t000644 002015 000024 00000004600 11272642676 017015 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 214; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -Embperl ); ###################################################################### my $scr_hello = <<'ENDSCRIPT'; [- my $noun = 'World'; -]Hello [+ $noun +]! How are ya? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Hello World! How are ya? ENDSCRIPT is $m->execute( text => $scr_hello), $res_hello; is $m->compile( text => $scr_hello)->(), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; ###################################################################### my $scr_bold = '[+ $ARGS{label} +]'; is $m->execute( text => $scr_bold, label=>'Foo'), 'Foo'; is $m->compile( text => $scr_bold)->(label=>'Foo'), 'Foo'; ###################################################################### FLOW_CONTROL: { my $scr_rand = <<'ENDSCRIPT'; [- if ( int rand 2 ) { -] Hello World! [- } else { -] Goodbye Cruel World! [- } -] ENDSCRIPT ok my $scriptlet = $m->compile(text => $scr_rand); for ( 0 .. 99 ) { like $scriptlet->(), qr/^\n (Hello World!|Goodbye Cruel World!)\n$/; } } ###################################################################### FLOW_CONTROL_TAG: { my $scr_rand = <<'ENDSCRIPT'; [$ if int rand 2 $] Hello World! [$ else $] Goodbye Cruel World! [$ endif $] ENDSCRIPT ok my $scriptlet = $m->compile(text => $scr_rand); for ( 0 .. 99 ) { like $scriptlet->(), qr/^\n (Hello World!|Goodbye Cruel World!)\n$/; } } ###################################################################### PERL_BLOCK: { my $scr_count = <<'ENDSCRIPT'; Counting... [- foreach ( 1 .. 9 ) { $_out->( $_ ) } -] Done! ENDSCRIPT my $res_count = <<'ENDSCRIPT'; Counting... 123456789 Done! ENDSCRIPT is $m->execute( text => $scr_count), $res_count; } SPANNING_PERL: { my $scr_count = <<'ENDSCRIPT'; [- foreach ( 1 .. 9 ) { -] [- } -]
[+ $_ +]
ENDSCRIPT my $res_count = <<'ENDSCRIPT';
1 2 3 4 5 6 7 8 9
ENDSCRIPT is $m->execute( text => $scr_count), $res_count; } Text-MicroMason-2.13/t/08-errors.t000644 002015 000024 00000004075 11300342730 016664 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 28; use Text::MicroMason; my $m = Text::MicroMason->new( ); ###################################################################### { my $scr_mobj = "Hello <% die('Foo!') %>!"; is eval { $m->execute( text => $scr_mobj ); 1 }, undef; like ($@, qr/Foo!/, "Error $@ must match Foo!"); is eval { $m->execute( text => $scr_mobj ); 1 }, undef; like ($@, qr<\QMicroMason execution failed: Foo! at text template (compiled at t/08-errors.t line>, "Error $@ must match MicroMason failure"); is eval { $m->execute( file => 'samples/die.msn' ); 1 }, undef; like ($@, qr(\QMicroMason execution failed: Foo! at samples/die.msn line), "Error $@ must match MicroMason failure"); } ###################################################################### { my $scr_mobj = < is a test. End. EOT is eval { $m->compile( text => $scr_mobj ); 1 }, undef, "template with error dies"; ok my @lines = split(/\n/, $@), 'multiline output in $@'; like shift @lines, qr{MicroMason compilation failed: syntax error at text template \(compiled at t/08-errors.t line \d+\) line 8}, 'first line of $@ describes the error location' or diag $@; like shift @lines, qr/^$/, 'second line of $@ is blank' or diag $@; like $lines[0], qr{ 0 # line 1 "text template \(compiled at t/08-errors.t line }, 'third line of $@ has a #line' or diag $@; like pop @lines, qr{\s+eval \{\.\.\.\} called at t/08-errors.t line \d+}, 'last line of $@ has line number too' or diag $@; # Perl 5.6 has one line of "at line number" junk, but perl 5.8 has # two lines. The next line is our diagnostics message. ok ((pop @lines) =~ m{\Q** Please use Text::MicroMason->new(-LineNumbers) for better diagnostics!} or (pop @lines) =~ m{\Q** Please use Text::MicroMason->new(-LineNumbers) for better diagnostics!}); my $n = 0; foreach my $line (@lines) { like $line, qr/^\s*$n\s+/ or diag $@; $n++; } } Text-MicroMason-2.13/t/85-func-file.t000644 002015 000024 00000002401 11513635576 017237 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 9; use Safe; use_ok 'Text::MicroMason', qw( safe_compile safe_execute try_safe_compile try_safe_execute ); ###################################################################### use Text::MicroMason qw( try_execute_file try_compile try_execute ); FILE: { my $output = try_execute_file('samples/test.msn', name=>'Sam', hour=>14); like $output, qr/\QGood afternoon, Sam!\E/; } SYNTAX: { my $script = <<'TEXT_END'; <%perl> my $hour = $ARGS{hour}; xx % if ( $ARGS{name} eq 'Dave' and $hour > 22 ) { I'm sorry <% $ARGS{name} %>, I'm afraid I can't do that right now. % } else { <& 'samples/test.msn', name => $ARGS{name}, hour => $hour &> % } TEXT_END ok my $code = try_compile($script); ok my $output = try_execute($code, name => 'Sam', hour => 9); like $output, qr/\QGood morning, Sam!\E/; ok $output = try_execute($code, name => 'Dave', hour => 23); like $output, qr/\Qsorry Dave\E/; } SKIP: { skip "Safe doesn't die in Perl >= 5.13.1", 2 if $] >= 5.013001; my $script = qq| <& 'samples/test.msn', %ARGS &> |; my ($output, $err) = try_safe_execute($script, name => 'Sam', hour => 9); is $output, undef; like $err, qr/in this compartment/; } Text-MicroMason-2.13/t/01-syntax.t000644 002015 000024 00000001313 11272642676 016703 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 8; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new(); ###################################################################### { my $scr_hello = <<'ENDSCRIPT'; % my $noun = 'World'; Hello <% $noun %>! How are ya? ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Hello World! How are ya? ENDSCRIPT is $m->execute( text => $scr_hello), $res_hello; is $m->compile( text => $scr_hello)->(), $res_hello; ok my $scriptlet = $m->compile( text => $scr_hello); is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; is $scriptlet->(), $res_hello; } ###################################################################### Text-MicroMason-2.13/t/58-quicktemplate.t000644 002015 000024 00000005112 11272642676 020242 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 22; use Text::MicroMason::QuickTemplate; # to import $DONTSET use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -QuickTemplate ); ###################################################################### my $scr_hello = <<'ENDSCRIPT'; Dear {{to}}, Have a {{day_type}} day. Your {{relation}}, {{from}} ENDSCRIPT my $res_hello = <<'ENDSCRIPT'; Dear Professor Dumbledore, Have a swell day. Your friend, Harry ENDSCRIPT ok my $scriptlet = $m->compile(text => $scr_hello); is $scriptlet->(to => 'Professor Dumbledore', relation => 'friend', day_type => 'swell', from => 'Harry',), $res_hello; is $scriptlet->( { to => 'Professor Dumbledore', relation => 'friend', day_type => 'swell', from => 'Harry', } ), $res_hello; ###################################################################### ok my $emulator = $m->new(text => $scr_hello); is $emulator->fill( { to => 'Professor Dumbledore', relation => 'friend', day_type => 'swell', from => 'Harry', } ), $res_hello; ###################################################################### ok my $book_t = $emulator->new( text => '{{title}}, by {{author}}' ); ok my $bibl_1 = $book_t->fill({author => "Stephen Hawking", title => "A Brief History of Time"}); is $bibl_1, "A Brief History of Time, by Stephen Hawking"; ok my $bibl_2 = $book_t->fill({author => "Dr. Seuss", title => "Green Eggs and Ham"}); is $bibl_2, "Green Eggs and Ham, by Dr. Seuss"; ###################################################################### is eval { $book_t->fill({author => 'Isaac Asimov'}) }, undef; like $@, qr/could not resolve the following symbol: title/; ###################################################################### ok my $bibl_4 = $book_t->fill({author => 'Isaac Asimov', title => $Text::MicroMason::QuickTemplate::DONTSET }); is $bibl_4, "{{title}}, by Isaac Asimov"; ###################################################################### ok $m->compile( text => $scr_hello); ok $m->pre_fill(to => 'Professor Dumbledore', relation => 'friend' ); is eval { $m->fill(); 1 }, undef; ok $@; ok $m->pre_fill( day_type => 'swell', from => 'Harry'); is $m->fill(), $res_hello; ###################################################################### Text-MicroMason-2.13/t/40-pass_variables.t000644 002015 000024 00000002510 11344277460 020351 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 11; use_ok 'Text::MicroMason'; ###################################################################### { ok my $m = Text::MicroMason->new( -PassVariables ); is $m->execute( text=>'Hello <% $name || "" %>!' ), 'Hello !'; } ###################################################################### { ok my $m = Text::MicroMason->new( -PassVariables ); is $m->execute( text=>'Hello <% $name %>!', 'name' => 'Bob' ), 'Hello Bob!'; } ###################################################################### { ok my $m = Text::MicroMason->new( -PassVariables, package => 'foo' ); $foo::name = $foo::name = 'Bob'; is $m->execute( text=>'Hello <% $name %>!' ), 'Hello Bob!'; } ###################################################################### { ok my $m = Text::MicroMason->new( -PassVariables, package => 'main' ); local $::name; $::name = 'Bob'; is $m->execute( text=>'Hello <% $name %>!' ), 'Hello Bob!'; } ###################################################################### { ok my $m = Text::MicroMason->new( -PassVariables, package => 'main' ); is $m->execute( text=> < <%init> \$ARGS{name} = "jack"; EOT } ###################################################################### Text-MicroMason-2.13/t/05-file.t000644 002015 000024 00000003116 11272642676 016303 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 12; use_ok 'Text::MicroMason'; ok my $m = Text::MicroMason->new( -CatchErrors ); ###################################################################### FILE: { like $m->execute( file=>'samples/test.msn', name=>'Sam', hour => 14), qr/\QGood afternoon, Sam!\E/; } ###################################################################### TAG: { my $scr_hello = "<& 'samples/test-recur.msn', name => 'Dave' &>"; my $res_hello = "Test greeting:\n" . 'Good afternoon, Dave!' . "\n"; is $m->execute(text=>$scr_hello), $res_hello; } ###################################################################### SYNTAX: { my $script = <<'TEXT_END'; <%perl> my $hour = $ARGS{hour}; xx % if ( $ARGS{name} eq 'Dave' and $hour > 22 ) { I'm sorry <% $ARGS{name} %>, I'm afraid I can't do that right now. % } else { <& 'samples/test.msn', name => $ARGS{name}, hour => $hour &> % } TEXT_END ok my $code = $m->compile(text => $script); ok my ( $output, $error ) = $m->execute( code=>$code, name => 'Sam', hour => 9); like $output, qr/\QGood morning, Sam!\E/; is $error, ''; like $m->execute( code=>$code, name => 'Dave', hour => 23), qr/\Qsorry Dave\E/; } ###################################################################### HANDLE: { ok open my $TEST, '<', 'samples/test.msn'; ok my $output = $m->execute( handle => $TEST, name=>'Sam', hour => 14); close $TEST; like $output, qr/\QGood afternoon, Sam!\E/; } ###################################################################### Text-MicroMason-2.13/t/91-template_path.t000644 002015 000024 00000003462 11272642676 020224 0ustar00alanstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More tests => 12; # Test TemplatePath use_ok 'Text::MicroMason'; ###################################################################### my $m1 = Text::MicroMason->new( -TemplatePath, template_path => [ qw(samples/subdir/ samples/) ]); # If we execute a template in subdir/ we should get it (and not the # samples/ version). SUBDIR: { ok (my $output = $m1->execute( file => 'test.msn', name => 'Sam', hour => 14)); like ($output, qr/\QGuten Tag, Sam!\E/); ok ($output = $m1->execute( file => 'test.msn', name=>'Sam', hour=>10)); like ($output, qr/\QGuten Morgen, Sam!\E/); } # If we call a template that only exists in samples/ then that should # work as well. But the referred template SAMPLE: { ok (my $scr_hello = $m1->execute( file => 'test-relative.msn', name => 'Dave')); ok (my $res_hello = "Test greeting:\nGuten Tag, Dave!\n"); like ($scr_hello, qr/\Q$res_hello\E/); like ($m1->execute(text => $scr_hello), qr/\Q$res_hello\E/); } ###################################################################### # With the reverse path we should get opposite results. my $m2 = Text::MicroMason->new( -TemplatePath, template_path => [ qw(samples/ samples/subdir/) ]); SUBDIR: { my $output = $m2->execute( file=>'test.msn', name=>'Sam', hour=>14); like ($output, qr/\QGood afternoon, Sam!\E/ ); $output = $m2->execute( file=>'test.msn', name=>'Sam', hour=>10); like ($output, qr/\QGood morning, Sam!\E/ ); } # If we call a template that only exists in samples/ then that should # work as well. But the referred template SAMPLE: { my $scr_hello = $m2->execute( file => 'test-relative.msn', name => 'Dave'); my $res_hello = "Test greeting:\nGood afternoon, Dave!\n"; is ($m2->execute(text=>$scr_hello), $res_hello); }