├── .gitignore ├── .gitrepo ├── .perlcriticrc ├── Changes ├── MANIFEST.SKIP ├── TODO ├── bin └── mason.pl ├── dist.ini ├── eg └── blog │ └── README ├── git └── config ├── lib ├── Mason.pm ├── Mason │ ├── .gitignore │ ├── App.pm │ ├── CodeCache.pm │ ├── Compilation.pm │ ├── Component.pm │ ├── Component │ │ ├── ClassMeta.pm │ │ ├── Import.pm │ │ └── Moose.pm │ ├── DynamicFilter.pm │ ├── Exceptions.pm │ ├── Filters │ │ └── Standard.pm │ ├── Interp.pm │ ├── Manual.pod │ ├── Manual │ │ ├── Components.pod │ │ ├── Cookbook.pod │ │ ├── FAQ.pod │ │ ├── Filters.pod │ │ ├── Intro.pod │ │ ├── Plugins.pod │ │ ├── RequestDispatch.pod │ │ ├── Setup.pod │ │ ├── Subclasses.pod │ │ ├── Syntax.pod │ │ ├── Tutorial.pod │ │ └── UpgradingFromMason1.pod │ ├── Moose.pm │ ├── Moose │ │ └── Role.pm │ ├── Plugin.pm │ ├── Plugin │ │ ├── .gitignore │ │ ├── Defer.pm │ │ ├── Defer │ │ │ ├── Filters.pm │ │ │ └── Request.pm │ │ ├── DollarDot.pm │ │ ├── DollarDot │ │ │ └── Compilation.pm │ │ ├── LvalueAttributes.pm │ │ ├── LvalueAttributes │ │ │ └── Interp.pm │ │ ├── TidyObjectFiles.pm │ │ ├── TidyObjectFiles │ │ │ └── Interp.pm │ │ └── make │ ├── PluginBundle.pm │ ├── PluginBundle │ │ └── Default.pm │ ├── PluginManager.pm │ ├── PluginRole.pm │ ├── Request.pm │ ├── Result.pm │ ├── Test │ │ ├── Class.pm │ │ ├── Overrides │ │ │ └── Component │ │ │ │ └── StrictMoose.pm │ │ ├── Plugins │ │ │ ├── Notify.pm │ │ │ └── Notify │ │ │ │ ├── Compilation.pm │ │ │ │ ├── Component.pm │ │ │ │ ├── Interp.pm │ │ │ │ └── Request.pm │ │ ├── RootClass.pm │ │ └── RootClass │ │ │ ├── Compilation.pm │ │ │ ├── Component.pm │ │ │ ├── Interp.pm │ │ │ └── Request.pm │ ├── TieHandle.pm │ ├── Types.pm │ ├── Util.pm │ └── t │ │ ├── Autobase.pm │ │ ├── Cache.pm │ │ ├── CompCalls.pm │ │ ├── Compilation.pm │ │ ├── ComponentMeta.pm │ │ ├── Defer.pm │ │ ├── DollarDot.pm │ │ ├── Errors.pm │ │ ├── Filters.pm │ │ ├── Globals.pm │ │ ├── HTMLFilters.pm │ │ ├── Interp.pm │ │ ├── LvalueAttributes.pm │ │ ├── Plugins.pm │ │ ├── Reload.pm │ │ ├── Request.pm │ │ ├── ResolveURI.pm │ │ ├── Sanity.pm │ │ ├── Sections.pm │ │ ├── Skel.pm │ │ ├── StaticSource.pm │ │ ├── Syntax.pm │ │ └── Util.pm └── Pod │ └── Weaver │ └── Section │ └── SeeAlsoMason.pm ├── perlcriticrc ├── t ├── Autobase.t ├── CompCalls.t ├── Compilation.t ├── ComponentMeta.t ├── Defer.t ├── DollarDot.t ├── Errors.t ├── Filters.t ├── Globals.t ├── Interp.t ├── LvalueAttributes.t ├── Plugins.t ├── Reload.t ├── Request.t ├── ResolveURI.t ├── Sanity.t ├── Sections.t ├── StaticSource.t ├── Syntax.t ├── Util.t ├── make └── mason-app.t ├── tidyall.ini ├── weaver.ini └── xt └── author └── leaks.t /.gitignore: -------------------------------------------------------------------------------- 1 | .tidyall.d 2 | Mason-* 3 | NOTES 4 | REFERENCE 5 | bench 6 | cp.yml 7 | data 8 | docs 9 | dist 10 | htdocs 11 | inc 12 | profile 13 | release 14 | tmp 15 | z-backup 16 | -------------------------------------------------------------------------------- /.gitrepo: -------------------------------------------------------------------------------- 1 | perl-mason.git 2 | -------------------------------------------------------------------------------- /.perlcriticrc: -------------------------------------------------------------------------------- 1 | only = 1 2 | severity = 1 3 | verbose = %m at %f line %l [%p]\n 4 | 5 | [Moose::RequireMakeImmutable] 6 | [TestingAndDebugging::RequireUseStrict] 7 | equivalent_modules = Mason::Moose Test::Class::Most Mason::PluginRole 8 | [Variables::ProhibitConditionalDeclarations] 9 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Mason 2 | 3 | ** marks an incompatible change 4 | 5 | 2.24 May 16, 2015 6 | 7 | * Fixes 8 | - Patch for 5.21.6 closure deprecation - RT #100507 (Dave Mitchell) 9 | 10 | 2.23 Feb 7, 2015 11 | 12 | * Fixes 13 | - Detect empty <% %> tags (A Kobame) 14 | - Eliminate unescaped left brace in regex, deprecated in perl 5.21.x - RT 101637 - SREZIC 15 | 16 | 2.22 Feb 1, 2014 17 | 18 | * Fixes 19 | - Release new version using gnutar 20 | 21 | 2.21 Jan 18, 2014 22 | 23 | * Fixes 24 | - Replace deprecated Class::MOP methods with Class::Load - perl-mason/pull/21 (Leeft) 25 | 26 | * Improvements 27 | - Add class_header shortcut to add to each component class header - perl-mason/pull/14 28 | (jomo666) 29 | 30 | 2.20 Jul 12, 2012 31 | 32 | * Improvements 33 | - Implement and document trailing slash policy - perl-mason/pull/11 (Pedro Melo) 34 | 35 | * Fixes 36 | - Coerce undefined filter argument to the empty string (Tomohiro Hosaka) 37 | - Eliminate "=for html" POD entries, which were mangling metacpan.org output (Pedro Melo) 38 | - Fix some tests for Windows - perl-mason/pull/9 (Tomasz Konojacki) 39 | 40 | * Documentation 41 | - Moved eg/blog to Poet 42 | 43 | 2.19 May 2, 2012 44 | 45 | * Improvements 46 | - Add $.Tee standard filter, like $.Capture but outputs at same time 47 | 48 | * Fixes 49 | - Fix for Moose 2.06 - RT #76793 (doy) 50 | 51 | * Documentation 52 | - Mention Mason::Plugin::DefaultFilter more prominently 53 | 54 | 2.18 Apr 22, 2012 55 | 56 | * Documentation 57 | - Add references to Poet, Mason's new companion web framework 58 | - Move Admin.pod to Setup.pod 59 | - Fix lots of broken links 60 | 61 | 2.17 Mar 27, 2012 62 | 63 | * Documentation 64 | - Move FAQ pod sections up one level 65 | 66 | * Fixes 67 | - Use make_immutable on generated Mason subclasses (Tomohiro Hosaka) 68 | - Properly quote paths when generating component class (Peter Franke) 69 | 70 | 2.16 Feb 24, 2012 71 | 72 | * Documentation 73 | - Add Mason::Manual::FAQ, and various documentation improvements/fixes 74 | 75 | * Fixes 76 | - Add prereq Exception::Class 77 | - Use Data::Dumper in Mason::Util 78 | 79 | 2.15 Nov 27, 2011 80 | 81 | ** Incompatible changes 82 | - Rename bin/mason to bin/mason.pl, to avoid conflict with the Mason firewall tool - RT #72497 (Florian) 83 | 84 | * Fixes 85 | - Fix parser bug with filters and comment characters (Tomohiro Hosaka) 86 | 87 | 2.14 Sep 6, 2011 88 | 89 | ** Incompatible changes 90 | - Deprecate %%-lines, <%args> section and <%shared> section, which IMO add 91 | unnecessary TMTOWTDI. Standardize on the <%class> section and Moose 'has' 92 | declarations. These alternate syntaxes may make it into a plugin. 93 | 94 | * Improvements 95 | - Allow applications to specify Mason subclasses by naming convention. 96 | - Document use of Mason subclasses in Mason::Manual::Subclasses. 97 | 98 | * Fixes 99 | - Respect Mason::CodeCache plugins (bokutin) 100 | - Allow comments after filter markers {{ and }} 101 | 102 | 2.13 Jul 26, 2011 103 | 104 | * Improvements 105 | - Add process_output, an easy way to modify all Mason output in a plugin or subclass 106 | 107 | 2.12 Jul 3, 2011 108 | 109 | * Fixes 110 | - Fix $m->visit under PSGIHandler (Jozef Mojzis) 111 | - Fix $m->visit when initial out_method passed 112 | 113 | 2.11 Jun 29, 2011 114 | 115 | * Fixes 116 | - Fix memory leaks between Interp, Request and Component; add test for leaks (StephenClouse) 117 | 118 | 2.10 Jun 23, 2011 119 | 120 | * Fixes 121 | - Fix filter pipe syntax, broken in 2.09 - RT #69038 (MDIETRICH) 122 | - Specify and test execution order of multiple filters in pipe syntax 123 | - Go back to generating version numbers for all sub-modules again 124 | 125 | 2.09 Jun 20, 2011 126 | 127 | * Fixes 128 | - Properly rename Mason::t::Defer test 129 | 130 | 2.08 Jun 18, 2011 131 | 132 | ** Incompatible changes 133 | - Change apply filter syntax to 134 | % $.Filter {{ 135 | ... 136 | % }} 137 | as it reduces tag soup and better matches the typical use of filtering a block of content 138 | 139 | * Improvements 140 | - Add $m->filter to manually apply filters 141 | - Add CLASS->no_wrap() as a convenient way to skip parent wrapping 142 | - Set $_ as well as $_[0] to content for filtering, to make s// based filters easier 143 | 144 | * Fixes 145 | - Define $CLASS as well as CLASS in components, ala CLASS module 146 | - Fix $. notation inside <& &> 147 | - Re-fix compatibility with JSON version 1.x 148 | - Untaint component source when in taint mode (e.g. mod_perl) as in Mason 1, otherwise 149 | compiler regexes may fail 150 | 151 | 2.07 Apr 21, 2011 152 | 153 | * Improvements 154 | - Allow arguments to be passed to the content sub from a dynamic filter (e.g. CompCall) 155 | - Throw error on unmatched %> or &> 156 | - Fix error line numbers after method sections and multiple text sections 157 | 158 | * Fixes 159 | - Prevent false inheritance loops when component overrides its default parent (Jozef Mojzis) 160 | - Fix compatibility with JSON version 1.x 161 | 162 | * Other 163 | - Only generate version numbers for .pm files with documentation, to reduce inter-version churn 164 | 165 | 2.06 Mar 14, 2011 166 | 167 | * Fixes 168 | - Use new file extensions in eg/blog (Jozef Mojzis) 169 | 170 | 2.05 Mar 6, 2011 171 | 172 | ** Incompatible changes 173 | - Change default component file extensions due to conflict with Objective C's .m 174 | (suggested by jomo). New extensions: 175 | .mc - top-level component 176 | .mi - internal component 177 | .mp - pure-perl component 178 | 179 | * Fixes 180 | - Require comp_root parameter to Mason->new (cxreg) 181 | - Require that request path is absolute 182 | - Ignore whitespace at beginning of a <%args> and <%shared> line (cxreg) 183 | 184 | * Improvements 185 | - Forbid reserved names such as 'cmeta' in new method and attribute declarations 186 | - Improve error message when request path not found - list all component paths searched 187 | 188 | * Testing 189 | - Stop using test counts - see http://bit.ly/eISu3R 190 | 191 | * Documentation 192 | - Add Mason/Manual/Intro.pod 193 | 194 | 2.04 Feb 26, 2011 195 | 196 | * Fixes 197 | - Fix broken $m->scomp (Tomohiro Hosaka) 198 | 199 | * Testing 200 | - Add a pile of tests to fill in coverage gaps 201 | 202 | 2.03 Feb 24, 2011 203 | 204 | * Improvements 205 | - Add -e option to bin/mason 206 | 207 | * Fixes 208 | - Depend on Log::Any 0.08, for Log::Any::Test (David Wheeler) 209 | 210 | 2.02 Feb 24, 2011 211 | 212 | * Fixes 213 | - Allow index file (index.m, index.pm) to be accessed directly with /index path (Matthias Dietrich) 214 | - Fix error line # for invalid attribute 215 | - Include HTMLFilters in eg/blog/install.sh (qiuhw) 216 | - Fix t/mason-app.t to be perl-location-agnostic (qiuhw) 217 | - Prevent CPAN from indexing built-in plugin implementation files 218 | 219 | * Backend 220 | - Remove InstanceMeta object, make args() a direct method of component 221 | - Add pluggable Mason::Component::Import for importing non-Moose things into components 222 | 223 | 2.01 Feb 20, 2011 224 | 225 | * Fixes 226 | - Declare Devel::GlobalDestruction dependency; get rid of List::MoreUtils dependency 227 | 228 | 2.00 Feb 16, 2011 229 | 230 | - Initial Mason 2 version - see HTML::Mason for previous versions 231 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ^MANIFEST.SKIP$ 2 | ^Makefile$ 3 | ^Makefile.old$ 4 | ^NOTES 5 | ^REFERENCE 6 | ^TODO 7 | ^bench 8 | ^blib 9 | ^build 10 | ^cp\.yml 11 | ^data 12 | ^depends 13 | ^dist\.ini 14 | ^docs 15 | ^eg/blog/data 16 | ^git 17 | ^htdocs 18 | ^inc/\.author 19 | ^lib/Dist 20 | ^lib/Mason/Plugin/make 21 | ^lib/Mason/Tidy.pm 22 | ^lib/Pod 23 | ^localcpan 24 | ^misc 25 | ^perlcritic 26 | ^profile 27 | ^release 28 | ^t/make 29 | ^tidyall.ini 30 | ^tmp 31 | ^weaver.ini 32 | ^wiki 33 | ^z-backup 34 | 35 | # pod2html files 36 | \.pm\.html 37 | 38 | # Backup files, etc. 39 | ~$ 40 | (^|/)# 41 | (^|/)\. 42 | \.bak$ 43 | \.tar\.gz$ 44 | 45 | # SVN cruft 46 | ^\.svn 47 | 48 | # MakeMaker cruft 49 | 50 | # pod2html files 51 | \.pm\.html 52 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | TO DO 2 | 3 | * Create utf8 plugin 4 | * In Mason::Plugin, don't rely on die to know whether module is available, can be expensive when combined with automatic stack tracers 5 | * Create easy way to apply filter to whole page, like old Mason 1 <%filter> 6 | * make _load_class_from_object_file supported 7 | * Create easy way to declare private attributes, like "priv" 8 | * Content wrapping needs to be easier to find in manual 9 | * Router::Simple does not reload on the fly well 10 | * If mason_root_class is missing, offer a helpful "are you calling Mason::Interp->new directly?" 11 | * Better debug logging for what is going on in a request, especially how the first component is dispatched to 12 | * Add a Page.mc/Page.mp that only top-level components inherit from? 13 | * Make 'augment wrap' the implicit default for any non-whitespace content in an autobase component. 14 | * Mailing lists: Shut down all but mason-users; eliminate you-must-be-subscribed from mason-users or its replacement 15 | * Add call() as wrapper around main(), so that call() can be overriden and wrapped in an autobase 16 | * Whitespace should be required before/after <%, <&, %>, &> 17 | * Mention defer in multiple places, maybe take it out of plugin altogether 18 | * Mention MasonX::ProcessDir somewhere, maybe FAQ and SEE ALSO 19 | * Default escaping - integrate into core, allow it to be overriden on a per-component or even per-fragment basis (see django - http://bit.ly/JglsGq) 20 | * Component load errors not showing up properly in plack stack trace, because __DIE__ hook is not called for an eval or do error. Mason 1's custom html errors handled this better (each line mentioned in compile error was highlighted). 21 | * Release initial Mason tidy, even without html/css/javascript 22 | * Mason 1 compatibility mode and/or conversion utility 23 | * Caching entire page 24 | * Add back $m->cache_self - return if $m->cache_self($key, '5 min') 25 | cache_self($key, $get_set_options, $cache_options) 26 | where $get_set_options is passed to compute 27 | and $cache_options are used to create the cache 28 | * Caching entire page does not work in concert with Defer - either we cache the buffer with the tags still in there, or caching keeps the buffer out of reach of _apply_defers_to_request_buffer 29 | * Add $m->no_wrap() as another way to turn off wrapping dynamically 30 | * Doc - mention "$self->page" in more examples and as replacement for REQ: 31 | * running list of notable available plugins 32 | * document in admin: 33 | * component caching (memory, object files), static source 34 | * test that cannot resolve to autobase 35 | * use // in perl 5.10.0 and above for '$$_buffer .= $_' 36 | * write filter to find link(s) to current page and apply another filter to each instance (e.g. unlink and make bold) 37 | * put back corrupt object file handling in Interp::load 38 | * have Mason::App use MooseX::Getopt 39 | -------------------------------------------------------------------------------- /bin/mason.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Mason::App; 6 | Mason::App->run(); 7 | 8 | __END__ 9 | 10 | =head1 NAME 11 | 12 | mason.pl - evaluate a mason template and output the result 13 | 14 | =head1 SYNOPSIS 15 | 16 | # Evaluate template from STDIN 17 | mason.pl [mason options] [--args json-string] 18 | 19 | # Evaluate template in string 20 | mason.pl [mason options] [--args json-string] -e "string" 21 | 22 | # Evaluate template in file 23 | mason.pl [mason options] [--args json-string] template-file 24 | 25 | =head1 DESCRIPTION 26 | 27 | Reads a Mason template (component) from STDIN, a string, or a file. Runs the 28 | template and outputs the result to STDOUT. 29 | 30 | =head1 MASON OPTIONS 31 | 32 | The following Mason options can be specified on the command line: 33 | 34 | --data-dir /path/to/data_dir 35 | --plugins MyPlugin,MyOtherPlugin 36 | 37 | The C will be set to the directory of the template file or to a 38 | temporary directory if using STDIN. If not specified C will be set to 39 | a temporary directory. 40 | 41 | =head1 ADDITIONAL OPTIONS 42 | 43 | =over 44 | 45 | =item --args json-string 46 | 47 | A hash of arguments to pass to the page component, in JSON form. e.g. 48 | 49 | --args '{"count":5,"names":["Alice","Bob"]}' 50 | 51 | =back 52 | 53 | =head1 SEE ALSO 54 | 55 | L 56 | 57 | =head1 AUTHOR 58 | 59 | Jonathan Swartz 60 | 61 | =head1 COPYRIGHT AND LICENSE 62 | 63 | This software is copyright (c) 2011 by Jonathan Swartz. 64 | 65 | This is free software; you can redistribute it and/or modify it under the same 66 | terms as the Perl 5 programming language system itself. 67 | 68 | =cut 69 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = Mason 2 | abstract = Powerful, high-performance templating for the web and beyond 3 | main_module = lib/Mason.pm 4 | author = Jonathan Swartz 5 | license = Perl_5 6 | copyright_year = 2012 7 | copyright_holder = Jonathan Swartz 8 | 9 | version = 2.24 10 | 11 | [MetaResources] 12 | bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Mason 13 | bugtracker.mailto = bug-mason@rt.cpan.org 14 | repository.url = git://github.com/jonswar/perl-mason.git 15 | repository.web = https://github.com/jonswar/perl-mason 16 | repository.type = git 17 | 18 | ; Build 19 | [ExecDir] 20 | [ExtraTests] 21 | [GatherDir] 22 | [License] 23 | [MakeMaker] 24 | [ManifestSkip] 25 | [Manifest] 26 | [MetaJSON] 27 | [MetaYAML] 28 | [MetaNoIndex] 29 | directory = eg 30 | directory = lib/Mason/t 31 | directory = lib/Mason/Test 32 | directory = lib/Mason/Plugin/Defer 33 | directory = lib/Mason/Plugin/DollarDot 34 | directory = lib/Mason/Plugin/LvalueAttributes 35 | directory = lib/Mason/Plugin/TidyObjectFiles 36 | file = lib/Mason/Util.pm 37 | [PkgVersion] 38 | [PodWeaverIfPod] 39 | [PruneCruft] 40 | 41 | [Prereqs / RuntimeRequires] 42 | Capture::Tiny = 0 43 | Class::Load = 0 44 | Class::Unload = 0 45 | Devel::GlobalDestruction = 0 46 | Exception::Class = 0 47 | File::Spec = 0 48 | File::Temp = 0 49 | Guard = 0 50 | IPC::System::Simple = 0 51 | JSON = 0 52 | Log::Any = 0.08 53 | Memoize = 0 54 | Method::Signatures::Simple = 0 55 | Moose = 1.15 56 | MooseX::HasDefaults = 0.03 57 | MooseX::StrictConstructor = 0.13 58 | Scalar::Util = 1.01 59 | Try::Tiny = 0 60 | 61 | [Prereqs / TestRequires] 62 | Test::Class::Most = 0 63 | Test::LongString = 0 64 | 65 | ; These need to be at the bottom 66 | [InstallGuide] 67 | -------------------------------------------------------------------------------- /eg/blog/README: -------------------------------------------------------------------------------- 1 | Moved to eg/blog in Poet. 2 | 3 | http://search.cpan.org/perldoc?Poet 4 | https://github.com/jonswar/perl-poet/tree/master/eg/blog 5 | 6 | -------------------------------------------------------------------------------- /git/config: -------------------------------------------------------------------------------- 1 | [core] 2 | repositoryformatversion = 0 3 | filemode = true 4 | bare = false 5 | logallrefupdates = true 6 | ignorecase = true 7 | [remote "origin"] 8 | url = git@github.com:jonswar/perl-mason.git 9 | fetch = +refs/heads/*:refs/remotes/origin/* 10 | [branch "master"] 11 | merge = master 12 | remote = origin 13 | -------------------------------------------------------------------------------- /lib/Mason.pm: -------------------------------------------------------------------------------- 1 | package Mason; 2 | 3 | use Mason::Interp; 4 | use Mason::PluginManager; 5 | use Mason::Util qw(can_load uniq); 6 | use Method::Signatures::Simple; 7 | use strict; 8 | use warnings; 9 | 10 | method new ($class: %params) { 11 | 12 | # Extract plugins and base_interp_class 13 | # 14 | my $plugin_specs = delete( $params{plugins} ) || []; 15 | my $base_interp_class = delete( $params{base_interp_class} ) 16 | || $class->default_base_interp_class; 17 | 18 | # Process plugins and determine real interp_class 19 | # 20 | my @plugins = Mason::PluginManager->process_top_plugin_specs($plugin_specs); 21 | my $interp_class = 22 | Mason::PluginManager->apply_plugins_to_class( $base_interp_class, 'Interp', \@plugins ); 23 | 24 | # Create and return interp 25 | # 26 | die "cannot pass mason_root_class directly" 27 | if exists( $params{mason_root_class} ); 28 | return $interp_class->new( 29 | mason_root_class => $class, 30 | plugins => \@plugins, 31 | %params 32 | ); 33 | } 34 | 35 | method default_base_interp_class ($class:) { 36 | my @candidates = 37 | map { join( '::', $_, 'Interp' ) } ( uniq( $class, 'Mason' ) ); 38 | my ($base_class) = grep { can_load($_) } @candidates 39 | or die sprintf( "cannot load %s for interp", join( ', ', @candidates ) ); 40 | return $base_class; 41 | } 42 | 43 | 1; 44 | 45 | __END__ 46 | 47 | =pod 48 | 49 | =head1 NAME 50 | 51 | Mason - Powerful, high-performance templating for the web and beyond 52 | 53 | =head1 SYNOPSIS 54 | 55 | foo.mc: 56 | % my $name = "Mason"; 57 | Hello world! Welcome to <% $name %>. 58 | 59 | #!/usr/local/bin/perl 60 | use Mason; 61 | my $mason = Mason->new(comp_root => '...'); 62 | print $mason->run('/foo')->output; 63 | 64 | =head1 DESCRIPTION 65 | 66 | Mason is a powerful Perl-based templating system, designed to generate dynamic 67 | content of all kinds. 68 | 69 | Unlike many templating systems, Mason does not attempt to invent an alternate, 70 | "easier" syntax for templates. It provides a set of syntax and features 71 | specific to template creation, but underneath it is still clearly and proudly 72 | recognizable as Perl. 73 | 74 | Mason is most often used for generating web pages. It has a companion web 75 | framework, L, designed to take maximum advantage of its routing and 76 | content generation features. It can also be used as the templating layer for 77 | web frameworks such as L and 78 | L. 79 | 80 | All documentation is indexed at L. 81 | 82 | The previous major version of Mason (1.x) is available under the name 83 | L. 84 | 85 | =head1 SUPPORT 86 | 87 | The mailing list is C. You must be 88 | subscribed to send a message. To subscribe, visit 89 | L. 90 | 91 | You can also visit us at C<#mason> on L. 92 | 93 | Bugs and feature requests will be tracked at RT: 94 | 95 | http://rt.cpan.org/NoAuth/Bugs.html?Dist=Mason 96 | bug-mason@rt.cpan.org 97 | 98 | The latest source code can be browsed and fetched at: 99 | 100 | http://github.com/jonswar/perl-mason 101 | git clone git://github.com/jonswar/perl-mason.git 102 | 103 | The official Mason website is L, however it contains 104 | mostly information about L. We're not sure what the future 105 | of the website will be wrt Mason 2. 106 | 107 | =head1 ACKNOWLEDGEMENTS 108 | 109 | Thanks to Stevan Little and the L team for the awesomeness of Moose, 110 | which motivated me to create a second version of Mason years after I thought I 111 | was done. 112 | 113 | Thanks to Tatsuhiko Miyagawa and the L team, 114 | who freed me from ever worrying about server backends again. 115 | 116 | =head1 SEE ALSO 117 | 118 | L 119 | 120 | -------------------------------------------------------------------------------- /lib/Mason/.gitignore: -------------------------------------------------------------------------------- 1 | Plack 2 | -------------------------------------------------------------------------------- /lib/Mason/App.pm: -------------------------------------------------------------------------------- 1 | package Mason::App; 2 | 3 | use Cwd qw(realpath); 4 | use File::Basename; 5 | use File::Temp qw(tempdir); 6 | use Getopt::Long; 7 | use Mason; 8 | use Mason::Util qw(json_decode); 9 | use strict; 10 | use warnings; 11 | 12 | my $usage = 13 | "usage: $0 [--data-dir dir] [--plugins Plugin1,Plugin2] [--args json-string] [-e source] [template-file]"; 14 | 15 | sub run { 16 | my ( %params, $args, $source, $help ); 17 | GetOptions( 18 | 'args=s' => \$args, 19 | 'e=s' => \$source, 20 | 'h|help' => \$help, 21 | map { dashify($_) . "=s" => \$params{$_} } qw(data_dir plugins) 22 | ) or usage(); 23 | if ($help) { 24 | system("perldoc $0"); 25 | exit; 26 | } 27 | %params = map { defined( $params{$_} ) ? ( $_, $params{$_} ) : () } keys(%params); 28 | if ( $params{plugins} ) { 29 | $params{plugins} = [ split( /\s*,\s*/, $params{plugins} ) ]; 30 | } 31 | my %run_args = defined($args) ? %{ json_decode($args) } : (); 32 | 33 | my $tempdir = tempdir( 'mason-XXXX', TMPDIR => 1, CLEANUP => 1 ); 34 | my $file; 35 | if ($source) { 36 | $file = "$tempdir/source.mc"; 37 | open( my $fh, ">", $file ); 38 | print $fh $source; 39 | } 40 | else { 41 | $file = shift(@ARGV); 42 | usage() if @ARGV; 43 | if ( !$file ) { 44 | $file = "$tempdir/stdin.mc"; 45 | open( my $fh, ">", $file ); 46 | while () { print $fh $_ } 47 | } 48 | } 49 | 50 | my $comp_root = dirname($file); 51 | my $path = "/" . basename($file); 52 | my $interp = Mason->new( comp_root => $comp_root, autoextend_request_path => 0, %params ); 53 | print $interp->run( $path, %run_args )->output . "\n"; 54 | } 55 | 56 | sub usage { 57 | print "$usage\n"; 58 | exit; 59 | } 60 | 61 | sub dashify { 62 | my $name = shift; 63 | $name =~ s/_/-/g; 64 | return $name; 65 | } 66 | 67 | 1; 68 | 69 | __END__ 70 | 71 | =pod 72 | 73 | =head1 NAME 74 | 75 | Mason::App - Implementation of bin/mason 76 | 77 | =head1 DESCRIPTION 78 | 79 | See documentation for bin/mason. 80 | 81 | =cut 82 | -------------------------------------------------------------------------------- /lib/Mason/CodeCache.pm: -------------------------------------------------------------------------------- 1 | package Mason::CodeCache; 2 | 3 | use Devel::GlobalDestruction; 4 | use Mason::Moose; 5 | use Mason::Util; 6 | 7 | has 'datastore' => ( is => 'ro', isa => 'HashRef', default => sub { {} } ); 8 | 9 | method get ($key) { 10 | return $self->{datastore}->{$key}; 11 | } 12 | 13 | method set ($key, $data) { 14 | $self->{datastore}->{$key} = $data; 15 | } 16 | 17 | method remove ($key) { 18 | if ( my $entry = $self->{datastore}->{$key} ) { 19 | if ( !in_global_destruction() ) { 20 | my $compc = $entry->{compc}; 21 | $compc->_unset_class_cmeta(); 22 | $compc->meta->make_mutable(); 23 | Mason::Util::delete_package($compc); 24 | } 25 | delete $self->{datastore}->{$key}; 26 | } 27 | } 28 | 29 | method get_keys () { 30 | return keys( %{ $self->{datastore} } ); 31 | } 32 | 33 | __PACKAGE__->meta->make_immutable(); 34 | 35 | 1; 36 | 37 | __END__ 38 | 39 | =pod 40 | 41 | =head1 NAME 42 | 43 | Mason::CodeCache - Result returned from Mason request 44 | 45 | =head1 DESCRIPTION 46 | 47 | Internal class that manages the cache of components for L. 48 | 49 | =cut 50 | -------------------------------------------------------------------------------- /lib/Mason/Component.pm: -------------------------------------------------------------------------------- 1 | package Mason::Component; 2 | 3 | use Moose; # no Mason::Moose - don't want StrictConstructor 4 | use MooseX::HasDefaults::RO; 5 | use Method::Signatures::Simple; 6 | use Log::Any; 7 | use Scalar::Util qw(weaken); 8 | 9 | with 'Mason::Filters::Standard'; 10 | 11 | # Passed attributes 12 | # 13 | has 'args' => ( init_arg => undef, lazy_build => 1 ); 14 | has 'm' => ( required => 1, weak_ref => 1 ); 15 | 16 | __PACKAGE__->meta->make_immutable(); 17 | 18 | method BUILD ($params) { 19 | 20 | # Make a copy of params and re-weaken m 21 | # 22 | $self->{_orig_params} = $params; 23 | weaken $self->{_orig_params}->{m}; 24 | } 25 | 26 | method cmeta () { 27 | return $self->can('_class_cmeta') ? $self->_class_cmeta : undef; 28 | } 29 | 30 | method _build_args () { 31 | my $orig_params = $self->{_orig_params}; 32 | return { 33 | map { ( $_, $orig_params->{$_} ) } 34 | grep { $_ ne 'm' } keys(%$orig_params) 35 | }; 36 | } 37 | 38 | # Default handle - call render 39 | # 40 | method handle () { 41 | $self->render(@_); 42 | } 43 | 44 | # Default render - call wrap 45 | # 46 | method render () { 47 | $self->wrap(@_); 48 | } 49 | 50 | # Top wrap 51 | # 52 | method wrap () { 53 | inner(); 54 | } 55 | 56 | # By default, do not allow path_info 57 | # 58 | method allow_path_info () { 59 | return 0; 60 | } 61 | 62 | # Shorcut for skipping wrap 63 | # 64 | method no_wrap ($class:) { 65 | $class->meta->add_method( 'render' => sub { $_[0]->main(@_) } ); 66 | } 67 | 68 | 1; 69 | 70 | __END__ 71 | 72 | =pod 73 | 74 | =head1 NAME 75 | 76 | Mason::Component - Mason Component base class 77 | 78 | =head1 DESCRIPTION 79 | 80 | Every Mason component corresponds to a unique class that inherits, directly or 81 | indirectly, from this base class. 82 | 83 | A new instance of the component class is created whenever a component is called 84 | - whether via a top level request, C<< <& &> >> tags, or an << $m->comp >> 85 | call. A component instance is only valid for the Mason request in which it was 86 | created. 87 | 88 | We leave this class as devoid of built-in methods as possible, allowing you to 89 | create methods in your own components without worrying about name clashes. 90 | 91 | =head1 STRUCTURAL METHODS 92 | 93 | This is the standard call chain for the page component (the initial component 94 | of a request). 95 | 96 | handle -> render -> wrap -> main 97 | 98 | In many cases only C
will actually do anything. 99 | 100 | =over 101 | 102 | =item handle 103 | 104 | This is the top-most method called on the page component. Its job is to decide 105 | how to handle the request, e.g. 106 | 107 | =over 108 | 109 | =item * 110 | 111 | throw an error (e.g. permission denied) 112 | 113 | =item * 114 | 115 | take some action and redirect (e.g. if handling a form in a web environment) 116 | 117 | =item * 118 | 119 | defer to another component via C<< $m->go >> 120 | 121 | =item * 122 | 123 | render the page 124 | 125 | =back 126 | 127 | It should not output any content itself. By default, it simply calls 128 | L. 129 | 130 | =item render 131 | 132 | This method is invoked from L on the page component. Its job is 133 | to output the full content of the page. By default, it simply calls 134 | L. 135 | 136 | =item wrap 137 | 138 | This method is invoked from L on the page component. By 139 | convention, C is an L method, with each superclass calling the next subclass. This is 141 | useful for cascading templates in which the top-most superclass generates the 142 | surrounding content. 143 | 144 | <%augment wrap> 145 |

Subtitle section

146 |
147 | <% inner() %> 148 |
149 | 150 | 151 | By default, C simply calls C<< inner() >> to go to the next subclass, and 152 | then L at the bottom subclass. 153 | 154 | To override a component's parent wrapper, a component can define its own 155 | C using C instead of C: 156 | 157 | <%method wrap> 158 |

Parent wrapper will be ignored

159 | <% inner() %> 160 | 161 | 162 | To do no wrapping at all, call the component class method L: 163 | 164 | <%class> 165 | CLASS->no_wrap; 166 | 167 | 168 | =item main 169 | 170 | This method is invoked when a non-page component is called, and from the 171 | default L method as well. It consists of the code and output in the 172 | main part of the component that is not inside a C<< <%method> >> or C<< 173 | <%class> >> tag. 174 | 175 | =back 176 | 177 | =head1 CLASS METHODS 178 | 179 | =over 180 | 181 | =item no_wrap 182 | 183 | A convenience method that redefines L to call L 184 | instead of L, thus skipping any content wrapper inherited from 185 | parent. 186 | 187 | <%class> 188 | CLASS->no_wrap; 189 | 190 | 191 | =item allow_path_info 192 | 193 | This method is called when the request path has a path_info portion, to 194 | determine whether the path_info is allowed. Default is false. See 195 | L. 196 | 197 | <%class> 198 | method allow_path_info { 1 } 199 | 200 | 201 | =back 202 | 203 | =head1 OTHER METHODS 204 | 205 | =over 206 | 207 | =item args 208 | 209 | Returns the hashref of arguments passed to this component's constructor, e.g. 210 | the arguments passed in a L. 211 | 212 | =item cmeta 213 | 214 | Returns the L object associated with this 215 | component class, containing information such as the component's path and source 216 | file. 217 | 218 | my $path = $self->cmeta->path; 219 | 220 | =item m 221 | 222 | Returns the current request. This is also available via C<< $m >> inside Mason 223 | components. 224 | 225 | =back 226 | 227 | =cut 228 | -------------------------------------------------------------------------------- /lib/Mason/Component/ClassMeta.pm: -------------------------------------------------------------------------------- 1 | package Mason::Component::ClassMeta; 2 | 3 | use File::Basename; 4 | use Mason::Moose; 5 | use Log::Any; 6 | 7 | my $next_id = 0; 8 | 9 | # Passed attributes (generated in compiled component) 10 | has 'class' => ( required => 1 ); 11 | has 'dir_path' => ( required => 1 ); 12 | has 'interp' => ( required => 1, weak_ref => 1 ); 13 | has 'is_dhandler' => ( init_arg => undef, lazy_build => 1 ); 14 | has 'is_top_level' => ( required => 1 ); 15 | has 'object_file' => ( required => 1 ); 16 | has 'path' => ( required => 1 ); 17 | has 'source_file' => ( required => 1 ); 18 | 19 | # Derived attributes 20 | has 'id' => ( init_arg => undef, default => sub { $next_id++ } ); 21 | has 'log' => ( init_arg => undef, lazy_build => 1 ); 22 | has 'name' => ( init_arg => undef, lazy_build => 1 ); 23 | 24 | method _build_is_dhandler () { 25 | return grep { $self->name eq $_ } @{ $self->interp->dhandler_names }; 26 | } 27 | 28 | method _build_log () { 29 | my $log_category = "Mason::Component" . $self->path; 30 | $log_category =~ s/\//::/g; 31 | return Log::Any->get_logger( category => $log_category ); 32 | } 33 | 34 | method _build_name () { 35 | return basename( $self->path ); 36 | } 37 | 38 | __PACKAGE__->meta->make_immutable(); 39 | 40 | 1; 41 | 42 | __END__ 43 | 44 | =pod 45 | 46 | =head1 NAME 47 | 48 | Mason::Component::ClassMeta - Meta-information about Mason component class 49 | 50 | =head1 SYNOPSIS 51 | 52 | # In a component: 53 | My path is <% $.cmeta->path %> 54 | My source file is <% $.cmeta->source_file %> 55 | 56 | =head1 DESCRIPTION 57 | 58 | Every L class has an associated 59 | L object, containing 60 | meta-information such as the component's path and source file. It can be 61 | accessed with the L method. 62 | 63 | =over 64 | 65 | =item class 66 | 67 | The component class that this meta object is associated with. 68 | 69 | =item dir_path 70 | 71 | The directory of the component path, relative to the component root - e.g. for 72 | a component '/foo/bar', the dir_path is '/foo'. 73 | 74 | =item is_top_level 75 | 76 | Whether the component is considered "top level", accessible directly from C<< 77 | $interp->run >> or a web request. See L. 78 | 79 | =item name 80 | 81 | The component base name, e.g. 'bar' for component '/foo/bar'. 82 | 83 | =item object_file 84 | 85 | The object file produced from compiling the component. 86 | 87 | =item path 88 | 89 | The component path, relative to the component root - e.g. '/foo/bar'. 90 | 91 | =item source_file 92 | 93 | The component source file. 94 | 95 | =back 96 | 97 | =cut 98 | -------------------------------------------------------------------------------- /lib/Mason/Component/Import.pm: -------------------------------------------------------------------------------- 1 | package Mason::Component::Import; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | sub import { 7 | my $class = shift; 8 | my $caller = caller; 9 | $class->import_into($caller); 10 | } 11 | 12 | sub import_into { 13 | my ( $class, $for_class ) = @_; 14 | 15 | # no-op by default 16 | } 17 | 18 | 1; 19 | 20 | __END__ 21 | 22 | =pod 23 | 24 | =head1 NAME 25 | 26 | Mason::Component::Import - Extra component imports 27 | 28 | =head1 DESCRIPTION 29 | 30 | This module is automatically use'd in each generated Mason component class. It 31 | imports nothing by default, but you can modify the C method in 32 | plugins to add imports. 33 | 34 | -------------------------------------------------------------------------------- /lib/Mason/Component/Moose.pm: -------------------------------------------------------------------------------- 1 | package Mason::Component::Moose; ## no critic (Moose::RequireMakeImmutable) 2 | 3 | use Moose (); 4 | use MooseX::HasDefaults::RW (); 5 | use Method::Signatures::Simple (); 6 | use Moose::Exporter; 7 | use strict; 8 | use warnings; 9 | Moose::Exporter->setup_import_methods( also => ['Moose'] ); 10 | 11 | sub init_meta { 12 | my $class = shift; 13 | my %params = @_; 14 | my $for_class = $params{for_class}; 15 | Method::Signatures::Simple->import( into => $for_class ); 16 | MooseX::HasDefaults::RW->import( { into => $for_class } ); 17 | { 18 | no strict 'refs'; 19 | my $temp = $for_class; 20 | *{ $for_class . '::CLASS' } = sub () { $temp }; # like CLASS.pm 21 | *{ $for_class . '::CLASS' } = \$for_class; 22 | } 23 | } 24 | 25 | 1; 26 | 27 | __END__ 28 | 29 | =pod 30 | 31 | =head1 NAME 32 | 33 | Mason::Component::Moose - Moose policies and exports for Mason components 34 | 35 | =head1 DESCRIPTION 36 | 37 | This module is automatically included in each generated Mason component class, 38 | and is equivalent to 39 | 40 | use CLASS; 41 | use Moose; 42 | use MooseX::HasDefaults::RW; 43 | use Method::Signatures::Simple; 44 | 45 | =head1 OVERRIDING 46 | 47 | To override the default behavior, subclass this class and specify it as 48 | C to L. 49 | 50 | For example, to use L in every component: 51 | 52 | package My::Mason::Component::Moose; 53 | use Moose::Exporter; 54 | use MooseX::StrictConstructor (); 55 | use base qw(Mason::Component::Moose); 56 | 57 | sub init_meta { 58 | my $class = shift; 59 | $class->SUPER::init_meta(@_); 60 | MooseX::StrictConstructor->init_meta(@_); 61 | } 62 | 63 | ... 64 | 65 | my $interp = Mason::Interp->new(..., base_component_moose_class => 'My::Mason::Component::Moose'); 66 | -------------------------------------------------------------------------------- /lib/Mason/DynamicFilter.pm: -------------------------------------------------------------------------------- 1 | package Mason::DynamicFilter; 2 | 3 | use Mason::Moose; 4 | 5 | has 'filter' => ( isa => 'CodeRef' ); 6 | 7 | around 'BUILDARGS' => sub { 8 | my $orig = shift; 9 | my $class = shift; 10 | if ( @_ == 1 ) { 11 | return $class->$orig( filter => $_[0] ); 12 | } 13 | else { 14 | return $class->$orig(@_); 15 | } 16 | }; 17 | 18 | method apply_filter () { 19 | my ($yield) = @_; 20 | return $self->filter->($yield); 21 | } 22 | 23 | __PACKAGE__->meta->make_immutable(); 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/Mason/Exceptions.pm: -------------------------------------------------------------------------------- 1 | package Mason::Exceptions; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Exception::Class ( 7 | 'Mason::Exception' => { description => 'generic base class for all Mason exceptions', }, 8 | 'Mason::Exception::Abort' => { 9 | isa => 'Mason::Exception', 10 | fields => [qw(aborted_value)], 11 | description => 'a component called $m->abort' 12 | }, 13 | 14 | 'Mason::Exception::TopLevelNotFound' => { 15 | isa => 'Mason::Exception', 16 | description => 'the top level component could not be found' 17 | }, 18 | ); 19 | 20 | 1; 21 | 22 | __END__ 23 | 24 | =pod 25 | 26 | =head1 NAME 27 | 28 | Mason::Exceptions - Exception objects thrown by Mason 29 | 30 | =head1 DESCRIPTION 31 | 32 | This module creates the exception classes used by Mason. Mason only throws 33 | exception objects to communicate something specific to code catching the 34 | exception; otherwise it is content to die with a string. 35 | 36 | =head1 EXCEPTIONS 37 | 38 | =over 39 | 40 | =item Mason::Exception::Abort 41 | 42 | The C<< $m->abort >> method was called. 43 | 44 | Exceptions in this class contain the field C. 45 | 46 | =item Mason::Exception::TopLevelNotFound 47 | 48 | The requested top level component passed to exec() could not be found. In a web 49 | environment, this could be used to determine that a 404 should be returned. 50 | 51 | =back 52 | 53 | =cut 54 | -------------------------------------------------------------------------------- /lib/Mason/Filters/Standard.pm: -------------------------------------------------------------------------------- 1 | package Mason::Filters::Standard; 2 | 3 | use Mason::DynamicFilter; 4 | use Mason::Util; 5 | use Mason::PluginRole; 6 | 7 | method Capture ($outref) { 8 | sub { $$outref = $_[0]; return '' } 9 | } 10 | 11 | method CompCall ($path, @params) { 12 | Mason::DynamicFilter->new( 13 | filter => sub { 14 | my $m = $self->m; 15 | return $m->scomp( $path, @params, yield => $_[0] ); 16 | } 17 | ); 18 | } 19 | 20 | method NoBlankLines () { 21 | sub { 22 | my $text = $_[0]; 23 | $text =~ s/^\s*\n//mg; 24 | return $text; 25 | }; 26 | } 27 | 28 | method Repeat ($times) { 29 | Mason::DynamicFilter->new( 30 | filter => sub { 31 | my $content = ''; 32 | for ( my $i = 0 ; $i < $times ; $i++ ) { 33 | $content .= $_[0]->(); 34 | } 35 | return $content; 36 | } 37 | ); 38 | } 39 | 40 | method Tee ($outref) { 41 | sub { $$outref = $_[0]; return $_[0] } 42 | } 43 | 44 | method Trim () { 45 | sub { Mason::Util::trim( $_[0] ) } 46 | } 47 | 48 | 1; 49 | 50 | __END__ 51 | 52 | =pod 53 | 54 | =head1 NAME 55 | 56 | Mason::Filters::Standard - Standard filters 57 | 58 | =head1 DESCRIPTION 59 | 60 | These filters are automatically composed into 61 | L. 62 | 63 | =head1 FILTERS 64 | 65 | =over 66 | 67 | =item Capture ($ref) 68 | 69 | Uses C<< $m->capture >> to capture the content in I<$ref> instead of outputting 70 | it. 71 | 72 | % $.Capture(\my $content) {{ 73 | 74 | % }} 75 | 76 | ... do something with $content 77 | 78 | =item CompCall ($path, @args...) 79 | 80 | Calls the component with I and I<@args>, just as with C<< $m->scomp >>, 81 | with an additional coderef argument C that can be invoked to generate 82 | the content. Arguments passed to C can be accessed inside the content 83 | via C<@_>. This is the replacement for Mason 1's L. 85 | 86 | In index.mc: 87 | % $.CompCall ('list_items.mi', items => \@items) {{ 88 |
  • <% $_[0] %>
    • 89 | % }} 90 | 91 | In list_items.mi: 92 | <%class> 93 | has 'items'; 94 | has 'yield'; 95 | 96 | 97 | % foreach my $item (@{$.items}) { 98 | <% $.yield->($item) %> 99 | % } 100 | 101 | =item NoBlankLines 102 | 103 | Remove lines with only whitespace from content. This 104 | 105 | % $.NoBlankLines {{ 106 | 107 | hello 108 | 109 | 110 | world 111 | % }} 112 | 113 | yields 114 | 115 | hello 116 | world 117 | 118 | =item Repeat ($count) 119 | 120 | Repeat the content block I<$count> times. Note that the block is re-executed 121 | each time, which may result in different content. 122 | 123 | 124 | % my $i = 1; 125 | % $.Repeat(5) {{ 126 | <% $i++ %>
    127 | % }} 128 | 129 | =item Tee ($ref) 130 | 131 | Uses C<< $m->capture >> to capture the content in I<$ref>, and also output it. 132 | 133 | % $.Tee(\my $content) {{ 134 | 135 | % }} 136 | 137 | ... 138 | 139 | 140 | <% $content %> 141 | 142 | =item Trim 143 | 144 | Remove whitespace from the beginning and end of the content. 145 | 146 | =back 147 | 148 | =head1 SEE ALSO 149 | 150 | L, L 151 | 152 | =cut 153 | -------------------------------------------------------------------------------- /lib/Mason/Manual.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Mason::Manual - Index of Mason documentation 5 | 6 | =head1 MANUALS 7 | 8 | =over 9 | 10 | =item L 11 | 12 | A quick introduction to get your feet wet. 13 | 14 | =item L 15 | 16 | How to set up Mason in a web environment and a non-web environment. 17 | 18 | =item L 19 | 20 | All about components, the building blocks of Mason. 21 | 22 | =item L 23 | 24 | A full reference of syntax that can be used in components. 25 | 26 | =item L 27 | 28 | How request paths get mapped to page components. 29 | 30 | =item L 31 | 32 | Recipes for common Mason tasks. 33 | 34 | =item L 35 | 36 | Frequently asked questions. 37 | 38 | =item L 39 | 40 | Using and creating filters that can be applied to portions of content in a 41 | component. 42 | 43 | =item L 44 | 45 | Using and creating plugins to modify Mason behavior. 46 | 47 | =item L 48 | 49 | Summary of differences between Mason 1 and Mason 2. 50 | 51 | =back 52 | 53 | =head1 OBJECT DOCUMENTATION 54 | 55 | =over 56 | 57 | =item L 58 | 59 | Mason::Interp is the central Mason object, returned from C<< Mason->new >>. It 60 | is responsible for creating new requests, compiling components, and maintaining 61 | the cache of loaded components. 62 | 63 | =item L 64 | 65 | Mason::Request represents a single request for a page, and is the access point 66 | for most Mason features not provided by syntactic tags. 67 | 68 | =item L 69 | 70 | Mason::Component is the base class from which all generated component classes 71 | inherit, directly or indirectly. 72 | 73 | =back 74 | -------------------------------------------------------------------------------- /lib/Mason/Manual/Cookbook.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Mason::Manual::Cookbook - Recipes for common Mason tasks 5 | 6 | =head1 RECIPES 7 | 8 | =head2 HTML list formed from array 9 | 10 |
      11 | % foreach $item (@list) { 12 |
    • <% $item %>
      • 13 | % } 14 |
    15 | 16 | =head2 HTML table formed from list of objects 17 | 18 | 19 | 20 | % foreach my $obj (@objects) { 21 | 22 | 23 | 24 | 25 | 26 | % } 27 |
    FooBarBaz
    <% $obj->foo %><% $obj->bar %><% $obj->baz %>
    28 | -------------------------------------------------------------------------------- /lib/Mason/Manual/FAQ.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | Mason::Manual::FAQ - Frequently asked questions about Mason 7 | 8 | =head1 COMPONENTS 9 | 10 | =head2 Can I create global variable(s) that can be seen from all components? 11 | 12 | Mason components each run in their own packages, so if you set a regular global 13 | in one you won't be able to see it in the others. 14 | 15 | But you can use L and 16 | L to create globals accessible from all 17 | components. 18 | 19 | =head2 Why does my output have extra newlines/whitespace and how can I get rid of it? 20 | 21 | See L in 22 | the syntax manual. To suppress extra newlines you can use a backslash at the 23 | end of each line, or you can use the 24 | L filter. 25 | 26 | To emit binary data without the risk of inserting extra whitespace, surround 27 | your code with L<$m-Eclear_buffer|Mason::Request/clear_buffer> and 28 | L<$m-Eabort|Mason::Request/abort>: 29 | 30 | <%init> 31 | $m->clear_buffer; 32 | open(my $fh, '<', 'binary-file') or die $!; 33 | my $buffer; 34 | while (read $fh, $buffer, 8192) { 35 | $m->print($buffer); 36 | } 37 | $m->abort; 38 | 39 | 40 | =head2 I'm trying to generate an image or other binary file, but it seems to be getting corrupted. 41 | 42 | This is almost always caused by unwanted whitespace or other output at the 43 | beginning or end of your binary data. Use 44 | L<$m-Eclear_buffer|Mason::Request/clear_buffer> and 45 | L<$m-Eabort|Mason::Request/abort> as in previous answer. 46 | 47 | =head2 How do I put comments in components? 48 | 49 | See L section in the syntax manual for 50 | reference. 51 | 52 | =over 53 | 54 | =item * 55 | 56 | Put general comments in the C<< <%doc> >> section. 57 | 58 | =item * 59 | 60 | Within code blocks (C<< <%class> >>, C<< <%init> >>, C<< <%perl> >>, etc.), use 61 | standard Perl comments ('#'). 62 | 63 | =item * 64 | 65 | Use C<< <% # %> >> for single or multi-line comments anywhere outside of Perl 66 | sections. 67 | 68 | =item * 69 | 70 | If you are producing HTML, you can use standard HTML comments delimited by . The difference is that these comments will appear in the final output. 72 | 73 | =back 74 | 75 | =head2 What's a good way to temporarily comment out code in a component? 76 | 77 | For HTML, you might be tempted to surround the section with C<< >>. 78 | But be careful! Any code inside the section will still execute. Here's a 79 | example of commenting out a call to an ad server: 80 | 81 | 84 | 85 | The ad will still be fetched and counted, but not displayed! 86 | 87 | A better way to block out a section is C: 88 | 89 | % if (0) { 90 | ... 91 | % } 92 | 93 | Code blocked out in this way will neither be executed nor displayed, and 94 | multiple C blocks can be nested inside each other (unlike HTML 95 | comments). 96 | 97 | Another way to block out code is with a C<< <%doc> >> tag, although this not 98 | cannot be nested. 99 | 100 | =head2 How can I capture the output of a component (and modify it, etc.) instead of having it automatically output? 101 | 102 | Use L<$m-Escomp|Mason::Request/scomp>. 103 | 104 | =head2 How can I capture the output from arbitrary code that calls components, etc.? 105 | 106 | Use L<$m-Ecapture|Mason::Request/capture>. 107 | 108 | =head2 How can I get a list of components matching a path pattern? 109 | 110 | Use L<$m-Eglob_paths|Mason::Interp/glob_paths>, e.g. 111 | 112 | my @paths = $m->glob_paths('/some/comp/path/*'); 113 | 114 | This will work even with multiple component roots; you'll get a combined list 115 | of all matching component paths in all component roots. 116 | 117 | =head2 How can I access $m (the request object) from outside a component, e.g. inside a regular class? 118 | 119 | Use Lcurrent_request|Mason::Request/current_request>: 120 | 121 | package Foo; 122 | 123 | sub bar { 124 | my $m = Mason::Request->current_request; 125 | } 126 | 127 | =head2 When using multiple component roots, is there a way to explicitly call a component in a specific root? 128 | 129 | Multiple component roots were designed to work just like Perl's C<@INC>. A 130 | given component path matches exactly one file, the first file found in an 131 | ordered search through the roots. There is no way to explicitly ask for a file 132 | in a specific root. 133 | 134 | =head1 HTTP and HTML 135 | 136 | =head2 How do I use Mason to process web requests? 137 | 138 | You need to use Mason in conjunction with a web framework. L is a web 139 | framework designed specially for Mason. L and L can also use 140 | Mason for their templating layer. See L. 141 | 142 | =head2 How can I HTML-escape the output of C<< <% %> >> tags? 143 | 144 | See the C filter in 145 | L. If you want to do 146 | this automatically for all C<< <% %> >> tags, see 147 | L. 148 | 149 | =head2 Why is Mason so slow with standard CGI? 150 | 151 | Under standard CGI you must load all modules and initialize your environment 152 | with every request. Mason's startup cost (mostly due to L) will 153 | make this particularly sub-optimal. Ask yourself whether you absolutely have to 154 | use CGI, and if not, switch to a persistent solution like mod_perl or Fast CGI 155 | or L. 156 | 157 | -------------------------------------------------------------------------------- /lib/Mason/Manual/Filters.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Mason::Manual::Filters - Content filters in Mason 5 | 6 | =head1 DESCRIPTION 7 | 8 | Filters can be used to process portions of content in a component. 9 | 10 | A set of filters comes built-in with Mason - see 11 | L. Others will be available 12 | on CPAN, and it is easy to create your own. 13 | 14 | =head1 INVOKING 15 | 16 | =head2 Block invocation 17 | 18 | Here's the standard way of invoking a filter: 19 | 20 | % $.Trim {{ 21 | This string will be trimmed 22 | % }} # end Trim 23 | 24 | A double open brace (C<< {{ >>) at the end of a C<< %-line >> denotes a filter 25 | call. The filtered content begins just afterwards and ends at the C<< }} >>. 26 | Both C<< {{ >> and C<< }} >> may be followed by a comment. 27 | 28 | The expression C<< $.Trim >>, aka C<< $self->Trim >>, is a method call on the 29 | component object which returns a filter. In general everything before the C<< 30 | {{ >> is evaluated and is expected to return a filter or list of filters. 31 | 32 | By convention, and to avoid name clashes with other component methods, filters 33 | use CamelCase rather than traditional underscore names. 34 | 35 | Filters can take arguments: 36 | 37 | % $.Repeat(3) {{ 38 | There's no place like home. 39 | % }} 40 | 41 | ==> There's no place like home. 42 | There's no place like home. 43 | There's no place like home. 44 | 45 | Since the expression C<< $.Repeat(3) >> returns a filter, it can be curried: 46 | 47 | % my $repeat_three = $.Repeat(3); 48 | % $repeat_three {{ 49 | There's no place like home. 50 | % }} 51 | 52 | You can create one-off filters with anonymous subroutines. The subroutine 53 | receives the content in both C<< $_[0] >> and C<< $_ >>, and should return the 54 | filtered content. 55 | 56 | % sub { reverse($_[0]) } {{ 57 | Hello 58 | % }} 59 | 60 | ==> olleH 61 | 62 | 63 | % sub { s/ //g; $_[0] } {{ 64 | A bunch of words 65 | % }} 66 | 67 | ==> Abunchofwords 68 | 69 | Filters can be nested, with separate lines: 70 | 71 | % $.Trim {{ 72 | % sub { uc($_[0]) } {{ 73 | This string will be trimmed and uppercased 74 | % }} 75 | % }} 76 | 77 | or on a single line: 78 | 79 | % $.Trim, sub { uc($_[0]) } {{ 80 | This will be trimmed and uppercased 81 | % }} 82 | 83 | Multiple filters within the same tag are applied, intuitively, in reverse order 84 | with the last one being innermost. e.g. in this block 85 | 86 | % my $i = 1; 87 | % $.Repeat(3), $.Cache($key, '1 hour') {{ 88 | <% $i++ %> 89 | % }} 90 | 91 | => 1 1 1 92 | 93 | the output of C<< <% $i++ %> >> is cached, and then repeated three times, 94 | whereas in this block 95 | 96 | % my $i = 1; 97 | % $.Cache($key, '1 hour'), $.Repeat(3) {{ 98 | <% $i++ %> 99 | % }} 100 | 101 | => 1 2 3 102 | 103 | C<< <% $i++ %> >> is executed and output three times, and then the whole thing 104 | cached. 105 | 106 | =head2 Pipe invocation 107 | 108 | Filters can also appear in a limited way inside a regular C<< <% %> >> tag: 109 | 110 | <% $content | NoBlankLines,Trim %> 111 | 112 | The filter list appears after a << | >> character and must contain one or more 113 | comma-separated names. The names are treated as methods on the current 114 | component class. With this syntax you cannot use anonymous subroutines or 115 | variables as filters, or pass arguments to filters. However in a pinch you can 116 | define local filter methods to get around this, e.g. 117 | 118 | <%class> 119 | method Repeat3 { $.Repeat(3); } 120 | 121 | ... 122 | <% $message_body | Repeat3 %> 123 | 124 | For consistency with other syntax, multiple names are applied in reverse order 125 | with the rightmost applied first. 126 | 127 | One common use of this form is to escape HTML strings in web content, using the 128 | C filter in L: 129 | 130 | <% $message_body | H %> 131 | 132 | =head2 Default filters 133 | 134 | L allows you to 135 | define default filters that will automatically apply to all substitution tags. 136 | It is analagous to L setting. 138 | 139 | =head2 Manual invocation 140 | 141 | L<$m-Efilter|Mason::Request/filter> can be used to manually apply filter(s) 142 | to a string. It returns the filtered output. e.g. 143 | 144 | <%init> 145 | ... 146 | my $filtered_string = $m->filter($.Trim, $.NoBlankLines, $string); 147 | 148 | 149 | =head1 CREATING A FILTER 150 | 151 | =head2 Package and naming 152 | 153 | By convention, filters are placed in roles so that they can be composed into 154 | L or a subclass thereof. Take a look at 155 | L for an example. 156 | 157 | Also by convention, filters use CamelCase rather than traditional 158 | underscore_separated naming. Filter methods have to coexist with other methods 159 | in the Mason::Component namespace, so have to be distinguishable somehow, and 160 | we thought this was preferable to a "filter_" prefix or suffix. Of course, you 161 | are free to choose your own convention, but you should expect this naming in 162 | the standard filters at least. 163 | 164 | Here's a filter package that implements two filters, C and C: 165 | 166 | package MyApp::Filters; 167 | use Mason::PluginRole; 168 | 169 | method Upper () { 170 | return sub { uc($_[0]) } 171 | } 172 | 173 | method Lower () { 174 | return sub { lc($_[0]) } 175 | } 176 | 177 | 1; 178 | 179 | To use these in a component: 180 | 181 | <%class> 182 | with 'MyApp::Filters'; 183 | 184 | 185 | % $.Upper {{ 186 | ... 187 | % }} 188 | 189 | Or if you want them available to all components, put them in C at the 190 | top of your component hierarchy, or in your application's C 191 | subclass. 192 | 193 | =head2 Simple vs. dynamic filters 194 | 195 | A I is a code ref which takes a string (via either $_[0] and $_) 196 | and returns the output. Your filter method should return this code ref. e.g. 197 | 198 | # Uses $_[0] 199 | method Upper () { 200 | return sub { uc($_[0]) }; 201 | } 202 | 203 | # Uses $_ 204 | method Rot13 () { 205 | return sub { tr/a-zA-Z/n-za-mN-ZA-M/; $_ }; 206 | } 207 | 208 | A I is an object of class C. It contains 209 | a code ref which takes a I and returns the output. A yield block 210 | is a zero-argument code ref that returns a content string. e.g. this is 211 | functionally identical to the above: 212 | 213 | method Rot13 () { 214 | return Mason::DynamicFilter->new( 215 | filter => sub { 216 | my $yield = $_[0]; 217 | my $text = $yield->(); 218 | $text =~ tr/a-zA-Z/n-za-mN-ZA-M/; 219 | return $text; 220 | } 221 | ); 222 | } 223 | 224 | The dynamic filter obviously doesn't buy you anything in this case, and for the 225 | majority of filters they are unneeded. The real power of dynamic filters is 226 | that they can choose if and when to execute the yield block. For example, here 227 | is an implementation (slightly expanded for explanatory purposes) of the C<< 228 | Cache >> filter in L: 229 | 230 | method Cache ( $key, $set_options ) { 231 | return Mason::DynamicFilter->new( 232 | filter => sub { 233 | my $yield = $_[0]; 234 | my $cache = $self->cache; 235 | my $output = $cache->get( $key ); 236 | if (!$output) { 237 | $output = $yield->(); 238 | $cache->set( $key, $output, $set_options ); 239 | } 240 | return $output; 241 | } 242 | ); 243 | } 244 | 245 | Notice that we call C<< $cache->get >> first, and return the output immediately 246 | if it is in the cache. Only on a cache miss do we actually execute the 247 | (presumably expensive) yield block. 248 | 249 | C<< Defer >> and C<< Repeat >> are two other examples of dynamic filters. See 250 | L for their implementations. 251 | 252 | =head2 <%filter> block 253 | 254 | You can use the C<< <%filter> >> block to define filters that output content. 255 | It works just like a C<< <%method> >> block, except that you can call C<< 256 | $yield->() >> to generate the original content. e.g. 257 | 258 | <%filter Item ($class)> 259 |
  • <% $yield->() %>
    • 260 | 261 | 262 | % $.Item('std') {{ 263 | First 264 | % }} 265 | % $.Item('std') {{ 266 | Second 267 | % }} 268 | 269 | generates 270 | 271 |
  • 272 | First 273 |
    • 274 |
  • 275 | Second 276 |
    • 277 | 278 | =head1 SEE ALSO 279 | 280 | L, L 281 | 282 | =cut 283 | -------------------------------------------------------------------------------- /lib/Mason/Manual/Intro.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Mason::Manual::Intro - Getting started with Mason 5 | 6 | =head1 DESCRIPTION 7 | 8 | A few quick examples to get your feet wet with Mason. See 9 | L for how to use Mason to generate web sites. 10 | 11 | =head1 EXAMPLE 1 12 | 13 | =head2 Hello world (from command-line) 14 | 15 | After installing Mason, you should have a C command in your installation 16 | path (e.g. C). Try this: 17 | 18 | % mason 19 | Hello! The local time is <% scalar(localtime) %>. 20 | ^D 21 | 22 | (where '^D' means ctrl-D or EOF). You should see something like 23 | 24 | Hello! The local time is Wed Mar 2 17:11:54 2011. 25 | 26 | The C command reads in a Mason I (template), runs it, and 27 | prints the result to standard output. Notice that the tag 28 | 29 | <% scalar(localtime) %> 30 | 31 | was replaced with the value of its expression. This is called a I and is a central piece of Mason syntax. 33 | 34 | =head1 EXAMPLE 2 35 | 36 | =head2 Email generator (from script) 37 | 38 | The command line is good for trying quick things, but eventually you're going 39 | to want to put your Mason components in files. 40 | 41 | In a test directory, create a directory C and create a file C 42 | with the following: 43 | 44 | <%class> 45 | has 'amount'; 46 | has 'name'; 47 | 48 | 49 | Dear <% $.name %>, 50 | 51 | We are pleased to inform you that you have won $<% sprintf("%.2f", $.amount) %>! 52 | 53 | Sincerely, 54 | The Lottery Commission 55 | 56 | <%init> 57 | die "amount must be a positive value!" unless $.amount > 0; 58 | 59 | 60 | In addition to the substitution tag we've seen before, we declare two 61 | I, C and C, to be passed into the component; and we 62 | declare a piece of initialization code to validate the amount. 63 | 64 | In the same test directory, create a script C with the following: 65 | 66 | 1 #!/usr/local/bin/perl 67 | 2 use Mason; 68 | 3 my $interp = Mason->new(comp_root => 'comps', data_dir => 'data'); 69 | 4 print $interp->run('/email', name => 'Joe', amount => '1500')->output; 70 | 71 | Line 3 creates a I, the main Mason object. It specifies two 72 | parameters: a I, indicating the directory hierarchy where your 73 | components will live; and a I, which Mason will use for 74 | internal purposes such as class generation and caching. 75 | 76 | Line 4 runs the template - notice that the C<.mc> extension is added 77 | automatically - passing values for the C and C attributes. 78 | 79 | Run C, and you should see 80 | 81 | Dear Joe, 82 | 83 | We are pleased to inform you that you have won $1500.00! 84 | 85 | Sincerely, 86 | The Lottery Commission 87 | 88 | =head1 SEE ALSO 89 | 90 | L, L 91 | 92 | -------------------------------------------------------------------------------- /lib/Mason/Manual/Plugins.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Mason::Manual::Plugins - Mason plugins 5 | 6 | =head1 DESCRIPTION 7 | 8 | A Mason plugin modifies behavior in one or more of Mason's main classes 9 | simultaneously, using Moose roles. Many Mason features, even some that might be 10 | considered "core", are implemented with plugins. 11 | 12 | =head1 FINDING PLUGINS 13 | 14 | By convention plugins live in the "Mason::Plugin::*" namespace, and plugin 15 | bundles live in the "Mason::PluginBundle::*" namespace. You can find both with 16 | this search: 17 | 18 | http://search.cpan.org/search?query=Mason%3A%3APlugin&mode=all 19 | 20 | =head1 USING PLUGINS 21 | 22 | Pass a list of plugin specs to the Mason constructor: 23 | 24 | Mason->new(plugins => 25 | [ 26 | 'OnePlugin', 27 | 'AnotherPlugin', 28 | '+My::Mason::Plugin::AThirdPlugin', 29 | '@APluginBundle', 30 | '+My::Mason::PluginBundle::AnotherBundle', 31 | '-PluginIDontLike', 32 | ]); 33 | 34 | Each plugin spec can be one of the following; 35 | 36 | =over 37 | 38 | =item * 39 | 40 | A simple name, which will have "Mason::Plugin::" prepended to it. 41 | 42 | =item * 43 | 44 | A bundle name, prefixed with '@', which will have "Mason::PluginBundle::" 45 | prepended to it. 46 | 47 | =item * 48 | 49 | A full plugin or bundle class name prefixed with '+'. 50 | 51 | =item * 52 | 53 | Any spec prefixed with '-', which means do not include these plugin(s) in the 54 | final list. 55 | 56 | =back 57 | 58 | See Mason::t::Plugins::test_plugin_specs in the Mason distribution for some 59 | examples. 60 | 61 | =head1 DEFAULT PLUGINS 62 | 63 | Mason will always add the L<@Default|Mason::PluginBundle::Default> bundle 64 | regardless of whether you pass your own list. You can remove individual default 65 | plugins that you don't like: 66 | 67 | plugins => ['-DollarDot', ...] 68 | 69 | or the whole list: 70 | 71 | plugins => ['-@Default', ...] 72 | 73 | =head1 CREATING PLUGINS 74 | 75 | Note: If you want to modify behavior for a particular application only, it 76 | might be more convenient to create L. 77 | 78 | A plugin consists of the main plugin class and one or more roles. The main 79 | class currently looks like this: 80 | 81 | package Mason::Plugin::MyPlugin; 82 | use Moose; 83 | with 'Mason::Plugin'; 84 | 85 | # Optional: declare other plugin dependencies 86 | method requires_plugins { qw(A @D) } 87 | 88 | 1; 89 | 90 | __END__ 91 | 92 | =pod 93 | 94 | =head1 NAME 95 | 96 | Mason::Plugin::MyPlugin - My plugin 97 | 98 | .... 99 | 100 | Its main responsibilities are to include the role 'Mason::Plugin' and document 101 | itself. It may also specify a C that returns a list of 102 | dependencies with the same syntax as the C parameter to Cnew>. 103 | 104 | The real action is in the role classes, which live underneath, and each modify 105 | a single Mason class: 106 | 107 | package Mason::Plugin::MyPlugin::Interp; 108 | use Mason::PluginRole; 109 | 110 | # Modify Mason::Interp 111 | 112 | ... 113 | 114 | package Mason::Plugin::MyPlugin::Compilation; 115 | use Mason::PluginRole; 116 | 117 | # Modify Mason::Compilation 118 | 119 | ... 120 | 121 | When a plugin is applied, each of its roles will be automatically applied to 122 | the appropriate Mason class. For example, in the example above 123 | C and C 124 | will be applied to Mason::Interp and Mason::Compilation respectively. 125 | 126 | =head2 Pluggable Mason classes 127 | 128 | As of this writing the following Mason classes can be modified with plugins: 129 | 130 | Mason::CodeCache 131 | Mason::Compilation 132 | Mason::Component 133 | Mason::Component::ClassMeta 134 | Mason::Component::Import 135 | Mason::Component::Moose 136 | Mason::Interp 137 | Mason::Request 138 | Mason::Result 139 | 140 | =head2 Extra classes in plugin 141 | 142 | If you have extra classes in your plugin that aren't automatically providing a 143 | role to a Mason class, put them in C or the C subdirectory, 144 | e.g. 145 | 146 | package Mason::Plugin::MyPlugin::Extra::Utils; 147 | ... 148 | 149 | That will ensure that your classname will not conflict with a future Mason 150 | class name. 151 | 152 | =head1 CREATING PLUGIN BUNDLES 153 | 154 | A plugin bundle just collects one or more plugins and/or other bundles. It 155 | looks like this: 156 | 157 | package Mason::PluginBundle::MyBundle 158 | use Moose; 159 | with 'Mason::PluginBundle'; 160 | 161 | sub requires_plugins { 162 | return ( 163 | 'A', 164 | 'B', 165 | '+My::Plugin::C', 166 | '@D', 167 | '+My::PluginBundle::E', 168 | ); 169 | } 170 | 171 | 1; 172 | 173 | __END__ 174 | 175 | =pod 176 | 177 | =head1 NAME 178 | 179 | Mason::PluginBundle::MyBundle - My plugin bundle 180 | 181 | =head1 INCLUDED PLUGINS 182 | 183 | =over 184 | 185 | =item A 186 | =item B 187 | =item +My::Plugin::C 188 | =item @D 189 | =item +My::PluginBundle::E 190 | 191 | =back 192 | 193 | .... 194 | 195 | The C method returns a list of entries, with the same syntax 196 | as the C parameter to Cnew>. 197 | 198 | =head1 ACKNOWLEDGEMENTS 199 | 200 | Thanks to Ricardo Signes for L and 201 | L, which got me thinking in plugins and lent the 202 | plugin and bundle name syntax. 203 | 204 | -------------------------------------------------------------------------------- /lib/Mason/Manual/RequestDispatch.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Mason::Manual::RequestDispatch - How request paths get mapped to page 5 | components 6 | 7 | =head1 DESCRIPTION 8 | 9 | Given the request path 10 | 11 | /news/sports/hockey 12 | 13 | Mason searches for the following components in order, setting $m->path_info as 14 | noted. 15 | 16 | /news/sports/hockey.{mp,mc} 17 | /news/sports/hockey/index.{mp,mc} 18 | /news/sports/hockey/dhandler.{mp,mc} 19 | /news/sports/dhandler.{mp,mc} # $m->path_info = hockey 20 | /news/sports.{mp,mc} # $m->path_info = hockey (but see next section) 21 | /news/dhandler.{mp,mc} # $m->path_info = sports/hockey 22 | /news.{mp,mc} # $m->path_info = sports/hockey (but see next section) 23 | /dhandler.{mp,mc} # $m->path_info = news/sports/hockey 24 | 25 | where C<< .{mp,mc} >> means either C<.mp> (indicating a I 26 | component). or C<.mc> (indicating a I component). 27 | 28 | The following sections describe these elements in more detail. 29 | 30 | =head2 Autoextended path 31 | 32 | The request path is suffixed with ".mp" and ".mc" to translate it to a 33 | component path. 34 | 35 | /news/sports/hockey.{mp,mc} 36 | 37 | =head2 Index 38 | 39 | An index matches its exact directory, nothing underneath. 40 | 41 | /news/sports/hockey/index.{mp,mc} 42 | 43 | =head2 Dhandlers 44 | 45 | A dhandler matches its directory as well as anything underneath, setting C<< 46 | $m->path_info >> to the remainder. 47 | 48 | /news/sports/hockey/dhandler.{mp,mc} 49 | /news/sports/dhandler.{mp,mc} # $m->path_info = hockey 50 | /news/dhandler.{mp,mc} # $m->path_info = sports/hockey 51 | /dhandler.{mp,mc} # $m->path_info = news/sports/hockey 52 | 53 | =head2 Partial paths 54 | 55 | A component can match an initial part of the URL, setting C<< $m->path_info >> 56 | to the remainder: 57 | 58 | /news/sports.{mp,mc} # $m->path_info = hockey 59 | /news.{mp,mc} # $m->path_info = sports/hockey 60 | 61 | Since this isn't always desirable behavior, it must be explicitly enabled for 62 | the component. Mason will call method C on the component 63 | class, and will only allow the match if it returns true: 64 | 65 | <%class> 66 | method allow_path_info { 1 } 67 | 68 | 69 | The default C returns false. 70 | 71 | C is not checked on dhandlers, since the whole point of 72 | dhandlers is to match partial paths. 73 | 74 | =head2 Trailing slash 75 | 76 | If the request URL has a trailing slash (ends with C), we remove it before 77 | the match process begins and add it to the C<< $m->path_info >>. Components 78 | that should match must have C return true. 79 | 80 | For example: 81 | 82 | ## request URL /news/ 83 | /news/index.{mp,mc} # $m->path_info = / if index.{mp,mc} has 84 | # allow_path_info => true 85 | /news/dhandler.{mp,mc} # $m->path_info = / 86 | /news.{mp,mc} # $m->path_info = / if news.{mp,mc} has 87 | # allow_path_info => true 88 | 89 | ## request URL /news/sports/ 90 | /news/sports/index.{mp,mc} # $m->path_info = / if index.{mp,mc} has 91 | # allow_path_info => true 92 | /news/sports/dhandler.{mp,mc} # $m->path_info = / 93 | /news/sports.{mp,mc} # $m->path_info = / if sports.{mp,mc} 94 | # has allow_path_info => true 95 | /news/dhandler.{mp,mc} # $m->path_info = sports/ 96 | /news.{mp,mc} # $m->path_info = /sports/ if news.{mp,mc} 97 | # has allow_path_info => true 98 | 99 | =head2 Routes 100 | 101 | It is possible to use route syntax to more elegantly parse C<< $m->path_info >> 102 | for dhandlers and partial paths, e.g. 103 | 104 | <%class> 105 | route "{year:[0-9]+}/{month:[0-9]{2}}"; 106 | 107 | 108 | See L. 109 | 110 | -------------------------------------------------------------------------------- /lib/Mason/Manual/Setup.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Mason::Manual::Setup - Setting up Mason 5 | 6 | =head1 SETUP 7 | 8 | =head2 Web development 9 | 10 | The most common use of Mason is to generate dynamic web content. 11 | 12 | L is a web framework designed specifically to work with Mason. Given an 13 | HTTP request, Poet generates a corresponding Mason request, and uses the output 14 | from Mason to form the HTTP response. Poet takes care of the web development 15 | details that are outside of Mason's domain, such as server integration and 16 | configuration. L shows how to 17 | set up a Poet/Mason site in great detail. 18 | 19 | Mason can also be used in the popular web frameworks L and 20 | L, as a drop-in replacement for their default template engines. 21 | See L and 22 | L. 23 | 24 | =head2 Non-web development 25 | 26 | Mason can be used to generate any kind of dynamic content. I have personally 27 | used it to generate Apache configuration files, emails, and C++ code. 28 | 29 | To use Mason from a script or library, use the L API: 30 | 31 | my $interp = Mason->new( 32 | comp_root => '/path/to/comps', 33 | data_dir => '/path/to/data', 34 | ... 35 | ); 36 | my $output = $interp->run( '/request/path', foo => 5 )->output(); 37 | 38 | If you want to process a directory with a mix of Mason templates and static 39 | files, check out L. 40 | 41 | To try out Mason syntax from the command line, use the L script: 42 | 43 | % mason 44 | 2 + 2 = <% 2+2 %> 45 | ^D 46 | 2 + 2 = 4 47 | 48 | =head1 LOGGING 49 | 50 | Mason uses L to log various events, such as the start and 51 | end of each request. You can direct thesse logs to the output of your choice; 52 | see L. If you don't specify anything then 53 | the logs will go into the void. 54 | 55 | =cut 56 | -------------------------------------------------------------------------------- /lib/Mason/Manual/Subclasses.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Mason::Manual::Subclasses - Creating custom subclasses of Mason's classes 5 | 6 | =head1 DESCRIPTION 7 | 8 | You can subclass the following Mason classes for your application: 9 | 10 | Mason::CodeCache 11 | Mason::Compilation 12 | Mason::Component 13 | Mason::Component::ClassMeta 14 | Mason::Component::Import 15 | Mason::Component::Moose 16 | Mason::Interp 17 | Mason::Request 18 | Mason::Result 19 | 20 | and arrange things so that Mason always uses your subclass instead of its 21 | default class. 22 | 23 | Note: if you want to create a general purpose modification to Mason to use in 24 | multiple applications, you should probably create a 25 | L instead of a subclass. 26 | 27 | =head1 CREATING A SUBCLASS 28 | 29 | A subclass should look something like this: 30 | 31 | package My::Mason::Interp; 32 | use Moose; 33 | extends 'Mason::Interp'; 34 | 35 | # put your modifications here 36 | 37 | 1; 38 | 39 | =head1 LETTING MASON KNOW ABOUT YOUR SUBCLASSES 40 | 41 | There are two ways to let Mason know about your subclasses: by naming 42 | convention, and by parameters to C<< Mason->new >>. 43 | 44 | =head2 By naming convention 45 | 46 | First, create a subclass of Mason itself: 47 | 48 | package My::Mason; 49 | use Moose; 50 | extends 'Mason'; 51 | 52 | 1; 53 | 54 | and use that in place of C<< Mason >> in construction: 55 | 56 | my $interp = My::Mason->new(); 57 | 58 | Now, you can place any subclasses under 'My::Mason' and they'll automatically 59 | be picked up. e.g. 60 | 61 | My::Mason::Compilation 62 | My::Mason::Interp 63 | My::Mason::Request 64 | 65 | =head1 By constructor parameter 66 | 67 | You can specify your subclasses via "base_*" parameters to C<< Mason->new() >>. 68 | e.g. 69 | 70 | my $interp = Mason->new( 71 | base_compilation_class => 'My::Mason::Compilation', 72 | base_interp_class => 'My::Mason::Interp' 73 | base_request_class => 'Some::Other::Mason::Request' 74 | ); 75 | 76 | See L for a complete list. 77 | 78 | -------------------------------------------------------------------------------- /lib/Mason/Manual/Syntax.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Mason::Manual::Syntax - Mason component syntax reference 5 | 6 | =head1 DESCRIPTION 7 | 8 | A reference for all the syntax that can be used in components. 9 | 10 | =head1 SUBSTITUTION TAGS 11 | 12 | =head2 <% I %> 13 | 14 | Blocks of the form C<< <% expr %> >> are replaced with the result of evaluating 15 | C as a Perl expression in scalar context. 16 | 17 | Hello, <% $name %>! The current time is <% scalar(localtime) %>. 18 | 19 | Whitespace after '<%' and before '%>' is required. This gives us a little 20 | leeway in implementing variations on this tag in the future - it also just 21 | looks better. 22 | 23 | =head2 <% I | I,I... %> 24 | 25 | A filter list may appear after a << | >> character in a substitution, 26 | containing one or more names separated by commas. The names are as filter 27 | methods on the current component class. The filters are applied to the result 28 | before it is output. 29 | 30 | <% $content | NoBlankLines,Trim %> 31 | 32 | See L for more information on filters. 33 | 34 | =head1 PERL LINES 35 | 36 | =head2 %-lines 37 | 38 | Lines beginning with a single '%' are treated as Perl. The '%' must be followed 39 | by at least one whitespace character. 40 | 41 |
      42 | % foreach my $item (@items) { 43 |
    • <% $item %>
      • 44 | % } 45 |
    46 | 47 | % if ($.logged_in) { 48 |
    49 | Welcome, <% $.username %>. 50 |
    51 | % } 52 | % else { 53 | Click here to log in 54 | % } 55 | 56 | =head1 UNNAMED BLOCKS 57 | 58 | Blocks that do not take a name argument. 59 | 60 | =head2 <%class> 61 | 62 | Contains Perl code code that executes once when the component is loaded, in the 63 | main body of the class outside of any methods. This is the place to use 64 | modules, declare attributes, and do other things on a class level. 65 | 66 | <%class> 67 | 68 | 69 | =head2 <%doc> 70 | 71 | Text in this section is treated as a comment and ignored. 72 | 73 | <%doc> 74 | Name: foo.mc 75 | Purpose: ... 76 | 77 | 78 | =head2 <%flags> 79 | 80 | Specifies flags that affect the compilation of the component. Each flag is 81 | listed one per line in C<< key => value >> form. 82 | 83 | <%flags> 84 | extends => '/foo/bar' 85 | 86 | 87 | The C<< <%flags> >> block is extracted in a special first pass through the 88 | component, so that it can affect the remainder of the compilation. 89 | 90 | The built-in flags are: 91 | 92 | =over 93 | 94 | =item extends 95 | 96 | Declares the component's superclass (another component). The path may be 97 | absolute as shown above, or relative to the component's path. This is the only 98 | way to declare the component's superclass; using an C<< extends >> keyword 99 | directly will not work reliably. If not provided, the component's superclass is 100 | determined automatically via L. 102 | 103 | =back 104 | 105 | Plugins may implement additional flags. 106 | 107 | =head2 <%init> 108 | 109 | Contains Perl code that is executed at the beginning of the current method. 110 | Equivalent to a C<< <%perl> >> section at the top of the method. 111 | 112 | <%init> 113 | my $article = MyApp::Article->find($.article_id); 114 | my $title = $article->title; 115 | 116 | 117 | =head2 <%perl> 118 | 119 | Contains Perl code that is executed in place. The return value, if any, is 120 | discarded. May appear anywhere in the text and any number of times. 121 | 122 | <%perl> 123 | my $article = MyApp::Article->find($.article_id); 124 | my $title = $article->title; 125 | 126 | 127 | =head2 <%text> 128 | 129 | Text in this section is printed as-is with all Mason syntax ignored. 130 | 131 | <%text> 132 | % This is an example of a Perl line. 133 | <% This is an example of an expression block. %> 134 | 135 | 136 | This works for almost everything, but doesn't let you output C<< >> 137 | itself! When all else fails, use L: 138 | 139 | % $m->print('The tags are <%text> and .'); 140 | 141 | =head1 NAMED BLOCKS 142 | 143 | Blocks that take a name argument. 144 | 145 | =head2 <%method I I> 146 | 147 | Creates a new method with the specified I and I. Uses 148 | L underneath, so 149 | C<$self> and any other declared parameters are automatically shifted off of 150 | C<@_>. 151 | 152 | <%method greet ($name, $color)> 153 |
    154 | Hello, <% $name %>! 155 |
    156 | 157 | 158 | =head2 <%after I> 159 | 160 | =head2 <%augment I> 161 | 162 | =head2 <%around I> 163 | 164 | =head2 <%before I> 165 | 166 | =head2 <%override I> 167 | 168 | Modifies a content-producing method with the specified I. See 169 | L for a description of each modifier. 170 | 171 | C<$self> is automatically shifted off for the body of C<< <%after> >>, C<< 172 | <%augment> >>, C<< <%before> >> and C< <%override> >. C<$orig> and C<$self> are 173 | automatically shifted off for the body of C<< <%around> >>. 174 | 175 | <%after render> 176 | <% # Add analytics line after everything has rendered %> 177 | <& /shared/google_analytics_line.mi &> 178 | 179 | 180 | <%augment wrap> 181 | 182 | 183 | <% inner() %> 184 | 185 | 186 | 187 | 188 | <%around navbar> 189 |
    190 | <% $self->$orig() %> 191 |
    192 | 193 | 194 | <%override navbar> 195 | <% super() %> 196 | extra 197 | 198 | 199 | =head2 <%filter I I> 200 | 201 | Creates a filter method with the specified I and I. Works just 202 | like a C<< <%method> >> block, except that you can call C<< $yield->() >> to 203 | generate the original content. e.g. 204 | 205 | <%filter Row ($class)> 206 | 207 | % foreach my $item (split(/\s/, $yield->())) { 208 | <% $item %> 209 | % } 210 | 211 | 212 | 213 | % $.Row('std') {{ 214 | First Second Third 215 | % }} 216 | 217 | generates 218 | 219 | 220 | First 221 | Second 222 | Third 223 | 224 | 225 | See L for more information on filters. 226 | 227 | =head1 CALLING COMPONENTS 228 | 229 | =head2 <& I, I &> 230 | 231 | <& /path/to/comp.mi, name=>value, ... &> 232 | 233 | I is an absolute or relative component path. If the latter, it is 234 | considered relative to the location of the current component. I is a list 235 | of one or more name/value pairs. 236 | 237 | The path may be a literal string (quotes optional) or a Perl expression that 238 | evaluates to a string. To eliminate the need for quotes in most cases, Mason 239 | employs some magic parsing: If the first character is one of C<[\w/\.]>, 240 | comp_path is assumed to be a literal string running up to the first comma or 241 | &>. Otherwise, comp_path is evaluated as an expression. 242 | 243 | Here are some examples: 244 | 245 | # relative component paths 246 | <& topimage.mi &> 247 | <& tools/searchbox.mi &> 248 | 249 | # absolute component path 250 | <& /shared/masthead.mi, color=>'salmon' &> 251 | 252 | # this component path MUST have quotes because it contains a comma 253 | <& "sugar,eggs.mi", mix=>1 &> 254 | 255 | # variable component path 256 | <& $comp &> 257 | 258 | # variable component and attributes 259 | <& $comp, %args &> 260 | 261 | # you can use arbitrary expression for component path, but it cannot 262 | # begin with a letter or number; delimit with () to remedy this 263 | <& (int(rand(2)) ? 'thiscomp.mi' : 'thatcomp.mi'), id=>123 &> 264 | 265 | You can also call components with the L and 266 | L methods. 267 | 268 | =head1 COMMENTS 269 | 270 | =head2 <% # comment... %> 271 | 272 | A C<< <% %> >> tag is considered a comment if all of its lines are either 273 | whitespace, or begin with a '#' optionally preceded by whitespace. For example, 274 | 275 | <% # This is a single-line comment %> 276 | 277 | <% 278 | # This is a 279 | # multi-line comment 280 | %> 281 | 282 | =head2 % # comment 283 | 284 | Because a line beginning with C<%> is treated as Perl, C<% #> automatically 285 | works as a comment. However we prefer the C<< <% # comment %> >> form over C<< 286 | % # >>, because it stands out a little more as a comment and because it is more 287 | flexible with regards to preceding whitespace. 288 | 289 | =head2 % if (0) { } 290 | 291 | Anything between these two lines 292 | 293 | % if (0) { 294 | ... 295 | % } 296 | 297 | will be skipped by Mason, including component calls. While we don't recomend 298 | this for comments per se, it is a useful notation for "commenting out" code 299 | that you don't want to run. 300 | 301 | =head2 HTML/XML/... comments 302 | 303 | HTML and other markup languages will have their own comment markers, for 304 | example C<< >>. Note two important differences with these comments 305 | versus the above comments: 306 | 307 | =over 308 | 309 | =item * 310 | 311 | They will be sent to the client and appear in the source of the page. 312 | 313 | =item * 314 | 315 | They do not block component calls and other code from running, so don't try to 316 | use them to comment out code! 317 | 318 | 321 | 322 | =back 323 | 324 | =head1 WHITESPACE AND NEWLINES 325 | 326 | =head2 Newlines between blocks 327 | 328 | Mason will ignore a single newline between blocks, so that you can space them 329 | nicely. Additional newlines beyond that will be displayed. 330 | 331 | <%class> 332 | ... 333 | 334 | <-- ignored 335 | <%method foo> 336 | ... 337 | 338 | <-- ignored 339 | <-- displayed 340 | <%method bar> 341 | ... 342 | 343 | 344 | =head2 Backslash at end of line 345 | 346 | A backslash (\) at the end of a line suppresses the newline. In HTML 347 | components, this is mostly useful for fixed width areas like C<< 
     >> tags,
348 | since browsers ignore white space for the most part. An example:
349 | 
350 |     
    351 |     foo
352 |     % if (1) {
353 |     bar
354 |     % }
355 |     baz
356 |     
    
357 | 
358 | outputs
359 | 
360 |     foo
361 |     bar
362 |     baz
363 | 
364 | because of the newlines on lines 2 and 4. (Lines 3 and 5 do not generate a
365 | newline because the entire line is taken by Perl.) To suppress the newlines:
366 | 
367 |     
    368 |     foo\
369 |     % if (1) {
370 |     bar\
371 |     % }
372 |     baz
373 |     
    
374 | 
375 | which prints
376 | 
377 |     foobarbaz
378 | 
379 | =cut
380 | 


--------------------------------------------------------------------------------
/lib/Mason/Manual/Tutorial.pod:
--------------------------------------------------------------------------------
 1 | 
 2 | =head1 NAME
 3 | 
 4 | Mason::Manual::Tutorial - Mason tutorial (DEPRECATED - SEE POET)
 5 | 
 6 | =head1 DESCRIPTION
 7 | 
 8 | This tutorial has moved to L.
 9 | 
10 | 


--------------------------------------------------------------------------------
/lib/Mason/Manual/UpgradingFromMason1.pod:
--------------------------------------------------------------------------------
  1 | 
  2 | =head1 NAME
  3 | 
  4 | Mason::Manual::UpgradingFromMason1 - Summary of differences between Mason 1 and
  5 | Mason 2
  6 | 
  7 | =head1 DESCRIPTION
  8 | 
  9 | Mason 2.x comes ten years after Mason 1.0 (known as L) and twelve
 10 | years after the original Mason release.  It has been rearchitected and
 11 | reimplemented from the ground up.
 12 | 
 13 | That said, the philosophy and core syntax are similar enough that it should
 14 | still be recognizable and "feel like Mason" to existing users.
 15 | 
 16 | This manual attempts to summarize the differences between Mason 1 and 2, to
 17 | help existing users decide if they are interested and, if so, migrate their
 18 | projects.
 19 | 
 20 | There is currently no automated way to convert a Mason 1 to a Mason 2 site, but
 21 | there hopefully will be someday. (Contributions welcome. :))
 22 | 
 23 | =head1 ARCHITECTURE
 24 | 
 25 | =over
 26 | 
 27 | =item *
 28 | 
 29 | In Mason 1, each component was an instance of a common Component class. In
 30 | Mason 2, each component is its I Moose class, with a class name generated
 31 | from the component path.
 32 | 
 33 | =item *
 34 | 
 35 | The main component body - the content and the inline Perl sections - are placed
 36 | into a C
     method.
 37 | 
 38 | =item *
 39 | 
 40 | Calling a component (via C<< <& &> >> or C<< $m->comp >> ) entails creating a
 41 | new instance of the component class, and calling its C
     method. Component
 42 | call parameters are passed to the constructor and placed in attributes.
 43 | 
 44 | =back
 45 | 
 46 | =head1 MAJOR FEATURES
 47 | 
 48 | =over
 49 | 
 50 | =item *
 51 | 
 52 | B now utilize Moose roles and are much more powerful and flexible than
 53 | in Mason 1. Some features that were (or would have been) in the core of Mason 1
 54 | are now in plugins. See L.
 55 | 
 56 | =item *
 57 | 
 58 | B in Mason 1 was centered around mod_perl and was part of the
 59 | core. In Mason 2 all web integration has been split out into a companion web
 60 | framework, L, which in turn uses L to integrate with any server
 61 | backend.  You can also use Mason as the templating layer in popular web
 62 | frameworks such as L and L.  There is no longer anything
 63 | web-specific in the Mason core.
 64 | 
 65 | =item *
 66 | 
 67 | B have been eliminated, replaced with class methods.
 68 | 
 69 | =item *
 70 | 
 71 | B has been eliminated. Mason now simply throws
 72 | fatal errors to the caller.  In a L environment,
 73 | L will catch the
 74 | error and format it nicely.
 75 | 
 76 | =item *
 77 | 
 78 | B and B have been eliminated. Components need
 79 | to be in files.  If your components live in another data source, you could use
 80 | L or a custom plugin to keep a file
 81 | hierarchy up to date with the data source.
 82 | 
 83 | =item *
 84 | 
 85 | B support has been simplified. C<< $m->cache >> simply returns a
 86 | L object with an appropriate namespace for the component.
 87 | 
 88 | =back
 89 | 
 90 | =head1 SYNTAX
 91 | 
 92 | =over
 93 | 
 94 | =item *
 95 | 
 96 | C<< <%once> >> has been replaced with C<< <%class> >>.
 97 | 
 98 | =item *
 99 | 
100 | C<< <%cleanup> >> has been eliminated; it was not very useful anyway, since it
101 | was not guaranteed to run after an exception. You can use
102 | L to add cleanup code for the end of
103 | the request, which is good enough in most cases, or you can add a C
104 | method to the component.
105 | 
106 | =item *
107 | 
108 | Single blank lines between blocks are now removed, so you can space blocks out
109 | for readability without generating a ton of newlines.
110 | 
111 | =item *
112 | 
113 | Whitespace is required after a %-line and around the expression in a C<< <% %>
114 | >> tag.  This improves readability and leaves open the possibility of
115 | additional syntax.
116 | 
117 | =item *
118 | 
119 | C<< <%args> >> and C<< <%shared> >> are gone. Use Moose attributes instead.
120 | 
121 | =item *
122 | 
123 | The C<< <%ARGS> >> hash is gone, you can instead use C<< $.args >> or C<<
124 | $self->args >> to get all the parameters passed to a component.
125 | 
126 | =item *
127 | 
128 | C<< <%method> >> and C<< <%def> >> have been replaced with just C<< <%method>
129 | >>, which creates a true class method rather than a subcomponent.
130 | 
131 | =item *
132 | 
133 | The C<< <%filter> >> tag is now used to define filters, instead of
134 | automatically applying a filter to the current component.
135 | 
136 | =item *
137 | 
138 | C<< Components with content >> syntax has been eliminated; use the
139 | L filter instead.
140 | 
141 | =item *
142 | 
143 | C<< Escape flags >> in substitution tags now utilize
144 | L.
145 | 
146 | =back
147 | 
148 | =head1 MISC PARAMETER CHANGES
149 | 
150 | =head2 Interp parameters
151 | 
152 | =over
153 | 
154 | =item *
155 | 
156 | C, C and C have
157 | been deemed unnecessary and eliminated.
158 | 
159 | =item *
160 | 
161 | C has been eliminated; define filters instead.
162 | 
163 | =item *
164 | 
165 | C now defaults to a directory created with
166 | L.
167 | 
168 | =item *
169 | 
170 | C has been eliminated; this code does roughly the same:
171 | 
172 |     $interp->load($_) for (grep { /some_condition/ } $interp->all_paths);
173 | 
174 | =back
175 | 
176 | =head2 Request parameters
177 | 
178 | =over
179 | 
180 | =item *
181 | 
182 | C and C have been eliminated because they are too
183 | difficult to implement efficiently.
184 | 
185 | =back
186 | 
187 | =head2 Compiler parameters
188 | 
189 | =over
190 | 
191 | =item *
192 | 
193 | C, C, and C have been
194 | eliminated; similar effects can be achieved with plugins targeting
195 | L.
196 | 
197 | =item *
198 | 
199 | C has been eliminated, but see
200 | L for a third-party
201 | substitute.
202 | 
203 | =back
204 | 
205 | =head1 MISC METHOD CHANGES
206 | 
207 | =head2 Interp methods
208 | 
209 | =over
210 | 
211 | =item *
212 | 
213 | C has been renamed to L.
214 | 
215 | =back
216 | 
217 | =head2 Request methods
218 | 
219 | =over
220 | 
221 | =item *
222 | 
223 | C has been eliminated; use the L
224 | instead.
225 | 
226 | =item *
227 | 
228 | C, C and C have been eliminated; now that
229 | component calls are simply method calls underneath, they are too difficult to
230 | implement efficiently.
231 | 
232 | =item *
233 | 
234 | C has been replaced with Moose's C.
235 | 
236 | =item *
237 | 
238 | C has been eliminated; use L
239 | instead.
240 | 
241 | =item *
242 | 
243 | C has been eliminated. Within a component, use C<< $self >>;
244 | outside a component you can call
245 | L, which will at least
246 | get you the class.
247 | 
248 | =item *
249 | 
250 | C has been renamed to L.
251 | 
252 | =item *
253 | 
254 | C has been renamed to L.
255 | 
256 | =item *
257 | 
258 | C has been renamed to L.
259 | 
260 | =item *
261 | 
262 | C has been replaced with L and
263 | L.
264 | 
265 | =back
266 | 


--------------------------------------------------------------------------------
/lib/Mason/Moose.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Moose;    ## no critic (Moose::RequireMakeImmutable)
 2 | 
 3 | use Moose                      ();
 4 | use MooseX::HasDefaults::RO    ();
 5 | use MooseX::StrictConstructor  ();
 6 | use Method::Signatures::Simple ();
 7 | use Moose::Exporter;
 8 | use strict;
 9 | use warnings;
10 | Moose::Exporter->setup_import_methods( also => ['Moose'] );
11 | 
12 | sub init_meta {
13 |     my $class     = shift;
14 |     my %params    = @_;
15 |     my $for_class = $params{for_class};
16 |     Method::Signatures::Simple->import( into => $for_class );
17 |     Moose->init_meta(@_);
18 |     MooseX::StrictConstructor->import( { into => $for_class } );
19 |     MooseX::HasDefaults::RO->import( { into => $for_class } );
20 |     {
21 |         no strict 'refs';
22 |         my $temp = $for_class;
23 |         *{ $for_class . '::CLASS' } = sub () { $temp };    # like CLASS.pm
24 |     }
25 | }
26 | 
27 | 1;
28 | 
29 | __END__
30 | 
31 | =pod
32 | 
33 | =head1 NAME
34 | 
35 | Mason::Moose - Mason Moose policies
36 | 
37 | =head1 SYNOPSIS
38 | 
39 |     # instead of use Moose;
40 |     use Mason::Moose;
41 | 
42 | =head1 DESCRIPTION
43 | 
44 | Sets certain Moose behaviors for Mason's internal classes. Using this module is
45 | equivalent to
46 | 
47 |     use CLASS;
48 |     use Moose;
49 |     use MooseX::HasDefaults::RO;
50 |     use MooseX::StrictConstructor;
51 |     use Method::Signatures::Simple;
52 | 


--------------------------------------------------------------------------------
/lib/Mason/Moose/Role.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Moose::Role;
 2 | 
 3 | use Moose::Role                ();
 4 | use Method::Signatures::Simple ();
 5 | use Moose::Exporter;
 6 | Moose::Exporter->setup_import_methods( also => ['Moose::Role'] );
 7 | 
 8 | sub init_meta {
 9 |     my $class     = shift;
10 |     my %params    = @_;
11 |     my $for_class = $params{for_class};
12 |     Method::Signatures::Simple->import( into => $for_class );
13 |     Moose::Role->init_meta(@_);
14 | }
15 | 
16 | 1;
17 | 
18 | __END__
19 | 
20 | =pod
21 | 
22 | =head1 NAME
23 | 
24 | Mason::Moose::Role - Mason Moose role policies
25 | 
26 | =head1 SYNOPSIS
27 | 
28 |     # instead of use Moose::Role;
29 |     use Mason::Moose::Role;
30 | 
31 | =head1 DESCRIPTION
32 | 
33 | Sets certain Moose behaviors for Mason's internal roles. Using this module is
34 | equivalent to
35 | 
36 |     use Moose::Role;
37 |     use Method::Signatures::Simple;
38 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin;
 2 | 
 3 | use Mason::PluginRole;
 4 | use Mason::Util qw(can_load);
 5 | use Class::Load;
 6 | 
 7 | method requires_plugins ($plugin_class:) {
 8 |     return ();
 9 | }
10 | 
11 | method expand_to_plugins ($plugin_class:) {
12 |     return ( $plugin_class,
13 |         Mason::PluginManager->process_plugin_specs( [ $plugin_class->requires_plugins ] ) );
14 | }
15 | 
16 | method get_roles_for_mason_class ($plugin_class: $name) {
17 |     my @roles_to_try = join( "::", $plugin_class, $name );
18 |     if ( $name eq 'Component' ) {
19 |         push( @roles_to_try, join( "::", $plugin_class, 'Filters' ) );
20 |     }
21 |     my @roles = grep { Class::Load::is_class_loaded($_) || can_load($_) } @roles_to_try;
22 |     return @roles;
23 | }
24 | 
25 | 1;
26 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/.gitignore:
--------------------------------------------------------------------------------
1 | HTMLFilters
2 | HTMLFilters.pm
3 | PSGIHandler
4 | PSGIHandler.pm
5 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/Defer.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin::Defer;
 2 | 
 3 | use Moose;
 4 | with 'Mason::Plugin';
 5 | 
 6 | __PACKAGE__->meta->make_immutable();
 7 | 
 8 | 1;
 9 | 
10 | __END__
11 | 
12 | =pod
13 | 
14 | =head1 NAME
15 | 
16 | Mason::Plugin::Defer - Defer computing parts of output until the end of the
17 | request
18 | 
19 | =head1 SYNOPSIS
20 | 
21 |     
22 |     <% $m->defer(sub { $m->page->title }) %>
23 | 
24 |     % $.Defer {{
25 |     %   my $content = join(", ", @{ $m->page->meta_content });
26 |     
27 |     % }}
28 | 
29 |     
30 |     ...
31 | 
32 | =head1 DESCRIPTION
33 | 
34 | The I feature allows sections of output to be deferred til the end of
35 | the request. You can set up multiple deferred code blocks which will execute
36 | and insert themselves into the output stream at request end.
37 | 
38 | =head1 REQUEST METHOD
39 | 
40 | =over
41 | 
42 | =item defer (code)
43 | 
44 | Returns a marker string that is unique and will not appear in normal output. At
45 | the end of the request, each marker string is replaced with the output of its
46 | associated code. e.g.
47 | 
48 |     <% $m->defer(sub { $m->page->title }) %>
49 | 
50 | =back
51 | 
52 | =head1 FILTER
53 | 
54 | =over
55 | 
56 | =item Defer
57 | 
58 | Applies C<< $m->defer >> to the content block. e.g.
59 | 
60 |     % $.Defer {{
61 |     %   my $content = join(", ", @{ $m->page->meta_content });
62 |     
63 |     % }}
64 | 
65 | =back
66 | 
67 | =cut
68 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/Defer/Filters.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin::Defer::Filters;
 2 | 
 3 | use Mason::PluginRole;
 4 | 
 5 | method Defer () {
 6 |     Mason::DynamicFilter->new(
 7 |         filter => sub {
 8 |             $self->m->defer( $_[0] );
 9 |         }
10 |     );
11 | }
12 | 
13 | 1;
14 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/Defer/Request.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin::Defer::Request;
 2 | 
 3 | use Mason::PluginRole;
 4 | 
 5 | has 'defers' => ( is => 'rw', init_arg => undef, default => sub { [] } );
 6 | 
 7 | before 'flush_buffer' => sub {
 8 |     my $self = shift;
 9 |     $self->_apply_defers_to_request_buffer();
10 | };
11 | 
12 | method defer ($code) {
13 |     my $marker = $self->interp->_construct_distinct_string();
14 |     push( @{ $self->{defers} }, { marker => $marker, code => $code } );
15 |     return $marker;
16 | }
17 | 
18 | method _apply_defers_to_request_buffer () {
19 |     if ( my @defers = @{ $self->{defers} } ) {
20 |         my $request_buffer = ${ $self->_request_buffer };
21 |         foreach my $defer (@defers) {
22 |             my $subst = $defer->{marker};
23 |             my $repl  = $defer->{code}->();
24 |             $request_buffer =~ s/\Q$subst\E/$repl/;
25 |         }
26 |         ${ $self->_request_buffer } = $request_buffer;
27 |     }
28 | }
29 | 
30 | 1;
31 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/DollarDot.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin::DollarDot;
 2 | 
 3 | use Moose;
 4 | with 'Mason::Plugin';
 5 | 
 6 | __PACKAGE__->meta->make_immutable();
 7 | 
 8 | 1;
 9 | 
10 | __END__
11 | 
12 | =pod
13 | 
14 | =head1 NAME
15 | 
16 | Mason::Plugin::DollarDot - Allow $. as substitution for $self-> and in
17 | attribute names
18 | 
19 | =head1 SYNOPSIS
20 | 
21 |     <%class>
22 |     has 'name';
23 |     has 'date';
24 |     
25 | 
26 |     <%method greet>
27 |     Hello, <% $.name %>. Today is <% $.date %>.
28 |     
29 | 
30 |     ...
31 |     % $.greet();
32 | 
33 |     <%init>
34 |     # Set the date
35 |     $.date(scalar(localtime));
36 |     # or, if combined with LvalueAttributes
37 |     $.date = scalar(localtime);
38 |     
39 | 
40 | =head1 DESCRIPTION
41 | 
42 | This plugin substitutes C<< $.I >> for C<< $self->I >>
43 | in all Perl code inside components, so that C<< $. >> can be used when
44 | referring to attributes and calling methods. The actual regex is
45 | 
46 |     s/ \$\.([^\W\d]\w*) / \$self->$1 /gx;
47 | 
48 | =head1 RATIONALE
49 | 
50 | In Mason 2, components have to write C<< $self-> >> a lot to refer to
51 | attributes that were simple scalars in Mason 1. This eases the transition pain.
52 | C<< $. >> was chosen because of its similar use in Perl 6.
53 | 
54 | This plugin falls under the heading of gratuitous source filtering, which the
55 | author generally agrees is Evil. That said, this is a very limited filter, and
56 | seems unlikely to break any legitimate Perl syntax other than use of the C<< $.
57 | >> special variable (input line number).
58 | 
59 | =head1 BUGS
60 | 
61 | Will not interpolate as expected inside double quotes:
62 | 
63 |     "My name is $.name"   # nope
64 | 
65 | instead you have to do
66 | 
67 |     "My name is " . $.name
68 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/DollarDot/Compilation.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin::DollarDot::Compilation;
 2 | 
 3 | use Mason::PluginRole;
 4 | 
 5 | after 'process_perl_code' => sub {
 6 |     my ( $self, $coderef ) = @_;
 7 | 
 8 |     # Replace $. with $self->
 9 |     $$coderef =~ s/ \$\.([^\W\d]\w*) / \$self->$1 /gx;
10 | };
11 | 
12 | 1;
13 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/LvalueAttributes.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin::LvalueAttributes;
 2 | 
 3 | use Moose;
 4 | with 'Mason::Plugin';
 5 | 
 6 | __PACKAGE__->meta->make_immutable();
 7 | 
 8 | 1;
 9 | 
10 | __END__
11 | 
12 | =pod
13 | 
14 | =head1 NAME
15 | 
16 | Mason::Plugin::LvalueAttributes - Create lvalue accessors for all rw component
17 | attributes
18 | 
19 | =head1 SYNOPSIS
20 | 
21 |     <%class>
22 |     has 'a' => (is => "rw")
23 |     has 'b' => (is => "ro")
24 |     
25 | 
26 |     <%init>
27 |     # set a to 5
28 |     $.a = 5;
29 | 
30 |     # set a to 6
31 |     $.a(6);
32 | 
33 |     # error
34 |     $.b = 7;
35 |     
36 | 
37 | =head1 DESCRIPTION
38 | 
39 | This plugins creates an Lvalue accessor for every read/write attribute in the
40 | component. Which means that instead of writing:
41 | 
42 |     $.name( "Foo" );
43 | 
44 | you can use the more natural syntax
45 | 
46 |     $.name = "Foo";
47 | 
48 | =head1 WARNING
49 | 
50 | Standard Moose setter features such as type checking, triggers, and coercion
51 | will not work on Lvalue attributes. You should only use this plugin when the
52 | convenience of the Lvalue attributes outweighs the need for setter features.
53 | 
54 | =head1 ACKNOWLEDGEMENTS
55 | 
56 | Inspired by Christopher Brown's
57 | L.
58 | 
59 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/LvalueAttributes/Interp.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin::LvalueAttributes::Interp;
 2 | 
 3 | use Mason::PluginRole;
 4 | 
 5 | after 'modify_loaded_class' => sub {
 6 |     my ( $self, $compc ) = @_;
 7 |     $self->_add_lvalue_attribute_methods($compc);
 8 | };
 9 | 
10 | sub _add_lvalue_attribute_methods {
11 |     my ( $self, $class ) = @_;
12 | 
13 |     my @attrs = $class->meta->get_all_attributes();
14 |     foreach my $attr (@attrs) {
15 |         if ( $attr->_is_metadata eq 'rw' ) {
16 |             my $name = $attr->name;
17 |             $class->meta->add_method(
18 |                 $name,
19 |                 sub : lvalue {
20 |                     if ( defined( $_[1] ) ) {
21 |                         $_[0]->{$name} = $_[1];
22 |                     }
23 |                     $_[0]->{$name};
24 |                 }
25 |             );
26 |         }
27 |     }
28 | }
29 | 
30 | 1;
31 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/TidyObjectFiles.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin::TidyObjectFiles;
 2 | 
 3 | use Moose;
 4 | with 'Mason::Plugin';
 5 | 
 6 | __PACKAGE__->meta->make_immutable();
 7 | 
 8 | 1;
 9 | 
10 | __END__
11 | 
12 | =pod
13 | 
14 | =head1 NAME
15 | 
16 | Mason::Plugin::TidyObjectFiles - Tidy object files
17 | 
18 | =head1 DESCRIPTION
19 | 
20 | Uses perltidy to tidy object files (the compiled form of Mason components).
21 | 
22 | =head1 ADDITIONAL PARAMETERS
23 | 
24 | =over
25 | 
26 | =item tidy_options
27 | 
28 | A string of perltidy options. e.g.
29 | 
30 |     tidy_options => '-noll -l=72'
31 | 
32 |     tidy_options => '--pro=/path/to/.perltidyrc'
33 | 
34 | May include --pro/--profile to point to a .perltidyrc file. If omitted, will
35 | use default perltidy settings.
36 | 
37 | =back
38 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/TidyObjectFiles/Interp.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Plugin::TidyObjectFiles::Interp;
 2 | 
 3 | use Mason::PluginRole;
 4 | use Perl::Tidy;
 5 | 
 6 | has 'tidy_options' => ( is => 'ro' );
 7 | 
 8 | around 'write_object_file' => sub {
 9 |     my ( $orig, $self, $object_file, $object_contents ) = @_;
10 | 
11 |     my $argv = $self->tidy_options || '';
12 |     my $tidied_object_contents;
13 |     Perl::Tidy::perltidy(
14 |         'perltidyrc' => '/dev/null',
15 |         source       => \$object_contents,
16 |         destination  => \$tidied_object_contents,
17 |         prefilter    => sub { $self->prefilter( $_[0] ) },
18 |         postfilter   => sub { $self->postfilter( $_[0] ) },
19 |         argv         => $argv
20 |     );
21 |     $tidied_object_contents =~ s/^\s*(\#line .*)/$1/mg;
22 |     $self->$orig( $object_file, $tidied_object_contents );
23 | };
24 | 
25 | sub prefilter {
26 |     my $self = shift;
27 |     $_ = $_[0];
28 | 
29 |     # Turn method into sub
30 |     s/^method (.*)/sub $1 \#__METHOD/gm;
31 | 
32 |     return $_;
33 | }
34 | 
35 | sub postfilter {
36 |     my $self = shift;
37 |     $_ = $_[0];
38 | 
39 |     # Turn sub back into method
40 |     s/^sub (.*?)\s* \#__METHOD/method $1/gm;
41 | 
42 |     return $_;
43 | }
44 | 
45 | 1;
46 | 


--------------------------------------------------------------------------------
/lib/Mason/Plugin/make:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/perl
 2 | use Cwd qw(realpath);
 3 | use File::Basename;
 4 | use File::Path;
 5 | use File::Slurp;
 6 | use IPC::System::Simple qw(run);
 7 | use warnings;
 8 | use strict;
 9 | 
10 | my $cwd = dirname( realpath($0) );
11 | 
12 | my $class = shift(@ARGV) or die "usage: $0 Plugin";
13 | $class =~ s/\.pm$//;
14 | my $pmfile    = "$cwd/$class.pm";
15 | my $plugindir = "$cwd/$class";
16 | my $source    = "package Mason::Plugin::$class;
17 | use Moose;
18 | with 'Mason::Plugin';
19 | 
20 | 1;
21 | 
22 | =pod
23 | 
24 | =head1 NAME
25 | 
26 | =head1 SYNOPSIS
27 | 
28 | =head1 DESCRIPTION
29 | ";
30 | write_file( $pmfile, $source );
31 | mkpath( $plugindir, 0, 0775 );
32 | run("git add $pmfile $plugindir");
33 | run("$cwd/../../../t/make $class");
34 | 


--------------------------------------------------------------------------------
/lib/Mason/PluginBundle.pm:
--------------------------------------------------------------------------------
 1 | package Mason::PluginBundle;
 2 | 
 3 | use Mason::PluginRole;
 4 | 
 5 | method expand_to_plugins ($bundle_class:) {
 6 |     return Mason::PluginManager->process_plugin_specs( [ $bundle_class->requires_plugins ] );
 7 | }
 8 | 
 9 | requires 'requires_plugins';
10 | 
11 | 1;
12 | 


--------------------------------------------------------------------------------
/lib/Mason/PluginBundle/Default.pm:
--------------------------------------------------------------------------------
 1 | package Mason::PluginBundle::Default;
 2 | 
 3 | use Mason::PluginRole;
 4 | with 'Mason::PluginBundle';
 5 | 
 6 | sub requires_plugins { qw(Defer DollarDot) }
 7 | 
 8 | 1;
 9 | 
10 | __END__
11 | 
12 | =pod
13 | 
14 | =head1 NAME
15 | 
16 | Mason::PluginBundle::Default - Default plugins
17 | 
18 | =head1 INCLUDED PLUGINS
19 | 
20 | =over
21 | 
22 | =item L
23 | 
24 | =item L
25 | 
26 | =back
27 | 
28 | =head1 DESCRIPTION
29 | 
30 | Plugins in this bundle are always added by default, regardless of whether you
31 | pass a plugins list to C<< Mason->new >>. You can use the '-' prefix to remove
32 | individual plugins or the whole bundle. e.g.
33 | 
34 |     # Will get just the default plugins
35 |     Mason->new(...);
36 |     Mason->new(plugins => [], ...);
37 | 
38 |     # Will get the default plugins plus the 'Foo' plugin
39 |     Mason->new(plugins => ['Foo'], ...);
40 | 
41 |     # Will get the default plugins except for 'DollarDot'
42 |     Mason->new(plugins => ['-DollarDot'], ...);
43 | 
44 |     # Will get no plugins
45 |     Mason->new(plugins => ['-Default'], ...);
46 | 


--------------------------------------------------------------------------------
/lib/Mason/PluginManager.pm:
--------------------------------------------------------------------------------
 1 | package Mason::PluginManager;
 2 | 
 3 | use Carp;
 4 | use Log::Any qw($log);
 5 | use Mason::Moose;
 6 | use Mason::Util qw(can_load uniq);
 7 | 
 8 | my ( %apply_plugins_cache, %final_subclass_seen );
 9 | 
10 | # CLASS METHODS
11 | #
12 | 
13 | our $depth;
14 | our %visited;
15 | my $max_depth = 16;
16 | 
17 | method process_top_plugin_specs ($class: $plugin_specs) {
18 |     local $depth   = 0;
19 |     local %visited = ();
20 | 
21 |     my @positive_plugin_specs = grep { !/^\-/ } @$plugin_specs;
22 |     my @negative_plugin_specs = map { substr( $_, 1 ) } grep { /^\-/ } @$plugin_specs;
23 |     push( @positive_plugin_specs, '@Default' );
24 |     my %exclude_plugin_modules =
25 |       map { ( $_, 1 ) } $class->process_plugin_specs( \@negative_plugin_specs );
26 | 
27 |     my @modules =
28 |       grep { !$exclude_plugin_modules{$_} } $class->process_plugin_specs( \@positive_plugin_specs );
29 | 
30 |     return @modules;
31 | }
32 | 
33 | method process_plugin_specs ($class: $plugin_specs) {
34 |     local $depth   = $depth + 1;
35 |     local %visited = %visited;
36 |     die ">$max_depth levels deep in process_plugins_list (plugin cycle?)" if $depth >= $max_depth;
37 |     croak 'plugins must be an array reference' unless ref($plugin_specs) eq 'ARRAY';
38 |     my @modules = ( uniq( map { $class->process_plugin_spec($_) } @$plugin_specs ) );
39 |     return @modules;
40 | }
41 | 
42 | method process_plugin_spec ($class: $plugin_spec) {
43 |     my $module = $class->plugin_spec_to_module($plugin_spec);
44 |     my @modules = !$visited{$module}++ ? $module->expand_to_plugins : ();
45 |     return @modules;
46 | }
47 | 
48 | method plugin_spec_to_module ($class: $plugin_spec) {
49 |     my $module =
50 |         substr( $plugin_spec, 0, 1 ) eq '+' ? ( substr( $plugin_spec, 1 ) )
51 |       : substr( $plugin_spec, 0, 1 ) eq '@'
52 |       ? ( "Mason::PluginBundle::" . substr( $plugin_spec, 1 ) )
53 |       : "Mason::Plugin::$plugin_spec";
54 |     return can_load($module)
55 |       ? $module
56 |       : die "could not load '$module' for plugin spec '$plugin_spec'";
57 | }
58 | 
59 | method apply_plugins_to_class ($class: $base_subclass, $name, $plugins) {
60 |     my $subclass;
61 |     my $key = join( ",", $base_subclass, @$plugins );
62 |     return $apply_plugins_cache{$key} if defined( $apply_plugins_cache{$key} );
63 | 
64 |     my $final_subclass;
65 |     my @roles = map { $_->get_roles_for_mason_class($name) } @$plugins;
66 |     if (@roles) {
67 |         my $meta = Moose::Meta::Class->create_anon_class(
68 |             superclasses => [$base_subclass],
69 |             roles        => \@roles,
70 |             cache        => 1
71 |         );
72 |         $final_subclass = $meta->name;
73 |         $meta->add_method( 'meta' => sub { $meta } )
74 |           if !$final_subclass_seen{$final_subclass}++;
75 |     }
76 |     else {
77 |         $final_subclass = $base_subclass;
78 |     }
79 |     $log->debugf( "apply_plugins - base_subclass=%s, name=%s, plugins=%s, roles=%s - %s",
80 |         $base_subclass, $name, $plugins, \@roles, $final_subclass )
81 |       if $log->is_debug;
82 | 
83 |     $final_subclass->meta->make_immutable if $final_subclass->can('meta');
84 | 
85 |     $apply_plugins_cache{$key} = $final_subclass;
86 |     return $final_subclass;
87 | }
88 | 
89 | __PACKAGE__->meta->make_immutable();
90 | 
91 | 1;
92 | 


--------------------------------------------------------------------------------
/lib/Mason/PluginRole.pm:
--------------------------------------------------------------------------------
 1 | package Mason::PluginRole;
 2 | 
 3 | use Moose::Role                ();
 4 | use Method::Signatures::Simple ();
 5 | use Moose::Exporter;
 6 | Moose::Exporter->setup_import_methods( also => ['Moose::Role'] );
 7 | 
 8 | sub init_meta {
 9 |     my $class     = shift;
10 |     my %params    = @_;
11 |     my $for_class = $params{for_class};
12 |     Method::Signatures::Simple->import( into => $for_class );
13 |     Moose::Role->init_meta(@_);
14 | }
15 | 
16 | 1;
17 | 
18 | __END__
19 | 
20 | =pod
21 | 
22 | =head1 NAME
23 | 
24 | Mason::PluginRole - Helper for defining Mason plugin roles
25 | 
26 | =head1 SYNOPSIS
27 | 
28 |     # instead of use Moose::Role;
29 |     use Mason::PluginRole;
30 | 
31 | =head1 DESCRIPTION
32 | 
33 | A variant on Moose::Role that can be used in Mason plugin roles. Using this
34 | module is equivalent to
35 | 
36 |     use Moose::Role;
37 |     use Method::Signatures::Simple;
38 | 


--------------------------------------------------------------------------------
/lib/Mason/Result.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Result;
 2 | 
 3 | use Mason::Moose;
 4 | 
 5 | # Public attributes
 6 | has 'data'   => ( default => sub { {} } );
 7 | has 'output' => ( is => 'rw', default => '' );
 8 | 
 9 | method _append_output ($text) {
10 |     $self->{output} .= $text;
11 | }
12 | 
13 | __PACKAGE__->meta->make_immutable();
14 | 
15 | 1;
16 | 
17 | __END__
18 | 
19 | =pod
20 | 
21 | =head1 NAME
22 | 
23 | Mason::Result - Result returned from Mason request
24 | 
25 | =head1 SYNOPSIS
26 | 
27 |     my $interp = Mason->new(...);
28 |     my $output = $result->output;
29 |     my $data   = $result->data;
30 | 
31 | =head1 DESCRIPTION
32 | 
33 | An object of this class is returned from C<< $interp->run >>. It contains the
34 | page output and any values set in C<< $m->result >>. Plugins may add additional
35 | accessors.
36 | 
37 | =head1 METHODS
38 | 
39 | =over
40 | 
41 | =item output
42 | 
43 | The output of the entire page, unless L
44 | was defined in which case this will be empty.
45 | 
46 | =item data
47 | 
48 | A hashref of arbitrary data that can be set via
49 | 
50 |     $m->result->data->{'key'} = 'value';
51 | 
52 | =back
53 | 
54 | =cut
55 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/Class.pm:
--------------------------------------------------------------------------------
  1 | package Mason::Test::Class;
  2 | 
  3 | use Carp;
  4 | use File::Basename;
  5 | use File::Path;
  6 | use File::Temp qw(tempdir);
  7 | use Mason;
  8 | use Mason::Util qw(trim write_file);
  9 | use Method::Signatures::Simple;
 10 | use Test::Class::Most;
 11 | use Test::LongString;
 12 | use Class::Load;
 13 | use strict;
 14 | use warnings;
 15 | 
 16 | __PACKAGE__->SKIP_CLASS("abstract base class");
 17 | 
 18 | # RO accessors
 19 | sub comp_root { $_[0]->{comp_root} }
 20 | sub data_dir  { $_[0]->{data_dir} }
 21 | sub interp    { $_[0]->{interp} }
 22 | sub temp_dir  { $_[0]->{temp_dir} }
 23 | sub temp_root { $_[0]->{temp_root} }
 24 | 
 25 | # RW class accessors
 26 | my $default_plugins = [];
 27 | sub default_plugins { $default_plugins = $_[1] if defined( $_[1] ); $default_plugins; }
 28 | 
 29 | my $gen_path_count = 0;
 30 | my $parse_count    = 0;
 31 | my $temp_dir_count = 0;
 32 | 
 33 | our $current_test_object;
 34 | 
 35 | sub _startup : Test(startup) {
 36 |     my $self    = shift;
 37 |     my $verbose = $ENV{TEST_VERBOSE};
 38 |     $self->{temp_root} = tempdir( 'mason-test-XXXX', TMPDIR => 1, CLEANUP => $verbose ? 0 : 1 );
 39 |     printf STDERR ( "\n*** temp_root = %s, no cleanup\n", $self->{temp_root} ) if $verbose;
 40 |     $self->setup_dirs;
 41 | }
 42 | 
 43 | method setup_dirs () {
 44 |     $self->{temp_dir}  = join( "/", $self->{temp_root}, $temp_dir_count++ );
 45 |     $self->{comp_root} = $self->{temp_dir} . "/comps";
 46 |     $self->{data_dir}  = $self->{temp_dir} . "/data";
 47 |     mkpath( [ $self->{comp_root}, $self->{data_dir} ], 0, 0775 );
 48 |     $self->setup_interp(@_);
 49 | }
 50 | 
 51 | method setup_interp () {
 52 |     $self->{interp} = $self->create_interp(@_);
 53 | }
 54 | 
 55 | method create_interp () {
 56 |     my (%params) = @_;
 57 |     $params{plugins} = $default_plugins if @$default_plugins;
 58 |     my $mason_root_class = delete( $params{mason_root_class} ) || 'Mason';
 59 |     Class::Load::load_class($mason_root_class);
 60 |     rmtree( $self->data_dir );
 61 |     return $mason_root_class->new(
 62 |         comp_root => $self->comp_root,
 63 |         data_dir  => $self->data_dir,
 64 |         %params,
 65 |     );
 66 | }
 67 | 
 68 | method add_comp (%params) {
 69 |     $self->_validate_keys( \%params, qw(path src v verbose) );
 70 |     my $path    = $params{path} || die "must pass path";
 71 |     my $source  = $params{src}  || " ";
 72 |     my $verbose = $params{v}    || $params{verbose};
 73 |     die "'$path' is not absolute" unless substr( $path, 0, 1 ) eq '/';
 74 |     my $source_file = $self->comp_root . $path;
 75 |     $self->mkpath_and_write_file( $source_file, $source );
 76 |     if ($verbose) {
 77 |         print STDERR "*** $path ***\n";
 78 |         my $output = $self->interp->_compile( $source_file, $path );
 79 |         print STDERR "$output\n";
 80 |     }
 81 | }
 82 | 
 83 | method remove_comp (%params) {
 84 |     my $path = $params{path} || die "must pass path";
 85 |     my $source_file = join( "/", $self->comp_root, $path );
 86 |     unlink($source_file);
 87 | }
 88 | 
 89 | method _gen_comp_path () {
 90 |     my $caller        = ( caller(2) )[3];
 91 |     my ($caller_base) = ( $caller =~ /([^:]+)$/ );
 92 |     my $path          = "/$caller_base" . ( ++$gen_path_count ) . ".mc";
 93 |     return $path;
 94 | }
 95 | 
 96 | method test_comp (%params) {
 97 |     my $path    = $params{path} || $self->_gen_comp_path;
 98 |     my $source  = $params{src}  || " ";
 99 |     my $verbose = $params{v}    || $params{verbose};
100 | 
101 |     $self->add_comp( path => $path, src => $source, verbose => $verbose );
102 |     delete( $params{src} );
103 | 
104 |     $self->test_existing_comp( %params, path => $path );
105 | }
106 | 
107 | method test_existing_comp (%params) {
108 |     $self->_validate_keys( \%params, qw(args desc expect expect_data expect_error path v verbose) );
109 |     my $path         = $params{path} or die "must pass path";
110 |     my $caller       = ( caller(1) )[3];
111 |     my $desc         = $params{desc} || $path;
112 |     my $expect       = trim( $params{expect} );
113 |     my $expect_error = $params{expect_error};
114 |     my $expect_data  = $params{expect_data};
115 |     my $verbose      = $params{v} || $params{verbose};
116 |     my $args         = $params{args} || {};
117 |     ( my $request_path = $path ) =~ s/\.m[cpi]$//;
118 | 
119 |     my @run_params = ( $request_path, %$args );
120 |     local $current_test_object = $self;
121 | 
122 |     if ( defined($expect_error) ) {
123 |         $desc ||= $expect_error;
124 |         throws_ok( sub { $self->interp->run(@run_params) }, $expect_error, $desc );
125 |     }
126 |     if ( defined($expect) ) {
127 |         $desc ||= $caller;
128 |         my $output = trim( $self->interp->run(@run_params)->output );
129 |         if ( ref($expect) eq 'Regexp' ) {
130 |             like( $output, $expect, $desc );
131 |         }
132 |         else {
133 |             is( $output, $expect, $desc );
134 |         }
135 |     }
136 |     if ( defined($expect_data) ) {
137 |         $desc ||= $caller;
138 |         cmp_deeply( $self->interp->run(@run_params)->data, $expect_data, $desc );
139 |     }
140 | }
141 | 
142 | method run_test_in_comp (%params) {
143 |     my $test = delete( $params{test} ) || die "must pass test";
144 |     my $args = delete( $params{args} ) || {};
145 |     $params{path} ||= $self->_gen_comp_path;
146 |     $self->add_comp( %params, src => '% $.args->{_test}->($self);' );
147 |     ( my $request_path = $params{path} ) =~ s/\.m[cpi]$//;
148 |     my @run_params = ( $request_path, %$args );
149 |     $self->interp->run( @run_params, _test => $test );
150 | }
151 | 
152 | method test_parse (%params) {
153 |     my $caller        = ( caller(1) )[3];
154 |     my ($caller_base) = ( $caller =~ /([^:]+)$/ );
155 |     my $desc          = $params{desc};
156 |     my $source        = $params{src} || croak "must pass src";
157 |     my $expect_list   = $params{expect};
158 |     my $expect_error  = $params{expect_error};
159 |     croak "must pass either expect or expect_error" unless $expect_list || $expect_error;
160 | 
161 |     my $path = "/parse/comp" . $parse_count++;
162 |     my $file = $self->temp_dir . $path;
163 |     $self->mkpath_and_write_file( $file, $source );
164 | 
165 |     if ($expect_error) {
166 |         $desc ||= $expect_error;
167 |         throws_ok( sub { $self->interp->_compile( $file, $path ) }, $expect_error, $desc );
168 |     }
169 |     else {
170 |         $desc ||= $caller;
171 |         my $output = $self->interp->_compile( $file, $path );
172 |         foreach my $expect (@$expect_list) {
173 |             if ( ref($expect) eq 'Regexp' ) {
174 |                 like_string( $output, $expect, "$desc - $expect" );
175 |             }
176 |             else {
177 |                 contains_string( $output, $expect, "$desc - $expect" );
178 |             }
179 |         }
180 |     }
181 | }
182 | 
183 | method mkpath_and_write_file ($source_file, $source) {
184 |     unlink($source_file) if -e $source_file;
185 |     mkpath( dirname($source_file), 0, 0775 );
186 |     write_file( $source_file, $source );
187 | }
188 | 
189 | method _validate_keys ($params, @allowed_keys) {
190 |     my %is_allowed = map { ( $_, 1 ) } @allowed_keys;
191 |     if ( my @bad_keys = grep { !$is_allowed{$_} } keys(%$params) ) {
192 |         croak "bad parameters: " . join( ", ", @bad_keys );
193 |     }
194 | }
195 | 
196 | 1;
197 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/Overrides/Component/StrictMoose.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Test::Overrides::Component::StrictMoose;
 2 | 
 3 | use Moose::Exporter;
 4 | use MooseX::StrictConstructor ();
 5 | use strict;
 6 | use warnings;
 7 | use base qw(Mason::Component::Moose);
 8 | use strict;
 9 | use warnings;
10 | 
11 | Moose::Exporter->setup_import_methods();
12 | 
13 | sub init_meta {
14 |     my $class  = shift;
15 |     my %params = @_;
16 |     $class->SUPER::init_meta(@_);
17 |     MooseX::StrictConstructor->import( { into => $params{for_class} } );
18 | }
19 | 
20 | 1;
21 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/Plugins/Notify.pm:
--------------------------------------------------------------------------------
1 | package Mason::Test::Plugins::Notify;
2 | 
3 | use strict;
4 | use warnings;
5 | use base qw(Mason::Plugin);
6 | 
7 | 1;
8 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/Plugins/Notify/Compilation.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Test::Plugins::Notify::Compilation;
 2 | 
 3 | use Mason::PluginRole;
 4 | 
 5 | before 'parse' => sub {
 6 |     my ($self) = @_;
 7 |     print STDERR "starting compilation parse - " . $self->path . "\n";
 8 | };
 9 | 
10 | 1;
11 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/Plugins/Notify/Component.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Test::Plugins::Notify::Component;
 2 | 
 3 | use Mason::PluginRole;
 4 | 
 5 | # This doesn't work - it interrupts the inner() chain. Investigate later.
 6 | #
 7 | #  before 'render' => sub {
 8 | #      my ($self) = @_;
 9 | #      print STDERR "starting component render - " . $self->cmeta->path . "\n";
10 | #  };
11 | 
12 | 1;
13 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/Plugins/Notify/Interp.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Test::Plugins::Notify::Interp;
 2 | 
 3 | use Mason::PluginRole;
 4 | 
 5 | before 'run' => sub {
 6 |     print STDERR "starting interp run\n";
 7 | };
 8 | 
 9 | 1;
10 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/Plugins/Notify/Request.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Test::Plugins::Notify::Request;
 2 | 
 3 | use Mason::PluginRole;
 4 | 
 5 | before 'run' => sub {
 6 |     my ( $self, $path ) = @_;
 7 |     print STDERR "starting request run - $path\n";
 8 | };
 9 | 
10 | before 'comp' => sub {
11 |     my ( $self, $path ) = @_;
12 |     print STDERR "starting request comp - $path\n";
13 | };
14 | 
15 | 1;
16 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/RootClass.pm:
--------------------------------------------------------------------------------
1 | package Mason::Test::RootClass;
2 | 
3 | use strict;
4 | use warnings;
5 | use base qw(Mason);
6 | 
7 | 1;
8 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/RootClass/Compilation.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Test::RootClass::Compilation;
 2 | 
 3 | use Moose;
 4 | extends 'Mason::Compilation';
 5 | 
 6 | before 'parse' => sub {
 7 |     my ($self) = @_;
 8 |     print STDERR "starting compilation parse - " . $self->path . "\n";
 9 | };
10 | 
11 | __PACKAGE__->meta->make_immutable();
12 | 
13 | 1;
14 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/RootClass/Component.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Test::RootClass::Component;
 2 | 
 3 | use Moose;
 4 | extends 'Mason::Component';
 5 | 
 6 | # This doesn't work - it interrupts the inner() chain. Investigate later.
 7 | #
 8 | #  before 'render' => sub {
 9 | #      my ($self) = @_;
10 | #      print STDERR "starting component render - " . $self->cmeta->path . "\n";
11 | #  };
12 | 
13 | __PACKAGE__->meta->make_immutable();
14 | 
15 | 1;
16 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/RootClass/Interp.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Test::RootClass::Interp;
 2 | 
 3 | use Moose;
 4 | extends 'Mason::Interp';
 5 | 
 6 | before 'run' => sub {
 7 |     print STDERR "starting interp run\n";
 8 | };
 9 | 
10 | __PACKAGE__->meta->make_immutable();
11 | 
12 | 1;
13 | 


--------------------------------------------------------------------------------
/lib/Mason/Test/RootClass/Request.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Test::RootClass::Request;
 2 | 
 3 | use Moose;
 4 | extends 'Mason::Request';
 5 | 
 6 | before 'run' => sub {
 7 |     my ( $self, $path ) = @_;
 8 |     print STDERR "starting request run - $path\n";
 9 | };
10 | 
11 | before 'comp' => sub {
12 |     my ( $self, $path ) = @_;
13 |     print STDERR "starting request comp - $path\n";
14 | };
15 | 
16 | __PACKAGE__->meta->make_immutable();
17 | 
18 | 1;
19 | 


--------------------------------------------------------------------------------
/lib/Mason/TieHandle.pm:
--------------------------------------------------------------------------------
 1 | package Mason::TieHandle;
 2 | 
 3 | use strict;
 4 | use warnings;
 5 | 
 6 | sub TIEHANDLE {
 7 |     my $class = shift;
 8 | 
 9 |     return bless {}, $class;
10 | }
11 | 
12 | sub PRINT {
13 |     my $self = shift;
14 | 
15 |     # TODO - why do we need to select STDOUT here?
16 |     my $old = select STDOUT;
17 |     $Mason::Request::current_request->print(@_);
18 |     select $old;
19 | }
20 | 
21 | sub PRINTF {
22 |     my $self = shift;
23 | 
24 |     # apparently sprintf(@_) won't work, it needs to be a scalar
25 |     # followed by a list
26 |     $self->PRINT( sprintf( shift, @_ ) );
27 | }
28 | 
29 | 1;
30 | 


--------------------------------------------------------------------------------
/lib/Mason/Types.pm:
--------------------------------------------------------------------------------
 1 | package Mason::Types;
 2 | 
 3 | use Moose::Util::TypeConstraints;
 4 | use strict;
 5 | use warnings;
 6 | 
 7 | subtype 'Mason::Types::CompRoot' => as 'ArrayRef[Str]';
 8 | coerce 'Mason::Types::CompRoot' => from 'Str' => via { [$_] };
 9 | 
10 | subtype 'Mason::Types::OutMethod' => as 'CodeRef';
11 | coerce 'Mason::Types::OutMethod' => from 'ScalarRef' => via {
12 |     my $ref = $_;
13 |     sub { $$ref .= $_[0] }
14 | };
15 | 
16 | subtype 'Mason::Types::RegexpRefOrStr' => as 'RegexpRef';
17 | coerce 'Mason::Types::RegexpRefOrStr' => from 'Str' => via { qr/$/ };
18 | 
19 | subtype 'Mason::Types::Autoextend' => as 'ArrayRef[Str]';
20 | coerce 'Mason::Types::Autoextend' => from 'Bool' => via { $_ ? [ '.mp', '.mc' ] : [] };
21 | 
22 | 1;
23 | 


--------------------------------------------------------------------------------
/lib/Mason/Util.pm:
--------------------------------------------------------------------------------
  1 | package Mason::Util;
  2 | 
  3 | use Carp;
  4 | use Class::Unload;
  5 | use Class::Load;
  6 | use Data::Dumper;
  7 | use Fcntl qw( :DEFAULT :seek );
  8 | use File::Find;
  9 | use File::Spec::Functions ();
 10 | use JSON;
 11 | use Try::Tiny;
 12 | use strict;
 13 | use warnings;
 14 | use base qw(Exporter);
 15 | 
 16 | our @EXPORT_OK =
 17 |   qw(can_load catdir catfile checksum combine_similar_paths dump_one_line find_wanted first_index is_absolute json_encode json_decode mason_canon_path read_file taint_is_on touch_file trim uniq write_file);
 18 | 
 19 | my $Fetch_Flags          = O_RDONLY | O_BINARY;
 20 | my $Store_Flags          = O_WRONLY | O_CREAT | O_BINARY;
 21 | my $File_Spec_Using_Unix = $File::Spec::ISA[0] eq 'File::Spec::Unix';
 22 | 
 23 | # Map null, true and false to real Perl values
 24 | if ( JSON->VERSION < 2 ) {
 25 |     $JSON::UnMapping = 1;
 26 | }
 27 | 
 28 | sub can_load {
 29 | 
 30 |     # Load $class_name if possible. Return 1 if successful, 0 if it could not be
 31 |     # found, and rethrow load error (other than not found).
 32 |     #
 33 |     my ($class_name) = @_;
 34 | 
 35 |     my $result;
 36 |     try {
 37 |         Class::Load::load_class($class_name);
 38 |         $result = 1;
 39 |     }
 40 |     catch {
 41 |         if ( /Can\'t locate .* in \@INC/ && !/Compilation failed/ ) {
 42 |             $result = 0;
 43 |         }
 44 |         else {
 45 |             die $_;
 46 |         }
 47 |     };
 48 |     return $result;
 49 | }
 50 | 
 51 | sub catdir {
 52 |     return $File_Spec_Using_Unix ? join( "/", @_ ) : File::Spec::Functions::catdir(@_);
 53 | }
 54 | 
 55 | sub catfile {
 56 |     return $File_Spec_Using_Unix ? join( "/", @_ ) : File::Spec::Functions::catfile(@_);
 57 | }
 58 | 
 59 | sub checksum {
 60 |     my ($str) = @_;
 61 | 
 62 |     # Adler32 algorithm
 63 |     my $s1 = 1;
 64 |     my $s2 = 1;
 65 |     for my $c ( unpack( "C*", $str ) ) {
 66 |         $s1 = ( $s1 + $c ) % 65521;
 67 |         $s2 = ( $s2 + $s1 ) % 65521;
 68 |     }
 69 |     return ( $s2 << 16 ) + $s1;
 70 | }
 71 | 
 72 | # Convert /foo/bar.m, /foo/bar.pm, /foo.m, /foo.pm to
 73 | # /foo/bar.{m,pm}, /foo.{m,pm}. I have no idea why this takes
 74 | # so much code.
 75 | #
 76 | sub combine_similar_paths {
 77 |     my @paths = @_;
 78 |     my ( @final, $current_base, @current_exts );
 79 |     foreach my $path (@paths) {
 80 |         if ( my ( $base, $ext ) = ( $path =~ /^(.*)\.(.*)$/ ) ) {
 81 |             if ( defined($current_base) && $current_base ne $base ) {
 82 |                 push(
 83 |                     @final,
 84 |                     "$current_base."
 85 |                       . (
 86 |                         ( @current_exts == 1 )
 87 |                         ? $current_exts[0]
 88 |                         : sprintf( '{%s}', join( ',', @current_exts ) )
 89 |                       )
 90 |                 );
 91 |                 @current_exts = ($ext);
 92 |             }
 93 |             else {
 94 |                 push( @current_exts, $ext );
 95 |             }
 96 |             $current_base = $base;
 97 |         }
 98 |         else {
 99 |             push( @final, $path );
100 |         }
101 |     }
102 |     if ( defined($current_base) ) {
103 |         push(
104 |             @final,
105 |             "$current_base."
106 |               . (
107 |                 ( @current_exts == 1 )
108 |                 ? $current_exts[0]
109 |                 : sprintf( '{%s}', join( ',', @current_exts ) )
110 |               )
111 |         );
112 |     }
113 |     return @final;
114 | }
115 | 
116 | sub delete_package {
117 |     my $pkg = shift;
118 |     Class::Unload->unload($pkg);
119 | }
120 | 
121 | sub dump_one_line {
122 |     my ($value) = @_;
123 | 
124 |     return Data::Dumper->new( [$value] )->Indent(0)->Sortkeys(1)->Quotekeys(0)->Terse(1)->Dump();
125 | }
126 | 
127 | # From File::Find::Wanted
128 | sub find_wanted {
129 |     my $func = shift;
130 |     my @files;
131 | 
132 |     local $_;
133 |     find( sub { push @files, $File::Find::name if &$func }, @_ );
134 | 
135 |     return @files;
136 | }
137 | 
138 | # From List::MoreUtils
139 | sub first_index (&@) {
140 |     my $f = shift;
141 |     for my $i ( 0 .. $#_ ) {
142 |         local *_ = \$_[$i];
143 |         return $i if $f->();
144 |     }
145 |     return -1;
146 | }
147 | 
148 | sub is_absolute {
149 |     my ($path) = @_;
150 | 
151 |     return substr( $path, 0, 1 ) eq '/';
152 | }
153 | 
154 | # Maintain compatibility with both JSON 1 and 2. Borrowed from Data::Serializer::JSON.
155 | #
156 | sub json_decode {
157 |     my ($text) = @_;
158 |     return JSON->VERSION < 2 ? JSON->new->jsonToObj($text) : JSON->new->decode($text);
159 | }
160 | 
161 | sub json_encode {
162 |     my ($data) = @_;
163 |     return JSON->VERSION < 2 ? JSON->new->objToJson($data) : JSON->new->utf8->encode($data);
164 | }
165 | 
166 | sub mason_canon_path {
167 | 
168 |     # Like File::Spec::canonpath but with a few fixes.
169 |     #
170 |     my $path = shift;
171 |     $path =~ s|/+|/|g;           # xx////yy  -> xx/yy
172 |     $path =~ s|(?:/\.)+/|/|g;    # xx/././yy -> xx/yy
173 |     {
174 |         $path =~ s|^(?:\./)+||s unless $path eq "./";    # ./xx      -> xx
175 |         $path =~ s|^/(?:\.\./)+|/|s;                     # /../../xx -> xx
176 |         $path =~ s|/\Z(?!\n)|| unless $path eq "/";      # xx/       -> xx
177 |         $path =~ s|/[^/]+/\.\.$|| && redo;               # /xx/..    -> /
178 |         $path =~ s|[^/]+/\.\./||  && redo;               # /xx/../yy -> /yy
179 |     }
180 |     return $path;
181 | }
182 | 
183 | sub read_file {
184 |     my ($file) = @_;
185 | 
186 |     # Fast slurp, adapted from File::Slurp::read, with unnecessary options removed
187 |     #
188 |     my $buf = "";
189 |     my $read_fh;
190 |     unless ( sysopen( $read_fh, $file, $Fetch_Flags ) ) {
191 |         croak "read_file '$file' - sysopen: $!";
192 |     }
193 |     my $size_left = -s $read_fh;
194 |     while (1) {
195 |         my $read_cnt = sysread( $read_fh, $buf, $size_left, length $buf );
196 |         if ( defined $read_cnt ) {
197 |             last if $read_cnt == 0;
198 |             $size_left -= $read_cnt;
199 |             last if $size_left <= 0;
200 |         }
201 |         else {
202 |             croak "read_file '$file' - sysread: $!";
203 |         }
204 |     }
205 |     return $buf;
206 | }
207 | 
208 | sub taint_is_on {
209 |     return ${^TAINT} ? 1 : 0;
210 | }
211 | 
212 | sub touch_file {
213 |     my ($file) = @_;
214 |     if ( -f $file ) {
215 |         my $time = time;
216 |         utime( $time, $time, $file );
217 |     }
218 |     else {
219 |         write_file( $file, "" );
220 |     }
221 | }
222 | 
223 | sub trim {
224 |     my ($str) = @_;
225 |     if ( defined($str) ) {
226 |         for ($str) { s/^\s+//; s/\s+$// }
227 |     }
228 |     return $str;
229 | }
230 | 
231 | # From List::MoreUtils
232 | sub uniq (@) {
233 |     my %h;
234 |     map { $h{$_}++ == 0 ? $_ : () } @_;
235 | }
236 | 
237 | sub write_file {
238 |     my ( $file, $data, $file_create_mode ) = @_;
239 | 
240 |     ($file) = $file =~ /^(.*)/s if taint_is_on();    # Untaint blindly
241 |     $file_create_mode = oct(666) if !defined($file_create_mode);
242 | 
243 |     # Fast spew, adapted from File::Slurp::write, with unnecessary options removed
244 |     #
245 |     {
246 |         my $write_fh;
247 |         unless ( sysopen( $write_fh, $file, $Store_Flags, $file_create_mode ) ) {
248 |             croak "write_file '$file' - sysopen: $!";
249 |         }
250 |         my $size_left = length($data);
251 |         my $offset    = 0;
252 |         do {
253 |             my $write_cnt = syswrite( $write_fh, $data, $size_left, $offset );
254 |             unless ( defined $write_cnt ) {
255 |                 croak "write_file '$file' - syswrite: $!";
256 |             }
257 |             $size_left -= $write_cnt;
258 |             $offset += $write_cnt;
259 |         } while ( $size_left > 0 );
260 |         truncate( $write_fh, sysseek( $write_fh, 0, SEEK_CUR ) )
261 |     }
262 | }
263 | 
264 | 1;
265 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Autobase.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::Autobase;
  2 | 
  3 | use Test::Class::Most parent => 'Mason::Test::Class';
  4 | 
  5 | sub test_autobase : Tests {
  6 |     my $self   = shift;
  7 |     my $interp = $self->interp;
  8 | 
  9 |     my $check_parent = sub {
 10 |         my ( $path, $parent ) = @_;
 11 | 
 12 |         my $base_comp_class = $interp->load($path)
 13 |           or die "could not load '$path'";
 14 |         my $parent_comp_class = ( $parent =~ /\// ) ? $interp->load($parent) : $parent;
 15 |         cmp_deeply( [ $base_comp_class->meta->superclasses ],
 16 |             [$parent_comp_class], "parent of $path is $parent" );
 17 |     };
 18 | 
 19 |     my $add = sub {
 20 |         my ( $path, $extends ) = @_;
 21 | 
 22 |         $self->add_comp(
 23 |             path => $path,
 24 |             src  => ( $extends ? "<%flags>\nextends => $extends\n" : " " )
 25 |         );
 26 |     };
 27 | 
 28 |     my $remove = sub {
 29 |         my ($path) = @_;
 30 | 
 31 |         $self->remove_comp( path => $path, );
 32 |     };
 33 | 
 34 |     # Add components with no autobases, make sure they inherit from
 35 |     # Mason::Component
 36 |     #
 37 |     $add->('/comp.mc');
 38 |     $add->('/foo/comp.mc');
 39 |     $add->('/foo/bar/comp.mc');
 40 |     $add->('/foo/bar/baz/comp.mc');
 41 | 
 42 |     my $base_class = $self->interp->component_class;
 43 | 
 44 |     $check_parent->( '/comp.mc',             $base_class );
 45 |     $check_parent->( '/foo/comp.mc',         $base_class );
 46 |     $check_parent->( '/foo/bar/comp.mc',     $base_class );
 47 |     $check_parent->( '/foo/bar/baz/comp.mc', $base_class );
 48 | 
 49 |     # Add autobases, test the parents of the components and autobases
 50 |     #
 51 |     $add->('/Base.mc');
 52 |     $add->('/foo/Base.mc');
 53 |     $add->('/foo/bar/baz/Base.mc');
 54 |     $self->interp->_flush_load_cache();
 55 | 
 56 |     $check_parent->( '/Base.mc',             $base_class );
 57 |     $check_parent->( '/foo/Base.mc',         '/Base.mc' );
 58 |     $check_parent->( '/foo/bar/baz/Base.mc', '/foo/Base.mc' );
 59 |     $check_parent->( '/comp.mc',             '/Base.mc' );
 60 | 
 61 |     $check_parent->( '/foo/comp.mc',         '/foo/Base.mc' );
 62 |     $check_parent->( '/foo/bar/comp.mc',     '/foo/Base.mc' );
 63 |     $check_parent->( '/foo/bar/baz/comp.mc', '/foo/bar/baz/Base.mc' );
 64 | 
 65 |     $add->( '/foo/bar/baz/none.mc', "undef" );
 66 |     $check_parent->( '/foo/bar/baz/none.mc', $base_class );
 67 | 
 68 |     $add->( '/foo/bar/baz/top.mc', "'/Base.mc'" );
 69 |     $check_parent->( '/foo/bar/baz/top.mc', '/Base.mc' );
 70 | 
 71 |     $add->( '/foo/bar/baz/top2.mc', "'../../Base.mc'" );
 72 |     $check_parent->( '/foo/bar/baz/top2.mc', '/foo/Base.mc' );
 73 | 
 74 |     # Multiple autobases same directory
 75 |     $add->('/Base.mp');
 76 |     $add->('/foo/Base.mp');
 77 |     $self->interp->_flush_load_cache();
 78 |     $check_parent->( '/Base.mp',     $base_class );
 79 |     $check_parent->( '/Base.mc',     '/Base.mp' );
 80 |     $check_parent->( '/foo/Base.mp', '/Base.mc' );
 81 |     $check_parent->( '/foo/Base.mc', '/foo/Base.mp' );
 82 |     $check_parent->( '/foo/comp.mc', '/foo/Base.mc' );
 83 | 
 84 |     # Remove most autobases, test parents again
 85 |     #
 86 |     $remove->('/Base.mp');
 87 |     $remove->('/Base.mc');
 88 |     $remove->('/foo/Base.mp');
 89 |     $remove->('/foo/Base.mc');
 90 |     $self->interp->_flush_load_cache();
 91 | 
 92 |     $check_parent->( '/comp.mc',             $base_class );
 93 |     $check_parent->( '/foo/comp.mc',         $base_class );
 94 |     $check_parent->( '/foo/bar/comp.mc',     $base_class );
 95 |     $check_parent->( '/foo/bar/baz/comp.mc', '/foo/bar/baz/Base.mc' );
 96 |     $check_parent->( '/foo/bar/baz/Base.mc', $base_class );
 97 | }
 98 | 
 99 | sub test_cycles : Tests {
100 |     my $self = shift;
101 | 
102 |     # An inheritance cycle
103 |     #
104 |     $self->add_comp(
105 |         path => '/cycle/Base.mc',
106 |         src  => "<%flags>\nextends => '/cycle/c/index.mc'\n\n",
107 |     );
108 |     $self->test_comp(
109 |         path         => '/cycle/c/index.mc',
110 |         src          => "ok",
111 |         expect_error => qr/inheritance cycle/,
112 |     );
113 | 
114 |     # This isn't a cycle but a bug that tried to preload default parent was causing
115 |     # it to infinite loop
116 |     #
117 |     $self->add_comp(
118 |         path => '/pseudo/Base.mc',
119 |         src  => "<%flags>\nextends => '/pseudo/c/index.mc'\n\n",
120 |     );
121 |     $self->test_comp(
122 |         path   => '/pseudo/c/index.mc',
123 |         src    => "<%flags>\nextends => undef\n\nok",
124 |         expect => 'ok',
125 |     );
126 | }
127 | 
128 | sub test_wrapping : Tests {
129 |     my $self = shift;
130 | 
131 |     $self->add_comp(
132 |         path => '/wrap/Base.mc',
133 |         src  => '
134 | <%augment wrap>
135 | 
136 | % inner();
137 | 
138 | 
139 | '
140 |     );
141 |     $self->add_comp(
142 |         path => '/wrap/subdir/Base.mc',
143 |         src  => '
144 | 
145 | <%method hello>
146 | Hello world
147 | 
148 | 
149 | '
150 |     );
151 |     $self->add_comp(
152 |         path => '/wrap/subdir/subdir2/Base.mc',
153 |         src  => '
154 | <%augment wrap>
155 | 
156 | % inner();
157 | 
158 | 
159 | '
160 |     );
161 |     $self->test_comp(
162 |         path   => '/wrap/subdir/subdir2/wrap_me.mc',
163 |         src    => '<% $self->hello %>',
164 |         expect => '
165 | 
166 | 
167 | 
168 | 
169 | Hello world
170 | 
171 | 
172 | '
173 |     );
174 |     $self->test_comp(
175 |         path => '/wrap/subdir/subdir2/dont_wrap_me.mc',
176 |         src  => '
177 | <%class>method wrap { $.main() }
178 | <% $self->hello() %>
179 | ',
180 |         expect => 'Hello world'
181 |     );
182 |     $self->test_comp(
183 |         path => '/wrap/subdir/subdir2/dont_wrap_me_either.mc',
184 |         src  => '
185 | <%class>CLASS->no_wrap;
186 | <% $self->hello() %>
187 | ',
188 |         expect => 'Hello world'
189 |     );
190 | }
191 | 
192 | # not yet implemented
193 | sub _test_no_main_in_autobase {
194 |     my $self = shift;
195 | 
196 |     $self->test_comp(
197 |         path => '/wrap/Base.mc',
198 |         src  => '
199 | 
200 | % inner();
201 | 
202 | ',
203 |         expect_error => qr/content found in main body of autobase/,
204 |     );
205 | }
206 | 
207 | sub test_recompute_inherit : Tests {
208 |     my $self   = shift;
209 |     my $interp = $self->interp;
210 | 
211 |     # Test that /comp.mc class can be recomputed without garbage collection issues.
212 |     #
213 |     my $remove = sub {
214 |         my ($path) = @_;
215 | 
216 |         $self->remove_comp( path => $path, );
217 |     };
218 | 
219 |     $self->add_comp( path => '/comp.mc', src => ' ' );
220 |     $self->interp->load('/comp.mc');
221 |     $self->add_comp( path => '/Base.mc', src => ' ' );
222 |     $self->interp->_flush_load_cache();
223 |     $self->interp->load('/comp.mc');
224 |     ok(1);
225 | 
226 |     return;
227 | }
228 | 
229 | 1;
230 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Cache.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::Cache;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | __PACKAGE__->default_plugins( [ '@Default', 'Cache' ] );
 6 | 
 7 | sub test_cache_defaults : Tests {
 8 |     my $self = shift;
 9 |     $self->run_test_in_comp(
10 |         path => '/cache/defaults.mc',
11 |         test => sub {
12 |             my $comp = shift;
13 |             is( $comp->cache->label,     'File',             'cache->label' );
14 |             is( $comp->cache->namespace, $comp->cmeta->path, 'cache->namespace' );
15 |         }
16 |     );
17 | }
18 | 
19 | sub test_cache_method : Tests {
20 |     my $self = shift;
21 |     $self->test_comp(
22 |         path => '/cache.mc',
23 |         src  => '
24 | <%class>
25 | has "count" => ( default => 0 );
26 | 
27 | 
28 | 
29 | <%method getset ($key)>
30 | <%perl>$.count($.count+1);
31 | <% $.cache->compute($key, sub { $key . $.count }) %>
32 | 
33 | 
34 | namespace: <% $.cache->namespace %>
35 | <% $.getset("foo") %>
36 | <% $.getset("bar") %>
37 | <% $.getset("bar") %>
38 | <% $.getset("foo") %>
39 | ',
40 |         expect => '
41 | namespace: /cache.mc
42 | foo1
43 | 
44 | bar2
45 | 
46 | bar2
47 | 
48 | foo1
49 | ',
50 |     );
51 | }
52 | 
53 | sub test_cache_filter : Tests {
54 |     my $self = shift;
55 | 
56 |     $self->test_comp(
57 |         src => '
58 | % my $i = 1;
59 | % foreach my $key (qw(foo bar)) {
60 | % $.Repeat(3), $.Cache($key) {{
61 | i = <% $i++ %>
62 | % }}
63 | % }
64 | ',
65 |         expect => '
66 | i = 1
67 | i = 1
68 | i = 1
69 | i = 2
70 | i = 2
71 | i = 2
72 | ',
73 |     );
74 | 
75 |     $self->test_comp(
76 |         src => '
77 | % my $i = 1;
78 | % foreach my $key (qw(foo foo)) {
79 | % $.Cache($key), $.Repeat(3) {{
80 | i = <% $i++ %>
81 | % }}
82 | % }
83 | ',
84 |         expect => '
85 | i = 1
86 | i = 2
87 | i = 3
88 | i = 1
89 | i = 2
90 | i = 3
91 | '
92 |     );
93 | }
94 | 


--------------------------------------------------------------------------------
/lib/Mason/t/CompCalls.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::CompCalls;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | sub test_ampersand : Tests {
 6 |     my $self = shift;
 7 | 
 8 |     $self->add_comp(
 9 |         path => '/support/amper_test.mi',
10 |         src  => <<'EOF',
11 | amper_test.
    
12 | % if (%{$self->args}) {
13 | Arguments:
    
14 | %   foreach my $key (sort keys %{$self->args}) {
15 | <% $key %>: <% $self->args->{$key} %>
    
16 | %   }
17 | % }
18 | EOF
19 |     );
20 | 
21 |     $self->test_comp(
22 |         path => '/support/amper_call.mc',
23 |         src  => <<'EOF',
24 | <&/support/amper_test.mi&>
25 | <& amper_test.mi &>
26 | <&  amper_test.mi, &>
27 | <& /support/amper_test.mi
28 | &>
29 | <&
30 | amper_test.mi &>
31 | <&
32 | /support/amper_test.mi
33 | &>
34 | EOF
35 |         expect => <<'EOF',
36 | amper_test.
    
37 | 
38 | amper_test.
    
39 | 
40 | amper_test.
    
41 | 
42 | amper_test.
    
43 | 
44 | amper_test.
    
45 | 
46 | amper_test.
    
47 | 
48 | EOF
49 |     );
50 |     $self->test_comp(
51 |         src => <<'EOF',
52 | <& /support/amper_test.mi, message=>'Hello World!'  &>
53 | <& support/amper_test.mi, message=>'Hello World!',
54 |    to=>'Joe' &>
55 | <& "support/amper_test.mi" &>
56 | % my $dir = "support";
57 | % my %args = (a=>17, b=>32);
58 | <& $dir . "/amper_test.mi", %args &>
59 | EOF
60 |         expect => <<'EOF',
61 | amper_test.
    
62 | Arguments:
    
63 | message: Hello World!
    
64 | 
65 | amper_test.
    
66 | Arguments:
    
67 | message: Hello World!
    
68 | to: Joe
    
69 | 
70 | amper_test.
    
71 | 
72 | amper_test.
    
73 | Arguments:
    
74 | a: 17
    
75 | b: 32
    
76 | 
77 | EOF
78 |     );
79 | }
80 | 
81 | 1;
82 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Compilation.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::Compilation;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | sub test_pure_perl : Tests {
 6 |     my $self = shift;
 7 | 
 8 |     my $std =
 9 |       sub { my $num = shift; sprintf( 'method main () { my $foo = %s; print $foo; }', $num ) };
10 | 
11 |     $self->add_comp( path => '/print1.pl', src => $std->(53) );
12 |     $self->test_comp(
13 |         path   => '/top1.mp',
14 |         src    => 'method main () { $m->comp("/print1.pl") }',
15 |         expect => $std->(53),
16 |     );
17 | 
18 |     $self->setup_interp( pure_perl_extensions => ['.pl'] );
19 |     $self->add_comp( path => '/print2.pl', src => $std->(54) );
20 |     $self->test_comp( path => '/top2.mp', src => '<& print2.pl &>', expect => '54' );
21 | 
22 |     $self->setup_interp( pure_perl_extensions => [] );
23 |     $self->add_comp( path => '/print3.pl', src => $std->(55) );
24 |     $self->test_comp(
25 |         path   => '/top3.mp',
26 |         src    => '<& print3.pl &>',
27 |         expect => $std->(55),
28 |     );
29 | }
30 | 
31 | 1;
32 | 


--------------------------------------------------------------------------------
/lib/Mason/t/ComponentMeta.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::ComponentMeta;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | sub test_cmeta : Tests {
 6 |     my $self = shift;
 7 |     $self->run_test_in_comp(
 8 |         path => '/component/meta.mc',
 9 |         args => { foo => 5, bar => [ 'baz', 7 ] },
10 |         test => sub {
11 |             my $comp        = shift;
12 |             my $source_file = $self->comp_root . '/component/meta.mc';
13 |             foreach my $cmeta ( $comp->cmeta, ref($comp)->cmeta ) {
14 |                 is( $cmeta->path,         '/component/meta.mc', 'path' );
15 |                 is( $cmeta->dir_path,     '/component',         'dir_path' );
16 |                 is( $cmeta->is_top_level, 1,                    'is_top_level' );
17 |                 is( $cmeta->source_file,  $source_file,         'source_file' );
18 |                 like( $cmeta->object_file, qr|meta\.mc\.mobj|, 'object_file' );
19 |             }
20 |             my $args = $comp->args;
21 |             delete( $args->{_test} );
22 |             cmp_deeply( $args, { foo => 5, bar => [ 'baz', 7 ] } );
23 |         },
24 |     );
25 | }
26 | 
27 | 1;
28 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Defer.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::Defer;
 2 | 
 3 | use Test::More;
 4 | use strict;
 5 | use warnings;
 6 | use base qw(Mason::Test::Class);
 7 | 
 8 | sub test_defer : Test(1) {
 9 |     my $self = shift;
10 |     $self->{interp} = $self->create_interp( plugins => [ '@Default', 'Defer' ] );
11 |     $self->test_comp(
12 |         src => <<'EOF',
13 | <%class>
14 | my ($title, $subtitle);
15 | 
16 | 
17 | Title is <% $m->defer(sub { $title }) %>
18 | 
19 | % $.Defer {{
20 | Subtitle is <% $subtitle %>
21 | % }}
22 | 
23 | <%perl>
24 | $title = 'foo';
25 | $subtitle = 'bar';
26 | 
27 | EOF
28 |         expect => <<'EOF',
29 | Title is foo
30 | 
31 | Subtitle is bar
32 | EOF
33 |     );
34 | }
35 | 
36 | 1;
37 | 


--------------------------------------------------------------------------------
/lib/Mason/t/DollarDot.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::DollarDot;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | sub test_dollardot : Tests {
 6 |     my $self = shift;
 7 |     $self->add_comp(
 8 |         path => '/helper.mi',
 9 |         src  => '<%class>has "foo";
10 | Helper: <% $.foo %>
11 | ',
12 |     );
13 |     $self->test_comp(
14 |         src => '
15 | <%class>
16 | has "name" => ( default => "Joe" );
17 | 
18 | 
19 | 
20 | <%class>
21 | has "compname";
22 | has "date";
23 | 
24 | 
25 | <%method greet>
26 | Hello, <% $.name %>. Today is <% $.date %>.
27 | 
28 | 
29 | % $.greet();
30 | 
31 | <& $.compname, foo => $.date &>
32 | <& /helper.mi, foo => $.name &>
33 | 
34 | <%init>
35 | $.date("March 5th");
36 | $.compname("helper.mi");
37 | 
38 | ',
39 |         expect => '
40 | Hello, Joe. Today is March 5th.
41 | 
42 | Helper: March 5th
43 | 
44 | Helper: Joe
45 | ',
46 |     );
47 | }
48 | 
49 | 1;
50 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Errors.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::Errors;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | sub test_comp_errors : Tests {
 6 |     my $self = shift;
 7 |     my $try  = sub {
 8 |         my ( $src, $expect_error, %extra ) = @_;
 9 |         $self->test_comp(
10 |             src          => $src,
11 |             expect_error => $expect_error,
12 |             desc         => $expect_error,
13 |             %extra
14 |         );
15 |     };
16 |     my $root = $self->interp->comp_root->[0];
17 | 
18 |     $try->(
19 |         '<& /does/not/exist &>',
20 |         qr/could not find component for path '\/does\/not\/exist' - component root is \Q[$root]\E/,
21 |     );
22 |     $try->( '<%method>',                   qr/<%method> block requires a name/ );
23 |     $try->( '<%before>',                   qr/<%before> block requires a name/ );
24 |     $try->( '<%init>',                     qr/<%init> without matching <\/%init>/ );
25 |     $try->( '<%attr>',                     qr/unknown block '<%attr>'/ );
26 |     $try->( '<%blah>',                     qr/unknown block '<%blah>'/ );
27 |     $try->( '<%init foo>',                 qr/<%init> block does not take a name/ );
28 |     $try->( '<%',                          qr/'<%' without matching '%>'/ );
29 |     $try->( 'foo %>',                      qr/'%>' without matching '<%'/ );
30 |     $try->( '<& foo',                      qr/'<&' without matching '&>'/ );
31 |     $try->( 'foo &>',                      qr/'&>' without matching '<&'/ );
32 |     $try->( '%my $i = 1;',                 qr/% must be followed by whitespace/ );
33 |     $try->( "<%5\n\n%>",                   qr/whitespace required after '<%' at .* line 1/ );
34 |     $try->( "<%\n\n5%>",                   qr/whitespace required before '%>' at .* line 3/ );
35 |     $try->( "<%%>",                        qr/found empty '<% %>' tag/ );
36 |     $try->( "<% %>",                       qr/found empty '<% %>' tag/ );
37 |     $try->( "<%   %>",                     qr/found empty '<% %>' tag/ );
38 |     $try->( "% \$.Upper {{\nHi",           qr/'\{\{' without matching '}}'/ );
39 |     $try->( "Hi\n% }}",                    qr/'}}' without matching '\{\{'/ );
40 |     $try->( '<%method 1a>Hi',    qr/Invalid method name '1a'/ );
41 |     $try->( '<%method cmeta>Hi', qr/'cmeta' is reserved.*method name/ );
42 |     $try->(
43 |         "<%method a>Hi\n<%method a>Bye",
44 |         qr/Duplicate definition of method 'a'/
45 |     );
46 |     $try->( "<%before 1a>Hi", qr/Invalid method modifier name '1a'/ );
47 |     $try->(
48 |         "<%before a>Hi\n<%before a>Bye",
49 |         qr/Duplicate definition of method modifier 'before a'/
50 |     );
51 |     $try->(
52 |         '<%method b><%after main>Hi',
53 |         qr/Cannot nest <%after> block inside <%method> block/
54 |     );
55 |     $try->( "% 'foobar' {{\nHi\n% }}\n",     qr/'foobar' is neither a code ref/ );
56 |     $try->( "<%flags>\nfoo => 1\n", qr/Invalid flag 'foo'/ );
57 |     $try->( "<%flags>\nextends => 'blah'\n",
58 |         qr/could not load '\/blah' for extends flag/ );
59 |     $try->( "<%flags>\nextends => %foo\n", qr/Global symbol/ );
60 |     $try->( '<% $foo %>', qr/Global symbol "\$foo" requires explicit package name/ );
61 |     $try->( 'die "blargh";', qr/blargh/, path => '/blargh.mp' );
62 | 
63 |     # Error line numbers
64 |     #
65 |     $try->( "%\nb\n% die;",                               qr/Died at .* line 3/ );
66 |     $try->( "<%method foo>\n1\n2\n3\n\n% die;", qr/Died at .* line 6/ );
67 | }
68 | 
69 | sub test_bad_allow_globals : Tests {
70 |     my $self = shift;
71 |     throws_ok { $self->create_interp( allow_globals => ['@p'] ) } qr/only scalar globals supported/;
72 |     throws_ok { $self->create_interp( allow_globals => ['i-'] ) } qr/not a valid/;
73 | }
74 | 
75 | sub test_non_comp_errors : Tests {
76 |     my $self = shift;
77 |     throws_ok { $self->interp->_make_request()->current_comp_class }
78 |     qr/cannot determine current_comp_class/;
79 |     throws_ok { Mason->new() } qr/Attribute \(comp_root\) is required/;
80 | }
81 | 
82 | 1;
83 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Filters.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::Filters;
  2 | 
  3 | use Test::Warn;
  4 | use Test::Class::Most parent => 'Mason::Test::Class';
  5 | 
  6 | sub test_basic : Tests {
  7 |     my $self = shift;
  8 |     $self->test_comp(
  9 |         src => '
 10 | % sub { ucfirst(shift) } {{
 11 | <% "hello world?" %>
 12 | % }}
 13 | ',
 14 |         expect => '
 15 | Hello world?
 16 | ',
 17 |     );
 18 | }
 19 | 
 20 | sub test_filters : Tests {
 21 |     my $self = shift;
 22 |     $self->test_comp(
 23 |         src => '
 24 | <%class>
 25 | method Upper () { sub { uc(shift) } }
 26 | 
 27 | 
 28 | % $.Upper {{   # start Upper
 29 | Hello World.
 30 | % }}           # end Upper
 31 | 
 32 | % sub { ucfirst(shift) } {{   
 33 | <% "hello world?" %>
 34 | % }}   
 35 | 
 36 | % sub { tr/A-Z/a-z/; $_ } {{
 37 | Hello World!
 38 | % }}
 39 | ',
 40 |         expect => '
 41 | HELLO WORLD.
 42 | Hello world?
 43 | hello world!
 44 | ',
 45 |     );
 46 | }
 47 | 
 48 | sub test_filter_pipe : Tests {
 49 |     my $self = shift;
 50 |     $self->test_comp(
 51 |         src => '
 52 | <%class>
 53 | method Upper () { sub { uc(shift) } }
 54 | method Lower () { sub { lc(shift) } }
 55 | method UpFirst () { sub { ucfirst(shift) } }
 56 | 
 57 | 
 58 | <% "HELLO" | Lower %>
 59 | <% "hello" | UpFirst %>
 60 | <% "HELLO" | UpFirst,Lower %>
 61 | <% "hello" | Lower,   UpFirst %>
 62 | <% "HeLlO" | Lower, Upper %>
 63 | <% "HeLlO" | Upper, Lower %>
 64 | ',
 65 |         expect => '
 66 | hello
 67 | Hello
 68 | Hello
 69 | hello
 70 | hello
 71 | HELLO
 72 | ',
 73 |     );
 74 | }
 75 | 
 76 | sub test_filter_block : Tests {
 77 |     my $self = shift;
 78 |     $self->test_comp(
 79 |         src => '
 80 | <%filter MyRepeat ($count)>
 81 | % for (my $i=0; $i<$count; $i++) {
 82 | * <% $yield->() %>\
 83 | % }
 84 | 
 85 | 
 86 | % my $count = 0;
 87 | % $.MyRepeat(3) {{
 88 | count = <% ++$count %>
 89 | % }}
 90 | 
 91 | <%perl>
 92 | my $content = $m->filter($.MyRepeat(2), sub { "count == " . ++$count . "\n" });
 93 | print(uc($content));
 94 | 
 95 | ',
 96 |         expect => '
 97 | * count = 1
 98 | * count = 2
 99 | * count = 3
100 | * COUNT == 4
101 | * COUNT == 5
102 | ',
103 |     );
104 | }
105 | 
106 | sub test_lexical : Tests {
107 |     my $self = shift;
108 |     $self->test_comp(
109 |         src => <<'EOF',
110 | % my $msg = "Hello World";
111 | % sub { lc(shift) } {{
112 | <% $msg %>
113 | % }}
114 | EOF
115 |         expect => 'hello world',
116 |     );
117 | }
118 | 
119 | sub test_repeat : Tests {
120 |     my $self = shift;
121 |     $self->test_comp(
122 |         src => <<'EOF',
123 | % my $i = 1;
124 | % $.Repeat(3) {{
125 | i = <% $i++ %>
126 | % }}
127 | EOF
128 |         expect => <<'EOF',
129 | i = 1
130 | i = 2
131 | i = 3
132 | EOF
133 |     );
134 | }
135 | 
136 | sub test_nested : Tests {
137 |     my $self = shift;
138 |     $self->test_comp(
139 |         src => <<'EOF',
140 | % sub { ucfirst(shift) } {{
141 | %   sub { tr/e/a/; $_ } {{
142 | %     sub { lc(shift) } {{
143 | HELLO
144 | %     }}
145 | %   }}
146 | % }}
147 | goodbye
148 | 
149 | % sub { ucfirst(shift) }, sub { tr/e/a/; $_ }, sub { lc(shift) } {{
150 | HELLO
151 | % }}
152 | goodbye
153 | EOF
154 |         expect => <<'EOF',
155 | Hallo
156 | goodbye
157 | 
158 | Hallo
159 | goodbye
160 | EOF
161 |     );
162 | }
163 | 
164 | sub test_misc_standard_filters : Tests {
165 |     my $self = shift;
166 | 
167 |     $self->test_comp(
168 |         src    => 'the <% $m->filter($.Trim, "   quick brown   ") %> fox',
169 |         expect => 'the quick brown fox'
170 |     );
171 |     $self->test_comp(
172 |         src => '
173 | % $.Capture(\my $buf) {{
174 | 2 + 2 = <% 2+2 %>
175 | % }}
176 | <% reverse($buf) %>
177 | 
178 | % $.Tee(\my $buf2) {{
179 | 3 + 3 = <% 3+3 %>
180 | % }}
181 | <% reverse($buf2) %>
182 | 
183 | ---
184 | % $.NoBlankLines {{
185 | 
186 | one
187 | 
188 | 
189 | 
190 | 
191 | two
192 | 
193 | % }}
194 | ---
195 | ',
196 |         expect => '
197 | 4 = 2 + 2
198 | 
199 | 3 + 3 = 6
200 | 
201 | 6 = 3 + 3
202 | 
203 | ---
204 | one
205 | two
206 | ---
207 | 
208 | ',
209 |     );
210 | }
211 | 
212 | sub test_compcall_filter : Tests {
213 |     my $self = shift;
214 | 
215 |     $self->add_comp(
216 |         path => '/list_items.mi',
217 |         src  => '
218 | <%class>
219 | has "items";
220 | has "yield";
221 | 
222 | 
223 | % foreach my $item (@{$.items}) {
224 | <% $.yield->($item) %>
225 | % }
226 | ',
227 |     );
228 |     $self->test_comp(
229 |         src => '
230 | % $.CompCall ("list_items.mi", items => [1,2,3]) {{
231 | 
  • <% $_[0] %>
    • 
232 | % }}
233 | ',
234 |         expect => '
235 | 
  • 1
    • 
236 | 
237 | 
  • 2
    • 
238 | 
239 | 
  • 3
    • 
240 | ',
241 |     );
242 | }
243 | 
244 | sub test_around : Tests {
245 |     my $self = shift;
246 |     $self->test_comp(
247 |         src => <<'EOF',
248 | hello
249 | 
250 | <%around main>
251 | % sub { uc($_[0]) } {{
252 | %   $self->$orig();
253 | % }}
254 | 
255 | 
256 | EOF
257 |         expect => <<'EOF',
258 | HELLO
259 | EOF
260 |     );
261 | }
262 | 
263 | # Test old filter syntax, still currently supported
264 | #
265 | sub test_old_syntax : Tests {
266 |     my $self = shift;
267 |     $self->test_comp(
268 |         src => '
269 | <%class>
270 | method Upper () { sub { uc(shift) } }
271 | 
272 | 
273 | <% $.Upper { %>
274 | Hello World.
275 | 
276 | 
277 | <% sub { ucfirst(shift) } { %>
278 | <% "hello world?" %>
279 | <% } %>
280 | 
281 | <% sub { lc(shift) } { %>
282 | Hello World!
283 | 
284 | ',
285 |         expect => '
286 | HELLO WORLD.
287 | Hello world?
288 | hello world!
289 | ',
290 |     );
291 | }
292 | 
293 | sub test_filter_comment : Tests {
294 |     my $self = shift;
295 |     $self->test_comp(
296 |         src => '
297 | <%class>
298 | method LESSp () { sub { uc(shift) } }
299 | 
300 | % $.LESSp {{
301 | #header {
302 |     text-align: left;
303 | }
304 | % }}
305 | #footer {
306 |     text-align: right;
307 | }
308 | ',
309 |         expect => '
310 | #HEADER {
311 |     TEXT-ALIGN: LEFT;
312 | }
313 | #footer {
314 |     text-align: right;
315 | }
316 | ',
317 |     );
318 | }
319 | 
320 | sub test_no_undef_warning : Tests {
321 |     my $self = shift;
322 |     warnings_are {
323 |         $self->test_comp(
324 |             src => '
325 | <%class>
326 | method Upper () { sub { uc(shift) } }
327 | method Upper2 () {
328 |     return Mason::DynamicFilter->new(
329 |         filter => sub {
330 |             my $yield = $_[0];
331 |             return uc($yield->());
332 |         }
333 |     );
334 | }
335 | 
336 | 
337 | <%filter Upper3>
338 | <% uc($yield->()) %>
339 | 
340 | 
341 | a = <% "a" | Upper %>.
342 | undef = <% undef | Upper %>.
343 | 
344 | a = <% "a" | Upper2 %>.
345 | undef = <% undef | Upper2 %>.
346 | 
347 | a = <% "a" | Upper3 %>.
348 | undef = <% undef | Upper3 %>.
349 | ',
350 |             expect => '
351 | a = A.
352 | undef = .
353 | 
354 | a = A.
355 | undef = .
356 | 
357 | a = A.
358 | undef = .
359 | ',
360 |         );
361 |     }
362 |     [], "no warnings on undef";
363 | }
364 | 
365 | 1;
366 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Globals.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::Globals;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | sub test_globals : Tests {
 6 |     my $self = shift;
 7 |     $self->setup_interp( allow_globals => [qw(scalar $scalar2)] );
 8 |     my $interp = $self->interp;
 9 |     $interp->set_global( 'scalar',   5 );
10 |     $interp->set_global( '$scalar2', 'vanilla' );
11 |     throws_ok { $interp->set_global( '$bad', 8 ) } qr/\$bad is not in the allowed globals list/;
12 |     $self->add_comp(
13 |         path => '/values',
14 |         src  => '
15 | scalar = <% $scalar %>
16 | $scalar2 = <% $scalar2 %>
17 | ',
18 |     );
19 |     $self->test_comp(
20 |         src => '
21 | <& /values &>
22 | % $scalar++;
23 | % $scalar2 .= "s";
24 | <& /values &>
25 | ',
26 |         expect => '
27 | scalar = 5
28 | $scalar2 = vanilla
29 | 
30 | 
31 | scalar = 6
32 | $scalar2 = vanillas
33 | ',
34 |     );
35 | }
36 | 
37 | 1;
38 | 


--------------------------------------------------------------------------------
/lib/Mason/t/HTMLFilters.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::HTMLFilters;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | sub test_html_filters : Tests {
 6 |     my $self = shift;
 7 |     $self->setup_interp( plugins => [ '@Default', 'HTMLFilters' ] );
 8 |     $self->test_comp( src => '<% "" | HTML %>',         expect => '<a>' );
 9 |     $self->test_comp( src => '<% "/foo/bar?a=5" | URI %>', expect => '%2Ffoo%2Fbar%3Fa%3D5' );
10 |     $self->test_comp(
11 |         src    => '<% "First\n\nSecond\n\nThird\n\n" | HTMLPara %>',
12 |         expect => "
    \nFirst\n
    \n\n
    \nSecond\n
    \n\n
    \nThird
    \n"
13 |     );
14 |     $self->test_comp(
15 |         src    => '<% "First\n\nSecond\n\nThird\n\n" | NoBlankLines,HTMLPara %>',
16 |         expect => "
    \nFirst\n
    \n
    \nSecond\n
    \n
    \nThird
    \n"
17 |     );
18 | }
19 | 
20 | 1;
21 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Interp.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::Interp;
  2 | 
  3 | use Test::Class::Most parent => 'Mason::Test::Class';
  4 | use Capture::Tiny qw(capture);
  5 | 
  6 | { package MyInterp; use Moose; extends 'Mason::Interp'; __PACKAGE__->meta->make_immutable() }
  7 | 
  8 | sub test_base_interp_class : Tests {
  9 |     my $self = shift;
 10 |     my $interp = $self->create_interp( base_interp_class => 'MyInterp' );
 11 |     is( ref($interp), 'MyInterp' );
 12 | }
 13 | 
 14 | sub test_find_paths : Tests {
 15 |     my $self   = shift;
 16 |     my $r1     = $self->temp_dir . "/r1";
 17 |     my $r2     = $self->temp_dir . "/r2";
 18 |     my $interp = $self->create_interp( comp_root => [ $r1, $r2 ] );
 19 |     my @files =
 20 |       ( "$r1/foo.mc", "$r1/foo/bar.mc", "$r2/foo/baz.mc", "$r1/foo/blarg.mc", "$r2/foo/blarg.mc" );
 21 |     foreach my $file (@files) {
 22 |         $self->mkpath_and_write_file( $file, " " );
 23 |     }
 24 |     cmp_set(
 25 |         [ $interp->all_paths("/") ],
 26 |         [qw(/foo.mc /foo/bar.mc /foo/baz.mc /foo/blarg.mc)],
 27 |         "all_paths(/)"
 28 |     );
 29 |     cmp_set(
 30 |         [ $interp->all_paths() ],
 31 |         [qw(/foo.mc /foo/bar.mc /foo/baz.mc /foo/blarg.mc)],
 32 |         "all_paths(/)"
 33 |     );
 34 |     cmp_set(
 35 |         [ $interp->all_paths("/foo") ],
 36 |         [qw(/foo/bar.mc /foo/baz.mc /foo/blarg.mc)],
 37 |         "all_paths(/foo)"
 38 |     );
 39 |     cmp_set( [ $interp->all_paths("/bar") ], [], "all_paths(/bar)" );
 40 | 
 41 |     cmp_set(
 42 |         [ $interp->glob_paths("/foo/ba*.mc") ],
 43 |         [qw(/foo/bar.mc /foo/baz.mc)],
 44 |         "glob_paths(/foo/ba*.mc)"
 45 |     );
 46 |     cmp_set( [ $interp->glob_paths("/foo/bl*.mc") ],
 47 |         [qw(/foo/blarg.mc)], "glob_paths(/foo/bl*.mc)" );
 48 |     cmp_set( [ $interp->glob_paths("/foo/d*") ], [], "glob_paths(/foo/d*)" );
 49 | }
 50 | 
 51 | sub test_component_class_prefix : Tests {
 52 |     my $self = shift;
 53 | 
 54 |     my $check_prefix = sub {
 55 |         my $interp = shift;
 56 |         my $regex  = "^" . $interp->component_class_prefix . "::";
 57 |         like( $interp->load('/foo.mc'), qr/$regex/, "prefix at beginning of path" );
 58 |     };
 59 | 
 60 |     $self->add_comp( path => '/foo.mc', src => 'foo' );
 61 | 
 62 |     my @interp =
 63 |       map { $self->create_interp() } ( 0 .. 1 );
 64 |     ok( $interp[0]->component_class_prefix ne $interp[1]->component_class_prefix,
 65 |         "different prefixes" );
 66 |     ok( $interp[0]->load('/foo.mc') ne $interp[1]->load('/foo.mc'), "different classnames" );
 67 | 
 68 |     $check_prefix->( $interp[0] );
 69 |     $check_prefix->( $interp[1] );
 70 | 
 71 |     $interp[2] = $self->create_interp( component_class_prefix => 'Blah' );
 72 |     is( $interp[2]->component_class_prefix, 'Blah', 'specified prefix' );
 73 |     $check_prefix->( $interp[2] );
 74 | }
 75 | 
 76 | sub test_no_data_dir : Tests {
 77 |     my $self = shift;
 78 |     my $interp = Mason->new( comp_root => $self->comp_root );
 79 |     ok( -d $interp->data_dir );
 80 | }
 81 | 
 82 | sub test_bad_param : Tests {
 83 |     my $self = shift;
 84 |     throws_ok { $self->create_interp( foo => 5 ) } qr/Found unknown attribute/;
 85 | }
 86 | 
 87 | sub test_comp_exists : Tests {
 88 |     my $self = shift;
 89 | 
 90 |     $self->add_comp( path => '/comp_exists/one.mc', src => 'hi' );
 91 |     my $interp = $self->interp;
 92 |     ok( $interp->comp_exists('/comp_exists/one.mc') );
 93 |     ok( !$interp->comp_exists('/comp_exists/two.mc') );
 94 |     throws_ok { $interp->comp_exists('one.mc') } qr/not an absolute/;
 95 | }
 96 | 
 97 | sub test_out_method : Tests {
 98 |     my $self = shift;
 99 | 
100 |     $self->add_comp( path => '/out_method/hi.mc', src => 'hi' );
101 | 
102 |     my $buffer = '';
103 |     my $try    = sub {
104 |         my ( $out_method, $expect_result, $expect_buffer, $expect_stdout, $desc ) = @_;
105 |         my ( $result, $stdout );
106 |         my @params = ( $out_method ? ( { out_method => $out_method } ) : () );
107 |         ($stdout) = capture {
108 |             $result = $self->interp->run( @params, '/out_method/hi' );
109 |         };
110 |         is( $stdout,         $expect_stdout, "stdout - $desc" );
111 |         is( $buffer,         $expect_buffer, "buffer - $desc" );
112 |         is( $result->output, $expect_result, "result->output - $desc" );
113 |     };
114 | 
115 |     $try->( undef, 'hi', '', '', 'undef' );
116 |     $try->( sub { print $_[0] }, '', '', 'hi', 'sub print' );
117 |     $try->( sub { $buffer .= uc( $_[0] ) }, '', 'HI', '', 'sub buffer .=' );
118 |     $try->( \$buffer, '', 'HIhi', '', '\$buffer' );
119 | 
120 |     $buffer = '';
121 |     $self->setup_interp( out_method => sub { print scalar( reverse( $_[0] ) ) } );
122 |     $try->( undef, '', '', 'ih', 'print reverse' );
123 | }
124 | 
125 | sub test_no_source_line_numbers : Tests {
126 |     my $self = shift;
127 | 
128 |     $self->test_parse( src => "hi\n<%init>my \$d = 0", expect => [qr/\#line/] );
129 |     $self->setup_interp( no_source_line_numbers => 1 );
130 |     $self->test_parse( src => "hi\n<%init>my \$d = 0", expect => [qr/^(?!(?s:.*)\#line)/] );
131 | }
132 | 
133 | sub test_class_header : Tests {
134 |     my $self = shift;
135 | 
136 |     $self->setup_interp( class_header => '# header' );
137 |     $self->test_parse( src => "hi", expect => [qr/\# header/] );
138 | }
139 | 
140 | 1;
141 | 


--------------------------------------------------------------------------------
/lib/Mason/t/LvalueAttributes.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::LvalueAttributes;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | __PACKAGE__->default_plugins( [ '@Default', 'LvalueAttributes' ] );
 6 | 
 7 | sub test_lvalue : Tests {
 8 |     my $self = shift;
 9 |     $self->test_comp(
10 |         src => '
11 | <%class>
12 | has "a" => (is => "rw");
13 | has "b" => (is => "ro");
14 | 
15 | 
16 | 
17 | <%init>
18 | $.a = 5;
19 | print "a = " . $.a . "\n";
20 | $.a(6);
21 | print "a = " . $.a . "\n";
22 | eval { $.b = 6 };
23 | print $@ . "\n";
24 | 
25 | ',
26 |         expect => qr/a = 5\na = 6\nCan't modify.*/,
27 |     );
28 | }
29 | 
30 | 1;
31 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Plugins.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::Plugins;    ## no critic (Moose::RequireMakeImmutable)
  2 | 
  3 | use Test::Class::Most parent => 'Mason::Test::Class';
  4 | use Capture::Tiny qw(capture_merged);
  5 | use Mason::Util qw(dump_one_line);
  6 | 
  7 | sub test_notify_plugin : Tests {
  8 |     my $self = shift;
  9 | 
 10 |     $self->setup_interp(
 11 |         plugins                => ['+Mason::Test::Plugins::Notify'],
 12 |         no_source_line_numbers => 1,
 13 |     );
 14 |     $self->add_comp( path => '/test_plugin_support.mi', src => 'hi' );
 15 |     my $output = capture_merged {
 16 |         $self->test_comp(
 17 |             path   => '/test_plugin.mc',
 18 |             src    => '<& test_plugin_support.mi &>',
 19 |             expect => 'hi'
 20 |         );
 21 |     };
 22 | 
 23 |     my $like = sub { my $regex = shift; like( $output, $regex, $regex ) };
 24 |     $like->(qr/starting interp run/);
 25 |     $like->(qr/starting request run - \/test_plugin/);
 26 |     $like->(qr/starting request comp - test_plugin_support.mi/);
 27 |     $like->(qr/starting compilation parse - \/test_plugin.mc/);
 28 | }
 29 | 
 30 | # Call Mason::Test::RootClass->new, then make base classes like
 31 | # Mason::Test::RootClass::Interp are used automatically
 32 | #
 33 | sub test_notify_root_class : Tests {
 34 |     my $self = shift;
 35 |     my $mrc  = 'Mason::Test::RootClass';
 36 |     $self->setup_interp( mason_root_class => $mrc );
 37 |     is( $self->interp->mason_root_class,       $mrc,                  "mason_root_class" );
 38 |     is( $self->interp->base_compilation_class, "${mrc}::Compilation", "base_compilation_class" );
 39 |     is( $self->interp->base_component_class,   "${mrc}::Component",   "base_component_class" );
 40 |     is( $self->interp->base_request_class,     "${mrc}::Request",     "base_request_class" );
 41 |     is( $self->interp->base_result_class,      "Mason::Result",       "base_result_class" );
 42 |     isa_ok( $self->interp, "${mrc}::Interp", "base_interp_class" );
 43 | 
 44 |     $self->add_comp( path => '/test_plugin_support.mi', src => 'hi' );
 45 |     my $output = capture_merged {
 46 |         $self->test_comp(
 47 |             path   => '/test_plugin.mc',
 48 |             src    => '<& test_plugin_support.mi &>',
 49 |             expect => 'hi'
 50 |         );
 51 |     };
 52 | 
 53 |     my $like = sub { my $regex = shift; like( $output, $regex, $regex ) };
 54 |     $like->(qr/starting interp run/);
 55 |     $like->(qr/starting request run - \/test_plugin/);
 56 |     $like->(qr/starting request comp - test_plugin_support.mi/);
 57 |     $like->(qr/starting compilation parse - \/test_plugin.mc/);
 58 | }
 59 | 
 60 | sub test_strict_plugin : Tests {
 61 |     my $self = shift;
 62 | 
 63 |     $self->setup_interp(
 64 |         base_component_moose_class => 'Mason::Test::Overrides::Component::StrictMoose', );
 65 |     $self->add_comp( path => '/test_strict_plugin.mc', src => 'hi' );
 66 |     lives_ok { $self->interp->run('/test_strict_plugin') };
 67 |     throws_ok { $self->interp->run( '/test_strict_plugin', foo => 5 ) } qr/Found unknown attribute/;
 68 | }
 69 | 
 70 | {
 71 |     package Mason::Test::Plugins::A;
 72 | 
 73 |     use Moose;
 74 |     with 'Mason::Plugin';
 75 | }
 76 | {
 77 |     package Mason::Plugin::B;
 78 | 
 79 |     use Moose;
 80 |     with 'Mason::Plugin';
 81 | }
 82 | {
 83 |     package Mason::Plugin::C;
 84 | 
 85 |     use Moose;
 86 |     with 'Mason::Plugin';
 87 | }
 88 | {
 89 |     package Mason::Plugin::D;
 90 | 
 91 |     use Moose;
 92 |     with 'Mason::Plugin';
 93 | }
 94 | {
 95 |     package Mason::Plugin::E;
 96 | 
 97 |     use Moose;
 98 |     with 'Mason::Plugin';
 99 | }
100 | {
101 |     package Mason::PluginBundle::F;
102 | 
103 |     use Moose;
104 |     with 'Mason::PluginBundle';
105 |     sub requires_plugins { return qw(C D) }
106 | }
107 | {
108 |     package Mason::Test::PluginBundle::G;
109 | 
110 |     use Moose;
111 |     with 'Mason::PluginBundle';
112 |     sub requires_plugins { return qw(C E) }
113 | }
114 | {
115 |     package Mason::Plugin::H;
116 | 
117 |     use Moose;
118 |     with 'Mason::Plugin';
119 |     sub requires_plugins { return qw(@F) }
120 | }
121 | {
122 |     package Mason::PluginBundle::I;
123 | 
124 |     use Moose;
125 |     with 'Mason::PluginBundle';
126 | 
127 |     sub requires_plugins {
128 |         return ( '+Mason::Test::Plugins::A', 'B', '@F', '+Mason::Test::PluginBundle::G', );
129 |     }
130 | }
131 | 
132 | {
133 |     package Mason::PluginBundle::J;
134 | 
135 |     use Moose;
136 |     with 'Mason::PluginBundle';
137 | 
138 |     sub requires_plugins {
139 |         return ('@I');
140 |     }
141 | }
142 | 
143 | sub test_plugin_specs : Tests {
144 |     my $self = shift;
145 | 
146 |     require Mason::PluginBundle::Default;
147 |     my @default_plugins = Mason::PluginBundle::Default->requires_plugins
148 |       or die "no default plugins";
149 |     my $test = sub {
150 |         my ( $plugin_list, $expected_plugins ) = @_;
151 |         my $interp = Mason->new( comp_root => $self->comp_root, plugins => $plugin_list );
152 |         my $got_plugins =
153 |           [ map { /Mason::Plugin::/ ? substr( $_, 15 ) : $_ } @{ $interp->plugins } ];
154 |         cmp_deeply(
155 |             $got_plugins,
156 |             [ @$expected_plugins, @default_plugins ],
157 |             dump_one_line($plugin_list)
158 |         );
159 |     };
160 |     $test->( [], [] );
161 |     $test->( ['E'], ['E'] );
162 |     $test->( ['H'], [ 'H', 'C', 'D' ] );
163 |     $test->( ['@F'], [ 'C', 'D' ] );
164 |     $test->( ['@I'], [ 'Mason::Test::Plugins::A', 'B', 'C', 'D', 'E' ] );
165 |     $test->( [ '-C', '@I', '-+Mason::Test::Plugins::A' ], [ 'B', 'D', 'E' ] );
166 |     $test->( [ '-@I', '@J' ], [] );
167 |     throws_ok { $test->( ['@X'] ) } qr/could not load 'Mason::PluginBundle::X'/;
168 |     throws_ok { $test->( ['Y'] ) } qr/could not load 'Mason::Plugin::Y'/;
169 | }
170 | 
171 | {
172 |     package Mason::Test::Plugins::Upper;
173 | 
174 |     use Moose;
175 |     with 'Mason::Plugin'
176 | }
177 | {
178 |     package Mason::Test::Plugins::Upper::Request;
179 | 
180 |     use Mason::PluginRole;
181 |     after 'process_output' => sub {
182 |         my ( $self, $bufref ) = @_;
183 |         $$bufref = uc($$bufref);
184 |     };
185 | }
186 | 
187 | sub test_process_output_plugin : Tests {
188 |     my $self = shift;
189 | 
190 |     $self->setup_interp( plugins => ['+Mason::Test::Plugins::Upper'] );
191 |     $self->test_comp( src => 'Hello', expect => 'HELLO' );
192 | }
193 | 
194 | 1;
195 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Reload.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::Reload;
  2 | 
  3 | use Test::Class::Most parent => 'Mason::Test::Class';
  4 | 
  5 | sub test_reload : Tests {
  6 |     my $self = shift;
  7 |     my $class;
  8 | 
  9 |     $self->add_comp(
 10 |         path => "/reload.mc",
 11 |         src  => <<'EOF',
 12 | <%class>
 13 | sub foo { 'foo' }
 14 | sub baz { 'baz1' }
 15 | 
 16 | Foo
 17 | EOF
 18 |     );
 19 |     is( $self->interp->run("/reload")->output, "Foo\n", "before reload" );
 20 |     $class = $self->interp->load("/reload.mc");
 21 |     is( $class->foo(), 'foo',  "method foo" );
 22 |     is( $class->baz(), 'baz1', "method baz" );
 23 |     ok( $class->can('foo'),  "can call foo before reload" );
 24 |     ok( !$class->can('bar'), "cannot call bar before reload" );
 25 |     ok( $class->can('baz'),  "can call baz before reload" );
 26 | 
 27 |     sleep(1);    # so timestamp will be different
 28 | 
 29 |     $self->add_comp(
 30 |         path => "/reload.mc",
 31 |         src  => <<'EOF',
 32 | <%class>
 33 | sub bar { 'bar' }
 34 | sub baz { 'baz2' }
 35 | 
 36 | Bar
 37 | EOF
 38 |     );
 39 |     is( $self->interp->run("/reload")->output, "Bar\n", "after reload" );
 40 |     is( $class->bar(),                         'bar',   "method bar" );
 41 |     is( $class->baz(),                         'baz2',  "method baz" );
 42 |     ok( $class->can('bar'),  "can call bar after reload" );
 43 |     ok( !$class->can('foo'), "cannot call foo after reload" );
 44 |     ok( $class->can('baz'),  "can call baz after reload" );
 45 | }
 46 | 
 47 | sub test_reload_parent : Tests {
 48 |     my $self   = shift;
 49 |     my $interp = $self->interp;
 50 | 
 51 |     $self->add_comp( path => '/foo/bar/baz.mc', src => '<% $.num1 %> <% $.num2 %>' );
 52 |     $self->add_comp( path => '/foo/Base.mc',    src => '<%class>method num1 { 5 }' );
 53 |     $self->add_comp( path => '/Base.mc',        src => '<%class>method num2 { 6 }' );
 54 | 
 55 |     $self->test_existing_comp( path => '/foo/bar/baz.mc', expect => '5 6' );
 56 | 
 57 |     $self->interp->_flush_load_cache();
 58 |     sleep(1);
 59 | 
 60 |     $self->add_comp( path => '/foo/Base.mc', src => "<%class>method num1 { 7 }" );
 61 |     $self->add_comp( path => '/Base.mc',     src => "<%class>method num2 { 8 }" );
 62 |     $self->test_existing_comp( path => '/foo/bar/baz.mc', expect => '7 8' );
 63 | 
 64 |     $self->interp->_flush_load_cache();
 65 |     sleep(1);
 66 | 
 67 |     $self->add_comp(
 68 |         path => '/Base.mc',
 69 |         src  => "<%class>method num1 { 10 }\nmethod num2 { 11 }\n"
 70 |     );
 71 |     $self->test_existing_comp( path => '/foo/bar/baz.mc', expect => '7 11' );
 72 | 
 73 |     $self->interp->_flush_load_cache();
 74 |     sleep(1);
 75 | 
 76 |     $self->remove_comp( path => '/foo/Base.mc' );
 77 |     $self->test_existing_comp( path => '/foo/bar/baz.mc', expect => '10 11' );
 78 | 
 79 |     $self->interp->_flush_load_cache();
 80 |     sleep(1);
 81 | 
 82 |     $self->remove_comp( path => '/foo/Base.mc' );
 83 |     $self->add_comp( path => '/foo/bar/baz.mc', src => 'hi' );
 84 |     $self->add_comp( path => '/Base.mp',        src => 'method wrap { print "wrap1" }' );
 85 |     $self->test_existing_comp( path => '/foo/bar/baz.mc', expect => 'wrap1' );
 86 | 
 87 |     $self->interp->_flush_load_cache();
 88 |     sleep(1);
 89 | 
 90 |     $self->add_comp( path => '/Base.mp', src => 'method wrap { print "wrap2" }' );
 91 |     $self->test_existing_comp( path => '/foo/bar/baz.mc', expect => 'wrap2' );
 92 | }
 93 | 
 94 | sub test_no_unnecessary_reload : Tests {
 95 |     my $self   = shift;
 96 |     my $interp = $self->interp;
 97 | 
 98 |     $self->add_comp( path => '/foo.mc', src => ' ' );
 99 |     my $id1 = $interp->load('/foo.mc')->cmeta->id;
100 |     $self->interp->_flush_load_cache();
101 |     my $id2 = $interp->load('/foo.mc')->cmeta->id;
102 |     ok( $id1 == $id2 );
103 | }
104 | 
105 | 1;
106 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Request.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::Request;
  2 | 
  3 | use Test::Class::Most parent => 'Mason::Test::Class';
  4 | use Log::Any::Test;
  5 | use Log::Any qw($log);
  6 | 
  7 | sub _get_current_comp_class {
  8 |     my $m = shift;
  9 |     return $m->current_comp_class;
 10 | }
 11 | 
 12 | sub test_add_cleanup : Tests {
 13 |     my $self = shift;
 14 |     my $foo  = 1;
 15 |     $self->test_comp(
 16 |         src => '
 17 | % my $ref = $.args->{ref};
 18 | % $m->add_cleanup(sub { $$ref++ });
 19 | foo = <% $$ref %>
 20 | ',
 21 |         args   => { ref => \$foo },
 22 |         expect => 'foo = 1'
 23 |     );
 24 |     is( $foo, 2, "foo now 2" );
 25 | }
 26 | 
 27 | sub test_capture : Tests {
 28 |     my $self = shift;
 29 |     $self->run_test_in_comp(
 30 |         test => sub {
 31 |             my $comp = shift;
 32 |             my $m    = $comp->m;
 33 |             is( $m->capture( sub { print "abcde" } ), 'abcde' );
 34 |         }
 35 |     );
 36 | }
 37 | 
 38 | sub test_comp_exists : Tests {
 39 |     my $self = shift;
 40 | 
 41 |     $self->add_comp( path => '/comp_exists/one.mc', src => 'hi' );
 42 |     $self->test_comp(
 43 |         path => '/comp_exists/two.mc',
 44 |         src  => '
 45 | % foreach my $path (qw(/comp_exists/one.mc /comp_exists/two.mc /comp_exists/three.mc one.mc two.mc three.mc)) {
 46 | <% $path %>: <% $m->comp_exists($path) ? "yes" : "no" %>
 47 | % }
 48 | ',
 49 |         expect => '
 50 | /comp_exists/one.mc: yes
 51 | /comp_exists/two.mc: yes
 52 | /comp_exists/three.mc: no
 53 | one.mc: yes
 54 | two.mc: yes
 55 | three.mc: no
 56 | ',
 57 |     );
 58 | }
 59 | 
 60 | sub test_current_comp_class : Tests {
 61 |     shift->test_comp(
 62 |         path   => '/current_comp_class.mc',
 63 |         src    => '<% ' . __PACKAGE__ . '::_get_current_comp_class($m)->cmeta->path %>',
 64 |         expect => '/current_comp_class.mc'
 65 |     );
 66 | }
 67 | 
 68 | sub test_id : Tests {
 69 |     my $self = shift;
 70 |     $self->setup_dirs;
 71 |     $self->add_comp( path => '/id.mc', src => 'id=<% $m->id %>' );
 72 |     my ($id1) = ( $self->interp->run('/id')->output =~ /id=(\d+)/ );
 73 |     my ($id2) = ( $self->interp->run('/id')->output =~ /id=(\d+)/ );
 74 |     ok( $id1 != $id2 );
 75 | }
 76 | 
 77 | sub test_log : Tests {
 78 |     my $self = shift;
 79 |     $self->add_comp( path => '/log/one.mc', src => '% $m->log->info("message one")' );
 80 |     $self->run_test_in_comp(
 81 |         path => '/log.mc',
 82 |         test => sub {
 83 |             my $comp = shift;
 84 |             my $m    = $comp->m;
 85 |             $m->comp('/log/one.mc');
 86 |             $log->contains_ok("message one");
 87 |         },
 88 |     );
 89 | }
 90 | 
 91 | sub test_notes : Tests {
 92 |     my $self = shift;
 93 |     $self->add_comp(
 94 |         path => '/show',
 95 |         src  => '
 96 | <% $m->notes("foo") %>
 97 | % $m->notes("foo", 3);
 98 | ',
 99 |     );
100 |     $self->test_comp(
101 |         src => '
102 | % $m->notes("foo", 2);
103 | <% $m->notes("foo") %>
104 | <& /show &>
105 | <% $m->notes("foo") %>
106 | ',
107 |         expect => "2\n\n2\n\n3\n",
108 |     );
109 | }
110 | 
111 | sub test_page : Tests {
112 |     my $self = shift;
113 |     $self->add_comp( path => '/page/other.mi', src => '<% $m->page->cmeta->path %>' );
114 |     $self->test_comp(
115 |         path   => '/page/first.mc',
116 |         src    => '<% $m->page->cmeta->path %>; <& other.mi &>',
117 |         expect => '/page/first.mc; /page/first.mc'
118 |     );
119 | }
120 | 
121 | sub test_result_data : Tests {
122 |     my $self = shift;
123 |     $self->test_comp(
124 |         src         => '% $m->result->data->{color} = "red"',
125 |         expect_data => { color => "red" }
126 |     );
127 | }
128 | 
129 | sub test_scomp : Tests {
130 |     my $self = shift;
131 |     $self->add_comp( path => '/str', src => 'abcde' );
132 |     $self->run_test_in_comp(
133 |         test => sub {
134 |             my $comp = shift;
135 |             my $m    = $comp->m;
136 |             is( $m->scomp('/str'), 'abcde' );
137 |             is( $m->capture( sub { $m->scomp('/str') } ), '' );
138 |         }
139 |     );
140 | }
141 | 
142 | sub test_go : Tests {
143 |     my $self = shift;
144 | 
145 |     my ( $buf, $result );
146 | 
147 |     reset_id();
148 |     $self->add_comp(
149 |         path => '/subreq/other.mc',
150 |         src  => '
151 | id=<% $m->id %>
152 | <% $m->page->cmeta->path %>
153 | <% $m->request_path %>
154 | args: <% Mason::Util::dump_one_line($m->request_args) %>
155 | ',
156 |     );
157 |     $self->test_comp(
158 |         path => '/subreq/go.mc',
159 |         src  => '
160 | This should not get printed.
161 | <%perl>$m->go("/subreq/other", foo => 5);',
162 |         expect => '
163 | id=1
164 | /subreq/other.mc
165 | /subreq/other
166 | args: {foo => 5}
167 | ',
168 |     );
169 |     reset_id();
170 |     $self->test_comp(
171 |         path => '/subreq/go_with_req_params.mc',
172 |         src  => '
173 | This should not get printed.
174 | <%perl>my $buf; $m->go({out_method => \$buf}, "/subreq/other", foo => 5)',
175 |         expect => '',
176 |     );
177 | 
178 |     reset_id();
179 |     $result = $self->interp->run( { out_method => \$buf }, '/subreq/go' );
180 |     is( $result->output, '', 'no output' );
181 |     is(
182 |         $buf, '
183 | id=1
184 | /subreq/other.mc
185 | /subreq/other
186 | args: {foo => 5}
187 | ', 'output in buf'
188 |     );
189 | }
190 | 
191 | sub test_visit : Tests {
192 |     my $self = shift;
193 | 
194 |     my ( $buf, $result );
195 | 
196 |     reset_id();
197 |     $self->add_comp(
198 |         path => '/subreq/other.mc',
199 |         src  => '
200 | id=<% $m->id %>
201 | <% $m->page->cmeta->path %>
202 | <% $m->request_path %>
203 | args: <% Mason::Util::dump_one_line($m->request_args) %>
204 | ',
205 |     );
206 |     $self->test_comp(
207 |         path => '/subreq/visit.mc',
208 |         src  => '
209 | begin
210 | id=<% $m->id %>
211 | <%perl>$m->visit("/subreq/other", foo => 5);
212 | id=<% $m->id %>
213 | end
214 | ',
215 |         expect => '
216 | begin
217 | id=0
218 | id=1
219 | /subreq/other.mc
220 | /subreq/other
221 | args: {foo => 5}
222 | id=0
223 | end
224 | ',
225 |     );
226 | 
227 |     reset_id();
228 |     $self->test_comp(
229 |         path => '/subreq/visit_with_req_params.mc',
230 |         src  => '
231 | begin
232 | id=<% $m->id %>
233 | <%perl>my $buf; $m->visit({out_method => \$buf}, "/subreq/other", foo => 5); print uc($buf);
234 | id=<% $m->id %>
235 | end
236 | ',
237 |         expect => '
238 | begin
239 | id=0
240 | ID=1
241 | /SUBREQ/OTHER.MC
242 | /SUBREQ/OTHER
243 | ARGS: {FOO => 5}
244 | id=0
245 | end
246 | ',
247 |     );
248 | 
249 |     reset_id();
250 |     $result = $self->interp->run( { out_method => \$buf }, '/subreq/visit' );
251 |     is( $result->output, '', 'no output' );
252 |     is(
253 |         $buf, '
254 | begin
255 | id=0
256 | id=1
257 | /subreq/other.mc
258 | /subreq/other
259 | args: {foo => 5}
260 | id=0
261 | end
262 | ', 'visit with initial out_method'
263 |     );
264 | }
265 | 
266 | sub reset_id {
267 |     Mason::Request->_reset_next_id;
268 | }
269 | 
270 | 1;
271 | 


--------------------------------------------------------------------------------
/lib/Mason/t/ResolveURI.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::ResolveURI;
  2 | 
  3 | use Test::Class::Most parent => 'Mason::Test::Class';
  4 | 
  5 | sub test_resolve : Tests {
  6 |     my $self = shift;
  7 | 
  8 |     my @interp_params = ();
  9 |     my $try           = sub {
 10 |         my ( $run_path, $existing_paths, $resolve_path, $path_info ) = @_;
 11 |         $path_info ||= '';
 12 | 
 13 |         $self->setup_dirs(@interp_params);
 14 |         foreach my $existing_path (@$existing_paths) {
 15 |             my $allow_path_info = 0;
 16 |             if ( $existing_path =~ /=1$/ ) {
 17 |                 substr( $existing_path, -2, 2 ) = '';
 18 |                 $allow_path_info = 1;
 19 |             }
 20 |             $self->add_comp(
 21 |                 path => $existing_path,
 22 |                 src  => join( "",
 23 |                     ( $allow_path_info ? "<%class>method allow_path_info { 1 }\n" : "" ),
 24 |                     "path: <% \$self->cmeta->path %>; path_info: <% \$m->path_info %>" )
 25 |             );
 26 |         }
 27 |         my $desc = sprintf( "run %s against %s", $run_path, join( ",", @$existing_paths ) );
 28 |         if ( defined($resolve_path) ) {
 29 |             my $good = "path: $resolve_path; path_info: $path_info";
 30 |             is( $self->interp->run($run_path)->output, $good, "$desc = matched $good" );
 31 |         }
 32 |         else {
 33 |             throws_ok { $self->interp->run($run_path)->output }
 34 |             qr/could not resolve request path/,
 35 |               "$desc = failed to match";
 36 |         }
 37 |     };
 38 | 
 39 |     my $run_path = '/foo/bar/baz';
 40 | 
 41 |     $try->( $run_path, ['/foo/bar/baz.mc'],          '/foo/bar/baz.mc',          '' );
 42 |     $try->( $run_path, ['/foo/bar/baz/dhandler.mc'], '/foo/bar/baz/dhandler.mc', '' );
 43 |     $try->( $run_path, ['/foo/bar/baz/index.mc'],    '/foo/bar/baz/index.mc',    '' );
 44 |     $try->( $run_path, ['/foo/bar.mc=1'],            '/foo/bar.mc',              'baz' );
 45 |     $try->( $run_path, ['/foo/bar/dhandler.mc'],     '/foo/bar/dhandler.mc',     'baz' );
 46 |     $try->( $run_path, ['/foo.mc=1'],                '/foo.mc',                  'bar/baz' );
 47 |     $try->( $run_path, ['/foo/dhandler.mc'],         '/foo/dhandler.mc',         'bar/baz' );
 48 |     $try->( $run_path, ['/dhandler.mc'],             '/dhandler.mc',             'foo/bar/baz' );
 49 |     $try->( $run_path, [ '/dhandler.mc',     '/foo/dhandler.mc' ], '/foo/dhandler.mc', 'bar/baz' );
 50 |     $try->( $run_path, [ '/foo/dhandler.mc', '/foo/bar.mc=1' ],    '/foo/bar.mc',      'baz' );
 51 |     $try->( $run_path, [ '/foo/dhandler.mc', '/foo/bar.mc' ],      '/foo/dhandler.mc', 'bar/baz' );
 52 | 
 53 |     # Not found
 54 |     $try->( $run_path, ['/foo/bar.mc'],                    undef );
 55 |     $try->( $run_path, ['/foo.mc'],                        undef );
 56 |     $try->( $run_path, ['/foo/bar/baz/blarg.mc'],          undef );
 57 |     $try->( $run_path, ['/foo/bar/baz/blarg/dhandler.mc'], undef );
 58 |     $try->( $run_path, ['/foo/bar/baz'],                   undef );
 59 |     $try->( $run_path, ['/foo/dhandler'],                  undef );
 60 |     $try->( $run_path, ['/foo/bar/index.mc'],              undef );
 61 |     $try->( $run_path, ['/foo/blarg.mc'],                  undef );
 62 |     $try->( $run_path, ['/foo/blarg/dhandler.mc'],         undef );
 63 | 
 64 |     # Can't access autobase or dhandler directly, but can access index
 65 |     $try->( '/foo/Base',     ['/foo/Base.mc'],     undef );
 66 |     $try->( '/foo/dhandler', ['/foo/dhandler.mc'], '/foo/dhandler.mc', 'dhandler' );
 67 |     $try->( '/foo/index',    ['/foo/index.mc'],    '/foo/index.mc' );
 68 | 
 69 |     # no autoextend_run_path
 70 |     @interp_params = ( autoextend_request_path => 0, top_level_extensions => ['.html'] );
 71 |     $try->( '/foo/bar/baz.html', ['/foo/bar/baz.html'], '/foo/bar/baz.html', '' );
 72 |     $try->( '/foo/bar/baz.html', ['/foo/bar/baz.html.mc'], undef );
 73 |     $try->( "/foo.mc/bar.mi",    ['/foo.mc/bar.mi'],       undef );
 74 |     @interp_params = ( autoextend_request_path => 0, top_level_extensions => [] );
 75 |     $try->( '/foo/bar/baz.html', ['/foo/bar/baz.html'], '/foo/bar/baz.html', '' );
 76 |     $try->( "/foo.mc/bar.mi",    ['/foo.mc/bar.mi'],    '/foo.mc/bar.mi',    '' );
 77 | 
 78 |     # dhandler_names
 79 |     @interp_params = ( dhandler_names => ['dhandler'] );
 80 |     $try->( $run_path, ['/foo/bar/baz/dhandler.mc'], undef );
 81 |     $try->( $run_path, ['/foo/bar/baz/dhandler'],    '/foo/bar/baz/dhandler', '' );
 82 |     $try->( $run_path, ['/foo/bar/dhandler'],        '/foo/bar/dhandler', 'baz' );
 83 | 
 84 |     # index_names
 85 |     @interp_params = ( index_names => [ 'index', 'index2' ] );
 86 |     $try->( $run_path, ['/foo/bar/baz/index.mc'], undef );
 87 |     $try->( $run_path, ['/foo/bar/baz/index'],    '/foo/bar/baz/index', '' );
 88 |     $try->( $run_path, ['/foo/bar/baz/index2'],   '/foo/bar/baz/index2', '' );
 89 |     $try->( $run_path, [ '/foo/bar/baz/index2', '/foo/bar/baz/index' ], '/foo/bar/baz/index', '' );
 90 | 
 91 |     # trailing slashes
 92 |     $try->( '/foo',      ['/foo.mc=1'], '/foo.mc', '' );
 93 |     $try->( '/foo/',     ['/foo.mc=1'], '/foo.mc', '/' );
 94 |     $try->( '/foo/bar',  ['/foo.mc=1'], '/foo.mc', 'bar' );
 95 |     $try->( '/foo/bar/', ['/foo.mc=1'], '/foo.mc', 'bar/' );
 96 |     $try->( '/foo/',     ['/foo.mc'],   undef );
 97 |     @interp_params = ( dhandler_names => ['dhandler'] );
 98 |     $try->( '/foo/',     ['/foo/dhandler'], '/foo/dhandler', '/' );
 99 |     $try->( '/foo/bar',  ['/foo/dhandler'], '/foo/dhandler', 'bar' );
100 |     $try->( '/foo/bar/', ['/foo/dhandler'], '/foo/dhandler', 'bar/' );
101 |     @interp_params = ( index_names => ['index'] );
102 |     $try->( '/foo/', ['/foo/index'], undef );
103 |     $try->( '/foo/', ['/foo/index=1'], '/foo/index', '/' );
104 |     @interp_params = ( dhandler_names => ['dhandler'], index_names => ['index'] );
105 |     $try->( '/foo/', [ '/foo/dhandler', '/foo/index' ],   '/foo/dhandler', '/' );
106 |     $try->( '/foo/', [ '/foo/dhandler', '/foo/index=1' ], '/foo/index',    '/' );
107 | }
108 | 
109 | sub test_decline : Tests {
110 |     my $self = shift;
111 | 
112 |     my @existing_paths =
113 |       qw(/foo/bar.mc /foo/bar/dhandler.mc /foo/bar/index.mc /foo.mc /foo/dhandler.mc /dhandler.mc);
114 |     my @paths_to_decline = ();
115 |     my $run_path         = '/foo/bar';
116 | 
117 |     my $try = sub {
118 |         my ( $resolve_path, $path_info ) = @_;
119 |         my %paths_to_decline_hash = map { ( $_, 1 ) } @paths_to_decline;
120 | 
121 |         $self->setup_dirs();
122 |         foreach my $existing_path (@existing_paths) {
123 |             my $component =
124 |               $paths_to_decline_hash{$existing_path}
125 |               ? '<%perl>$m->decline();'
126 |               : 'path: <% $self->cmeta->path %>; path_info: <% $m->path_info %>';
127 |             $self->add_comp(
128 |                 path => $existing_path,
129 |                 src  => $component,
130 |             );
131 |             $self->add_comp( path => '/Base.mp', src => 'method allow_path_info { 1 }' );
132 |         }
133 |         my $desc = sprintf( "declining: %s", join( ",", @paths_to_decline ) || '' );
134 |         if ( defined($resolve_path) ) {
135 |             is( $self->interp->run($run_path)->output,
136 |                 "path: $resolve_path; path_info: $path_info", $desc );
137 |         }
138 |         else {
139 |             throws_ok { $self->interp->run($run_path)->output }
140 |             qr/could not resolve request path/,
141 |               $desc;
142 |         }
143 |         push( @paths_to_decline, $resolve_path );
144 |     };
145 | 
146 |     # Repeatedly try /foo/bar, test the expected page component, then add
147 |     # that component to the decline list and try again.
148 |     #
149 |     $try->( '/foo/bar.mc',          '' );
150 |     $try->( '/foo/bar/index.mc',    '' );
151 |     $try->( '/foo/bar/dhandler.mc', '' );
152 |     $try->( '/foo.mc',              'bar' );
153 |     $try->( '/foo/dhandler.mc',     'bar' );
154 |     $try->( '/dhandler.mc',         'foo/bar' );
155 |     $try->(undef);
156 | }
157 | 
158 | 1;
159 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Sanity.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::Sanity;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | sub test_ok : Tests {
 6 |     my $self = shift;
 7 |     $self->test_comp( src => '2 + 2 = <% 2 + 2 %>', expect => '2 + 2 = 4' );
 8 | }
 9 | 
10 | 1;
11 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Sections.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::Sections;
  2 | 
  3 | use Test::Class::Most parent => 'Mason::Test::Class';
  4 | 
  5 | sub test_sections : Tests {
  6 |     my $self = shift;
  7 |     $self->test_comp(
  8 |         src => <<'EOF',
  9 | <%doc>
 10 | This should not get printed.
 11 | 
 12 | 
 13 | <%init>
 14 | my $init_message = $self->init_message();
 15 | 
 16 | 
 17 | <%class>
 18 | my $class_message = "class message";
 19 | method init_message () { "init message" }
 20 | 
 21 | 
 22 | 
 23 | <% $class_message %>
 24 | % $self->method_call();
 25 | <% $self->method_call_with_arglist(3, 4) %>
 26 | <%perl>
 27 | print "$init_message\n";
 28 | 
 29 | 
 30 | 
 31 | <%method method_call>
 32 | <% $message %>
 33 | 
 34 | <%init>
 35 | my $message = "message";
 36 | 
 37 | 
 38 | 
 39 | <%before method_call>
 40 | before method call
 41 | 
 42 | 
 43 | <%after method_call>
 44 | after method call
 45 | 
 46 | 
 47 | <%override render>
 48 | start override
 49 | <% super() %>
 50 | end override
 51 | 
 52 | 
 53 | <%method method_call_with_arglist ($foo, $bar)>
 54 | <% $foo %> - <% $bar %>
 55 | 
 56 | 
 57 | EOF
 58 |         expect => <<'EOF',
 59 | start override
 60 | 
 61 | class message
 62 | 
 63 | before method call
 64 | 
 65 | message
 66 | 
 67 | after method call
 68 | 
 69 | 3 - 4
 70 | init message
 71 | 
 72 | 
 73 | end override
 74 | EOF
 75 |     );
 76 | }
 77 | 
 78 | sub test_perl_section_newlines : Tests {
 79 |     my $self = shift;
 80 |     $self->test_comp(
 81 |         src => <<'EOF',
 82 | 1<%perl>print "2\n";
 83 | <%perl>
 84 | print "3\n";
 85 | 
 86 | 
 87 | 4
 88 | 
 89 | <%perl>
 90 | print "5\n";
 91 | 
 92 | 
 93 | 
 94 | 6
 95 | 
 96 | 
 97 | <%perl>
 98 | print "7\n";
 99 | 
100 | EOF
101 |         expect => <<'EOF',
102 | 12
103 | 3
104 | 4
105 | 5
106 | 
107 | 6
108 | 
109 | 7
110 | EOF
111 |     );
112 | }
113 | 
114 | sub test_text_section : Tests {
115 |     my $self = shift;
116 |     $self->test_comp(
117 |         src => <<'EOF',
118 | <%text>
119 | %
120 | <%init>
121 | <%doc>
122 | <% $x %>
123 | 
124 | EOF
125 |         expect => <<'EOF',
126 | 
127 | %
128 | <%init>
129 | <%doc>
130 | <% $x %>
131 | EOF
132 |     );
133 | }
134 | 
135 | sub test_empty_sections : Tests {
136 |     my $self = shift;
137 |     $self->test_comp(
138 |         src => '
139 | hi
140 | <%after foo>
141 | <%around foo>
142 | <%before foo>
143 | <%method foo>
144 | <%filter bar>
145 | <%override allow_path_info>
146 | <%class>
147 | <%doc>
148 | <%flags>
149 | <%init>
150 | <%perl>
151 | <%text>
152 | bye
153 | ',
154 |         expect => "hibye",
155 |     );
156 | }
157 | 
158 | 1;
159 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Skel.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::Skel;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | 
 5 | sub test_ : Tests {
 6 |     my $self = shift;
 7 |     $self->test_comp(
 8 |         src => '
 9 | ',
10 |         expect => '
11 | ',
12 |     );
13 | }
14 | 
15 | 1;
16 | 


--------------------------------------------------------------------------------
/lib/Mason/t/StaticSource.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::StaticSource;
  2 | 
  3 | use Test::Class::Most parent => 'Mason::Test::Class';
  4 | use Mason::Util qw(write_file touch_file);
  5 | 
  6 | sub setup : Test(setup) {
  7 |     my ($self) = @_;
  8 | 
  9 |     $self->setup_dirs();
 10 |     $self->add_comp(
 11 |         path => "/ss/remove_component.mc",
 12 |         src  => "I will be removed.\n",
 13 |     );
 14 |     $self->add_comp(
 15 |         path => "/ss/change_component.mc",
 16 |         src  => "I will be changed.\n",
 17 |     );
 18 | }
 19 | 
 20 | sub write_comp {
 21 |     my ( $self, $path, $contents ) = @_;
 22 |     my $source_file = $self->interp->load($path)->cmeta->source_file;
 23 |     write_file( $source_file, $contents );
 24 | }
 25 | 
 26 | sub remove_comp {
 27 |     my ( $self, $path ) = @_;
 28 |     my $source_file = $self->interp->load($path)->cmeta->source_file;
 29 |     unlink($source_file);
 30 | }
 31 | 
 32 | sub test_change_no_ss : Tests {
 33 |     my $self = shift;
 34 |     $self->test_comp(
 35 |         src    => '<& /ss/change_component.mc &>',
 36 |         expect => 'I will be changed.',
 37 |     );
 38 |     sleep(1);    # Make sure timestamp changes
 39 |     $self->write_comp( "/ss/change_component.mc", "I have changed!\n" );
 40 |     $self->test_comp(
 41 |         src    => '<& /ss/change_component.mc &>',
 42 |         expect => 'I have changed!',
 43 |     );
 44 | }
 45 | 
 46 | sub test_change_and_touch_ss : Tests {
 47 |     my $self       = shift;
 48 |     my $touch_file = $self->temp_dir . "/purge.dat";
 49 |     $self->setup_interp( static_source => 1, static_source_touch_file => $touch_file );
 50 |     $self->test_comp(
 51 |         src    => '<& /ss/change_component.mc &>',
 52 |         expect => 'I will be changed.',
 53 |     );
 54 |     sleep(1);    # Make sure timestamp changes
 55 |     $self->interp->load('/ss/change_component.mc');
 56 |     $self->write_comp( "/ss/change_component.mc", "I have changed!\n" );
 57 |     $self->test_comp(
 58 |         src    => '<& /ss/change_component.mc &>',
 59 |         expect => 'I will be changed.',
 60 |     );
 61 |     touch_file($touch_file);
 62 |     $self->test_comp(
 63 |         src    => '<& /ss/change_component.mc &>',
 64 |         expect => 'I have changed!',
 65 |     );
 66 | }
 67 | 
 68 | sub test_remove_no_ss : Tests {
 69 |     my $self = shift;
 70 |     $self->test_comp(
 71 |         src    => '<& /ss/remove_component.mc &>',
 72 |         expect => 'I will be removed.',
 73 |     );
 74 |     $self->remove_comp("/ss/remove_component.mc");
 75 |     $self->test_comp(
 76 |         src          => '<& /ss/remove_component.mc &>',
 77 |         expect_error => qr/could not find component/
 78 |     );
 79 | }
 80 | 
 81 | sub test_remove_and_touch_ss : Tests {
 82 |     my $self       = shift;
 83 |     my $touch_file = $self->temp_dir . "/purge.dat";
 84 |     $self->setup_interp( static_source => 1, static_source_touch_file => $touch_file );
 85 |     $self->test_comp(
 86 |         src    => '<& /ss/remove_component.mc &>',
 87 |         expect => 'I will be removed.',
 88 |     );
 89 |     $self->remove_comp("/ss/remove_component.mc");
 90 |     $self->test_comp(
 91 |         src    => '<& /ss/remove_component.mc &>',
 92 |         expect => 'I will be removed.',
 93 |     );
 94 |     touch_file($touch_file);
 95 |     $self->test_comp(
 96 |         src          => '<& /ss/remove_component.mc &>',
 97 |         expect_error => qr/could not find component/
 98 |     );
 99 | }
100 | 
101 | 1;
102 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Syntax.pm:
--------------------------------------------------------------------------------
  1 | package Mason::t::Syntax;
  2 | 
  3 | use Test::Class::Most parent => 'Mason::Test::Class';
  4 | 
  5 | sub test_replace : Tests {
  6 |     shift->test_comp(
  7 |         src => <<'EOF',
  8 | 
  9 | <% "Hello World!" %>
 10 | 
 11 | EOF
 12 |         expect => <<'EOF',
 13 | 
 14 | Hello World!
 15 | 
 16 | EOF
 17 |     );
 18 | }
 19 | 
 20 | sub test_percent : Tests {
 21 |     shift->test_comp(
 22 |         src => <<'EOF',
 23 | 
 24 | % my $message = "Hello World!";
 25 | <% $message %>
 26 | 
 27 | EOF
 28 |         expect => <<'EOF',
 29 | 
 30 | Hello World!
 31 | 
 32 | EOF
 33 |     );
 34 | }
 35 | 
 36 | sub test_fake_percent : Tests {
 37 |     shift->test_comp(
 38 |         src => <<'EOF',
 39 | some text, a %, and some text
 40 | EOF
 41 |         expect => <<'EOF',
 42 | some text, a %, and some text
 43 | EOF
 44 |     );
 45 | }
 46 | 
 47 | sub test_empty_percents : Tests {
 48 |     shift->test_comp(
 49 |         src => <<'EOF',
 50 | some text,
 51 | %
 52 | and some more
 53 | EOF
 54 |         expect => <<'EOF',
 55 | some text,
 56 | and some more
 57 | EOF
 58 |     );
 59 | }
 60 | 
 61 | sub test_empty_percents2 : Tests {
 62 |     shift->test_comp(
 63 |         src => <<'EOF',
 64 | some text,
 65 | %
 66 | % $m->print('foo, ');
 67 | % $m->print(undef);
 68 | and some more
 69 | EOF
 70 |         expect => <<'EOF',
 71 | some text,
 72 | foo, and some more
 73 | EOF
 74 |     );
 75 | }
 76 | 
 77 | # Deprecated syntax
 78 | #
 79 | sub test_double_percent : Tests {
 80 |     shift->test_comp(
 81 |         src => <<'EOF',
 82 | <%class>
 83 | my $i = 5;
 84 | 
 85 | 
 86 | %% my $j = 0;
 87 | %% if ($i == 5) {
 88 | %%   $j = $i+1;
 89 | %% }
 90 | <% $.bar %>
 91 | 
 92 | <%method bar>
 93 | j = <% $j %>
 94 | 
 95 | 
 96 | EOF
 97 |         expect => <<'EOF',
 98 | j = 6
 99 | EOF
100 |     );
101 | }
102 | 
103 | sub test_pure_perl : Tests {
104 |     shift->test_comp(
105 |         path   => '/pureperl.mp',
106 |         src    => 'sub main { print "hello from main" }',
107 |         expect => 'hello from main',
108 |     );
109 | }
110 | 
111 | # Deprecated syntax
112 | #
113 | sub test_args : Tests {
114 |     my $self = shift;
115 |     $self->add_comp(
116 |         path => '/args.mc',
117 |         src  => '
118 | <%args>
119 | a
120 | b # comment
121 | 
122 | # comment
123 |  c=>5
124 | d => 6
125 | e => "foo" # comment
126 | 
127 | f => (isa => "Num", default => 7)
128 | g => (isa => "Num", default => 8) # comment
129 | 
130 | 
131 | a = <% $.a %>
132 | b = <% $.b %>
133 | c = <% $.c %>
134 | d = <% $.d %>
135 | e = <% $.e %>
136 | f = <% $.f %>
137 | g = <% $.g %>
138 | ',
139 |     );
140 |     $self->test_comp(
141 |         src    => '<& /args.mc, a => 3, b => 4 &>',
142 |         expect => '
143 | a = 3
144 | b = 4
145 | c = 5
146 | d = 6
147 | e = foo
148 | f = 7
149 | g = 8
150 | '
151 |     );
152 | }
153 | 
154 | sub test_multiline_comment : Tests {
155 |     my $self = shift;
156 | 
157 |     $self->test_comp(
158 |         src => '
159 | hi<%
160 |     # comment
161 | 
162 |     # another comment
163 | 
164 | %>bye
165 | ',
166 |         expect => 'hibye',
167 |     );
168 | }
169 | 
170 | # Deprecated syntax
171 | #
172 | sub test_shared : Tests {
173 |     shift->test_parse(
174 |         src => '
175 | <%shared>
176 | $.foo  # a comment
177 |  $.bar => "something"
178 | $.baz => ( isa => "Num", default => 5 )
179 | # another comment
180 | 
181 | ',
182 |         expect => [
183 |             q/has 'foo' => (init_arg => undef/,
184 |             q/has 'bar' => (init_arg => undef, default => "something"/,
185 |             q/has 'baz' => (init_arg => undef,  isa => "Num", default => 5/
186 |         ],
187 |     );
188 | }
189 | 
190 | sub test_dollar_dot : Tests {
191 |     shift->test_comp(
192 |         src => '
193 | <%class>
194 | has "bar" => (default => 4);
195 | has "foo" => (default => 3);
196 | 
197 | 
198 | 
199 | <% $self->show %>
200 | 
201 | <%method show>
202 | foo = <% $.foo %>
203 | bar = <% $.bar %>
204 | 
205 | 
206 | <%init>
207 | $self->foo(5);
208 | $self->bar(6);
209 | 
210 | ',
211 |         expect => '
212 | foo = 5
213 | bar = 6
214 | '
215 |     );
216 | }
217 | 
218 | sub test_dollar_m : Tests {
219 |     my $self = shift;
220 |     $self->test_comp(
221 |         src => '
222 | <%class>
223 | method foo () { $m->print("foo\n") }
224 | 
225 | <%method bar><%perl>$m->print("bar\n");
226 | <% $.foo %>
227 | <% $.bar %>
228 | % $m->print("baz\n");
229 | ',
230 |         expect => '
231 | foo
232 | 
233 | bar
234 | 
235 | baz
236 | ',
237 |     );
238 | }
239 | 
240 | sub test_class_global : Tests {
241 |     my $self = shift;
242 | 
243 |     $self->test_comp(
244 |         src    => '<% ref($self) eq CLASS ? 1 : 0 %> <% ref($self) eq $CLASS ? 1 : 0 %>',
245 |         expect => qr/1 1/,
246 |     );
247 | }
248 | 
249 | 1;
250 | 


--------------------------------------------------------------------------------
/lib/Mason/t/Util.pm:
--------------------------------------------------------------------------------
 1 | package Mason::t::Util;
 2 | 
 3 | use Test::Class::Most parent => 'Mason::Test::Class';
 4 | use Mason::Util qw(combine_similar_paths);
 5 | 
 6 | sub test_combine_similar_paths : Tests {
 7 |     cmp_deeply( [ combine_similar_paths(qw(/foo/bar.m /foo/bar.pm /foo.m /foo.pm)) ],
 8 |         [ '/foo/bar.{m,pm}', '/foo.{m,pm}' ] );
 9 | }
10 | 
11 | 1;
12 | 


--------------------------------------------------------------------------------
/lib/Pod/Weaver/Section/SeeAlsoMason.pm:
--------------------------------------------------------------------------------
 1 | package Pod::Weaver::Section::SeeAlsoMason;
 2 | 
 3 | use Moose;
 4 | use Moose::Autobox;
 5 | with 'Pod::Weaver::Role::Section';
 6 | 
 7 | # Add "SEE ALSO: Mason"
 8 | 
 9 | sub weave_section {
10 |     my ( $self, $document, $input ) = @_;
11 | 
12 |     my $idc = $input->{pod_document}->children;
13 |     for ( my $i = 0 ; $i < $idc->length ; $i++ ) {
14 |         next unless my $para = $idc->[$i];
15 |         return
16 |           if $para->can('command') && $para->command eq 'head1' && $para->content eq 'SEE ALSO';
17 |     }
18 |     $document->children->push(
19 |         Pod::Elemental::Element::Nested->new(
20 |             {
21 |                 command  => 'head1',
22 |                 content  => 'SEE ALSO',
23 |                 children => [
24 |                     Pod::Elemental::Element::Pod5::Ordinary->new( { content => "L" } ),
25 |                 ],
26 |             }
27 |         ),
28 |     );
29 | }
30 | 
31 | __PACKAGE__->meta->make_immutable();
32 | 
33 | 1;
34 | 


--------------------------------------------------------------------------------
/perlcriticrc:
--------------------------------------------------------------------------------
1 | only = 1
2 | severity = 1
3 | verbose = %m at %f line %l [%p]\n
4 | 
5 | [Moose::RequireMakeImmutable]
6 | [TestingAndDebugging::RequireUseStrict]
7 | equivalent_modules = Test::Class::Most Mason::Moose Mason::PluginRole
8 | [Variables::ProhibitConditionalDeclarations]
9 | 


--------------------------------------------------------------------------------
/t/Autobase.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Autobase;
3 | Mason::t::Autobase->runtests;
4 | 


--------------------------------------------------------------------------------
/t/CompCalls.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::CompCalls;
3 | Mason::t::CompCalls->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Compilation.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Compilation;
3 | Mason::t::Compilation->runtests;
4 | 


--------------------------------------------------------------------------------
/t/ComponentMeta.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::ComponentMeta;
3 | Mason::t::ComponentMeta->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Defer.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Defer;
3 | Mason::t::Defer->runtests;
4 | 


--------------------------------------------------------------------------------
/t/DollarDot.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::DollarDot;
3 | Mason::t::DollarDot->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Errors.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Errors;
3 | Mason::t::Errors->runtests();
4 | 


--------------------------------------------------------------------------------
/t/Filters.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Filters;
3 | Mason::t::Filters->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Globals.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Globals;
3 | Mason::t::Globals->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Interp.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Interp;
3 | Mason::t::Interp->runtests();
4 | 


--------------------------------------------------------------------------------
/t/LvalueAttributes.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::LvalueAttributes;
3 | Mason::t::LvalueAttributes->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Plugins.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Plugins;
3 | Mason::t::Plugins->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Reload.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Reload;
3 | Mason::t::Reload->runtests();
4 | 


--------------------------------------------------------------------------------
/t/Request.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Request;
3 | Mason::t::Request->runtests;
4 | 


--------------------------------------------------------------------------------
/t/ResolveURI.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::ResolveURI;
3 | Mason::t::ResolveURI->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Sanity.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Sanity;
3 | Mason::t::Sanity->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Sections.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Sections;
3 | Mason::t::Sections->runtests();
4 | 


--------------------------------------------------------------------------------
/t/StaticSource.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::StaticSource;
3 | Mason::t::StaticSource->runtests;
4 | 


--------------------------------------------------------------------------------
/t/Syntax.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Syntax;
3 | Mason::t::Syntax->runtests();
4 | 


--------------------------------------------------------------------------------
/t/Util.t:
--------------------------------------------------------------------------------
1 | #!perl -w
2 | use Mason::t::Util;
3 | Mason::t::Util->runtests;
4 | 


--------------------------------------------------------------------------------
/t/make:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/perl
 2 | use Cwd qw(realpath);
 3 | use File::Basename;
 4 | use File::Slurp;
 5 | use IPC::System::Simple qw(run);
 6 | use warnings;
 7 | use strict;
 8 | 
 9 | my $cwd = dirname( realpath($0) );
10 | 
11 | my $class = shift(@ARGV) or die "usage: $0 MyClass";
12 | $class =~ s/\.(t|pm)$//;
13 | my $filename = "$cwd/$class.t";
14 | my $source = sprintf( "#!perl -w\nuse Mason::t::%s;\nMason::t::%s->runtests;\n", $class, $class );
15 | write_file( $filename, $source );
16 | run("git add $filename");
17 | print "$filename:\n$source\n";
18 | 


--------------------------------------------------------------------------------
/t/mason-app.t:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/perl
 2 | use File::Temp qw(tempdir);
 3 | use Mason::Util qw(write_file);
 4 | use Test::More tests => 3;
 5 | use warnings;
 6 | use strict;
 7 | 
 8 | my $tempdir = tempdir( 'mason-app-XXXX', TMPDIR => 1, CLEANUP => 1 );
 9 | my $comp_file = "$tempdir/hello.mc";
10 | write_file( $comp_file, "%% has 'd';\nd * 2 = <% \$.d * 2 %>" );
11 | 
12 | # Ugly string escaping for Windows
13 | my $output = `$^X bin/mason.pl $comp_file --data-dir $tempdir/data --args "{\\"d\\":\\"4\\"}"`;
14 | is( $output, "d * 2 = 8\n", 'correct output' );
15 | ok( -f "$tempdir/data/obj/hello.mc.mobj", "object file exists" );
16 | $output = `$^X bin/mason.pl -e "<% 3+3 %>"`;
17 | is( $output, "6\n", 'correct output' );
18 | 


--------------------------------------------------------------------------------
/tidyall.ini:
--------------------------------------------------------------------------------
 1 | [PerlTidy]
 2 | argv = -noll -blbp=0 -l=100
 3 | select = {bin,lib,t}/**/*.{pl,pm,t}
 4 | 
 5 | [PodTidy]
 6 | select = {bin,lib}/**/*.{pl,pm,pod}
 7 | 
 8 | [PerlCritic]
 9 | select = {bin,lib}/**/*.{pl,pm}
10 | argv = --profile $ROOT/perlcriticrc
11 | except_modes = editor
12 | 
13 | [Perl::IgnoreMethodSignaturesSimple]
14 | select = {bin,lib,t}/**/*.{pl,pm,t}
15 | 
16 | [Perl::AlignMooseAttributes]
17 | select = {bin,lib,t}/**/*.{pl,pm,t}
18 | 


--------------------------------------------------------------------------------
/weaver.ini:
--------------------------------------------------------------------------------
1 | [@CorePrep]
2 | [Generic / NAME]
3 | [Generic / SYNOPSIS]
4 | [Generic / DESCRIPTION]
5 | [Leftovers]
6 | [SeeAlsoMason]
7 | [Authors]
8 | [Legal]
9 | 


--------------------------------------------------------------------------------
/xt/author/leaks.t:
--------------------------------------------------------------------------------
 1 | #!perl -w
 2 | use Devel::LeakGuard::Object qw(leakguard);
 3 | use File::Path qw(mkpath);
 4 | use File::Temp qw(tempdir);
 5 | use Test::Most;
 6 | use Mason::Util qw(write_file);
 7 | use Mason;
 8 | 
 9 | sub testleaks {
10 |     my $code = shift;
11 |     my $report;
12 |     $code->();
13 |     leakguard(
14 |         sub { $code->() },
15 |         only    => 'Mason*',
16 |         on_leak => sub { $report = shift; }
17 |     );
18 |     if ($report) {
19 |         my $desc = join("\n", map { sprintf("%s %d %d", $_, @{ $report->{$_} }) } keys(%$report));
20 |         ok( 0, "leaks found:\n$desc" );
21 |     }
22 |     else {
23 |         ok( 1, "no leaks found" );
24 |     }
25 | }
26 | 
27 | my $root = tempdir('name-XXXX', TMPDIR => 1, CLEANUP => 1);
28 | my $comp_root = "$root/comps";
29 | my $data_dir = "$root/data";
30 | mkpath( [ $comp_root, $data_dir ], 0, 0775 );
31 | 
32 | testleaks(
33 |     sub {
34 |         my $interp = Mason->new( comp_root => $comp_root, data_dir => $data_dir );
35 |         foreach my $comp (qw(foo bar)) {
36 |             write_file("$comp_root/$comp.mc", "Hi");
37 |             $interp->run("/$comp");
38 |         }
39 |     }
40 | );
41 | 
42 | done_testing();
43 | 


--------------------------------------------------------------------------------