├── .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 | 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 | --------------------------------------------------------------------------------