Template-Declare-0.47/0000755000175000017500000000000012444203000013551 5ustar chmrrchmrrTemplate-Declare-0.47/Changes0000644000175000017500000001211512444202543015057 0ustar chmrrchmrr0.47 2014-12-16 - Stop checking warning message contents explictly (Aaron Crane) 0.46 2012-12-23 - Documentation fixes (Brigham Johnson) - Hash ordering fixes for 5.17 (Kent Fredric) 0.45 2011-04-15 - Added new HTML 5 elements to the HTML Tag set. (Theory) 0.44 2010-12-08 - Added support for $TAG_INDENTATION and $EOL (Marc Chantreux) - Add a current_base_path() convenience function (trs) 0.43 2009-11-18 - Test warning fixes (Theory) - Dist fixes suggested by rafl (Sartak) 0.42 2009-11-01 - Added the "strict" attribute to make exceptional situations fatal. (Theory) - Removed unused "implementor" attribute in Template::Declare::TagSet. (Theory) 0.41 2009-10-29 - Documentation tweaks (Theory) 0.40_02 2009-10-23 - David (Theory) Wheeler spent considerable effort on cleaning up Template-Declare for this release. - Reworked all the documentation, neatening things, expanding the "USAGE" section, fixing bugs in the examples, and adding missing docs for various functions and methods. - Added "dispatch_to" to replace "roots", which is now deprecated. Note that "dispatch_to" resolves to template classes in the opposite order to "roots". This won't be an issue if you only use a single temlate class. - Converted the implementation of "alias" to be the same as that used for "import_templates", which is much more efficient. - Added the "into" parameter to "alias" and "import_templates". - Added the "setting" syntactical sugar keyword for use with "alias". - Renamed "import_templates" to "mix". The former is still around, but is deprecated. - Added support for package variables with "mix". - Deprecated the undocumented "aliases()" and "alias_metadata()" methods, as they are no longer needed. They're now no-ops that issue warnings. To be removed altogether in a future version. 0.40_01 2009-08-12 - Support for inline tagset definitions. Thanks to Olivier 'dolmen' Mengué [rt.cpan.org #48642] 0.40 2009-07-08 - Fix subname issue with the debugger and specifically Devel::NYTProf - String::BufferStack usage improvements 0.39 2009-03-05 - No code changes; increase Test::Warn dependency to 0.11, as 0.10 was broken 0.38 2009-02-27 - Support, but deprecate, Template::Declare->buffer->data(...) usage 0.37 2009-02-19 - Make HTML::Lint an optional dependency 0.36 2009-02-05 - Hint to the source of the buffer using a 'from' argument. This allows us to inspect the call stack by looking at the buffer stack. 0.35 2009-01-20 - Buffers have been moved to using String::BufferStack, for better interopability with other templating systems. Code which manipulated Template::Declare::Buffer objects by hand may need to be adjusted. 0.31_01 2008-12-19 - INCOMPATIBLE: there were inconsistency in arguments passing. show in TD::Tags could pass arguments into template as array reference depending on a way it's called. Now arguments are always passwed the same way they passed into show. This change is only backwards incompatible for those who were using this incorrect behaviour. - stringify argument in TD::Buffer::append as we can deal with an object with overloaded stringification that puts data into buffer when stringified - correctly escape objects with overloaded stringification - use less buffers for operations and a few other small optimizations 0.30 2008-11-26 - Remove the "wrapper" export, its name is too generic and clashes with a lot of existing code. It's a negligible amount of sugar. 0.29 2008-07-01 - Sugar for defining a tag-like wrapper. Thanks Theory! #37624 - Don't load all of CGI.pm to get a list of tags. #37630 - Don't add attrs to the first tag in smart_tag_wrapper. #37622. 0.28 2008-02-14 - Added the missing dependency Class::ISA to Makefile.PL - Added the "canvas" tag to the HTML tagset. - Added around_template for instrumentation. 0.27 2007-11-02 - Added support for the RDF tag set (T::D::TagSet::RDF). - Added support for the Mozilla EM RDF tag set (T::D::TagSet::RDF::EM) 0.26 2007-08-14 - Refactored Template::Declare::Tags to make the tag sets configurable. - Added Template::Declare::TagSet::HTML and Template::Declare::TagSet::XUL, respectively, as well as their common base class, Template::Declare::TagSet. Added Template::Declare::TagSet::HTML and Template::Declare::TagSet::XUL, respectively. - Added support for XML namespace: use Template::Declare::Tags 'XUL', 'HTML' => { namespace => 'html' }; and ... 'HTML' => { namespace => 'html', package => 'MyHtml' }; - And we can now say 'use Template::Declare::Tags qw/ HTML XUL /; - Added @Template::Declare::Tags::TAG_SUB_LIST which records all the tag subroutines generated on-the-fly, which is necessary for secondary symbol exporting in Jifty::View::Declare::Helpers. - Implemented C< use Template::Declare::Tags HTML => { from => 'My::HTML::TagSet' } >. - Allow content post-proceessing with a callback. - Added a PITFALLS section to T::D's POD. - Added a global sub append_attr to provide friendly diagnostics and the infamous "Undefined subroutine &Template::Declare::Tags::append_attr called at ..." is now gone. Template-Declare-0.47/META.yml0000644000175000017500000000126312444202632015036 0ustar chmrrchmrr--- abstract: 'Perlish declarative templates' author: - 'Jesse Vincent ' build_requires: ExtUtils::MakeMaker: 6.59 Test::More: 0 Test::Warn: 0.11 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.12' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Template-Declare no_index: directory: - inc - t requires: Class::Accessor::Fast: 0 Class::Data::Inheritable: 0 Class::ISA: 0 HTML::Lint: 0 String::BufferStack: 1.1 perl: 5.8.2 resources: license: http://dev.perl.org/licenses/ version: '0.47' Template-Declare-0.47/README0000644000175000017500000013414412442630701014452 0ustar chmrrchmrrNAME Template::Declare - Perlish declarative templates SYNOPSIS Here's an example of basic HTML usage: package MyApp::Templates; use Template::Declare::Tags; # defaults to 'HTML' use base 'Template::Declare'; template simple => sub { html { head {} body { p { 'Hello, world wide web!' } } } }; package main; use Template::Declare; Template::Declare->init( dispatch_to => ['MyApp::Templates'] ); print Template::Declare->show( 'simple' ); And here's the output:

Hello, world wide web!

DESCRIPTION "Template::Declare" is a pure-Perl declarative HTML/XUL/RDF/XML templating system. Yes. Another one. There are many others like it, but this one is ours. A few key features and buzzwords: * All templates are 100% pure Perl code * Simple declarative syntax * No angle brackets * "Native" XML namespace and declaration support * Mixins * Inheritance * Delegation * Public and private templates GLOSSARY template class A subclass of Template::Declare in which one or more templates are defined using the "template" keyword, or that inherits templates from a super class. template Created with the "template" keyword, a template is a subroutine that uses "tags" to generate output. attribute An XML element attribute. For example, in "", "src" is an attribute of the "img" element. tag A subroutine that generates XML element-style output. Tag subroutines execute blocks that generate the output, and can call other tags to generate a properly hierarchical structure. tag set A collection of related tags defined in a subclass of Template::Declare::TagSet for a particular purpose, and which can be imported into a template class. For example, Template::Declare::TagSet::HTML defines tags for emitting HTML elements. wrapper A subroutine that wraps the output from a template. Useful for wrapping template output in common headers and footers, for example. dispatch class A template class that has been passed to "init()" via the "dispatch_to" parameter. When show is called, only templates defined in or mixed into the dispatch classes will be executed. path The name specified for a template when it is created by the "template" keyword, or when a template is mixed into a template class. mixin A template mixed into a template class via "mix". Mixed-in templates may be mixed in under prefix paths to distinguish them from the templates defined in the dispatch classes. alias A template aliased into a template class via "alias". Aliased templates may be added under prefix paths to distinguish them from the templates defined in the dispatch classes. package variable Variables defined when mixing templates into a template class. These variables are available only to the mixed-in templates; they are not even accessible from the template class in which the templates were defined. helper A subroutine used in templates to assist in the generation of output, or in template classes to assist in the mixing-in of templates. Output helpers include "outs()" for rending text output and "xml_decl()" for rendering XML declarations. Mixin helpers include "into" for specifying a template class to mix into, and "under" for specifying a path prefix under which to mix templates. USAGE Like other Perl templating systems, there are two parts to Template::Declare: the templates and the code that loads and executes the templates. Unlike other template systems, the templates are written in Perl classes. A simple HTML example is in the "SYNOPSIS". A slightly more advanced example In this example, we'll show off how to set attributes on HTML tags, how to call other templates, and how to declare a *private* template that can't be called directly. We'll also show passing arguments to templates. First, the template class: package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags; private template 'util/header' => sub { head { title { 'This is a webpage' }; meta { attr { generator => "This is not your father's frontpage" } } } }; private template 'util/footer' => sub { my $self = shift; my $time = shift || gmtime; div { attr { id => "footer"}; "Page last generated at $time." } }; template simple => sub { my $self = shift; my $user = shift || 'world wide web'; html { show('util/header'); body { img { src is 'hello.jpg' } p { attr { class => 'greeting'}; "Hello, $user!" }; }; show('util/footer', 'noon'); } }; A few notes on this example: * Since no parameter was passed to "use Template::Declare::Tags", the HTML tags are imported by default. * The "private" keyword indicates that a template is private. That means that it can only be executed by other templates within the template class in which it's declared. By default, "Template::Declare->show" will not dispatch to it. * The two private templates have longer paths than we've seen before: "util/header" and "util/footer". They must of course be called by their full path names. You can put any characters you like into template names, but the use of Unix filesystem-style paths is the most common (following on the example of HTML::Mason). * The first argument to a template is a class name. This can be useful for calling methods defined in the class. * The "show" sub executes another template. In this example, the "simple" template calls "show('util/header')" and "show('util/footer')" in order to execute those private templates in the appropriate places. * Additional arguments to "show" are passed on to the template being executed. here, "show('util/footer', 'noon')" is passing "noon" to the "util/footer" template, with the result that the "last generated at" string will display "noon" instead of the default "gmtime". * In the same way, note that the "simple" template expects an additional argument, a user name. * In addition to using "attr" to declare attributes for an element, you can use "is", as in img { src is 'hello.jpg' } Now for executing the template: package main; use Template::Declare; Template::Declare->init( dispatch_to => ['MyApp::Templates'] ); print Template::Declare->show( '/simple', 'TD user'); We've told Template::Declare to dispatch to templates defined in our template class. And note how an additional argument is passed to "show()"; that argument, "TD user", will be passed to the "simple" template, where it will be used in the $user variable. The output looks like this: This is a webpage

Hello, TD user!

Note that the single quote in "father's" was quoted for you. We sanitize your output for you to help prevent cross-site scripting attacks. XUL Template::Declare isn't limited to just HTML. Let's do XUL! package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags 'XUL'; template main => sub { xml_decl { 'xml', version => '1.0' }; xml_decl { 'xml-stylesheet', href => "chrome://global/skin/", type => "text/css" }; groupbox { caption { attr { label => 'Colors' } } radiogroup { for my $id ( qw< orange violet yellow > ) { radio { attr { id => $id, label => ucfirst($id), $id eq 'violet' ? (selected => 'true') : () } } } # for } } }; The first thing to do in a template class is to subclass Template::Declare itself. This is required so that Template::Declare always knows that it's dealing with templates. The second thing is to "use Template::Declare::Tags" to import the set of tag subroutines you need to generate the output you want. In this case, we've imported tags to support the creation of XUL. Other tag sets include HTML (the default), and RDF. Templates are created using the "template" keyword: template main => sub { ... }; The first argument is the name of the template, also known as its *path*. In this case, the template's path is "main" (or "/main", both are allowed (to keep both PHP and HTML::Mason fans happy). The second argument is an anonymous subroutine that uses the tag subs (and any other necessary code) to generate the output for the template. The tag subs imported into your class take blocks as arguments, while a number of helper subs take other arguments. For example, the "xml_decl" helper takes as its first argument the name of the XML declaration to be output, and then a hash of the attributes of that declaration: xml_decl { 'xml', version => '1.0' }; Tag subs are used by simply passing a block to them that generates the output. Said block may of course execute other tag subs in order to represent the hierarchy required in your output. Here, the "radiogroup" tag calls the "radio" tag for each of three different colors: radiogroup { for my $id ( qw< orange violet yellow > ) { radio { attr { id => $id, label => ucfirst($id), $id eq 'violet' ? (selected => 'true') : () } } } # for } Note the "attr" sub. This helper function is used to add attributes to the element created by the tag in which they appear. In the previous example, the the "id", "label", and "selected" attributes are added to each "radio" output. Once you've written your templates, you'll want to execute them. You do so by telling Template::Declare what template classes to dispatch to and then asking it to show you the output from a template: package main; Template::Declare->init( dispatch_to => ['MyApp::Templates'] ); print Template::Declare->show( 'main' ); The path passed to "show" can be either "main" or , as you prefer. In either event, the output would look like this: Postprocessing Sometimes you just want simple syntax for inline elements. The following shows how to use a postprocessor to emphasize text _like this_. package MyApp::Templates; use Template::Declare::Tags; use base 'Template::Declare'; template before => sub { h1 { outs "Welcome to "; em { "my" }; outs " site. It's "; em { "great" }; outs "!"; }; }; template after => sub { h1 { "Welcome to _my_ site. It's _great_!" }; h2 { outs_raw "This is _not_ emphasized." }; img { src is '/foo/_bar_baz.png' }; }; Here we've defined two templates in our template class, with the paths "before" and "after". The one new thing to note is the use of the "outs" and "outs_raw" subs. "outs" XML-encodes its argument and outputs it. You can also just specify a string to be output within a tag call, but if you need to mix tags and plain text within a tag call, as in the "before" template here, you'll need to use "outs" to get things to output as you would expect. "outs_raw" is the same, except that it does no XML encoding. Now let's have a look at how we use these templates with a post-processor: package main; use Template::Declare; Template::Declare->init( dispatch_to => ['MyApp::Templates'], postprocessor => \&emphasize, strict => 1, ); print Template::Declare->show( 'before' ); print Template::Declare->show( 'after' ); sub emphasize { my $text = shift; $text =~ s{_(.+?)_}{$1}g; return $text; } As usual, we've told Template::Declare to dispatch to our template class. A new parameter to "init()" is "postprocessor", which is a code reference that should expect the template output as an argument. It can then transform that text however it sees fit before returning it for final output. In this example, the "emphasize" subroutine looks for text that's emphasized using _underscores_ and turns them into "emphasis" HTML elements. We then execute both the "before" and the "after" templates with the output ending up as:

Welcome to my site. It's great!

Welcome to my site. It's great!

This is _not_ emphasized.

The thing to note here is that text passed to "outs_raw" is not passed through the postprocessor, and neither are attribute values (like the "img"'s "src"). Inheritance Templates are really just methods. You can subclass your template packages to override some of those methods: package MyApp::Templates::GenericItem; use Template::Declare::Tags; use base 'Template::Declare'; template 'list' => sub { my ($self, @items) = @_; div { show('item', $_) for @items; } }; template 'item' => sub { my ($self, $item) = @_; span { $item } }; package MyApp::Templates::BlogPost; use Template::Declare::Tags; use base 'MyApp::Templates::GenericItem'; template 'item' => sub { my ($self, $post) = @_; h1 { $post->title } div { $post->body } }; Here we have two template classes; the second, "MyApp::Templates::BlogPost", inherits from the first, "MyApp::Templates::GeniricItem". Note also that "MyApp::Templates::BlogPost" overrides the "item" template. So execute these templates: package main; use Template::Declare; Template::Declare->init( dispatch_to => ['MyApp::Templates::GenericItem'] ); print Template::Declare->show( 'list', 'foo', 'bar', 'baz' ); Template::Declare->init( dispatch_to => ['MyApp::Templates::BlogPost'] ); my $post = My::Post->new(title => 'Hello', body => 'first post'); print Template::Declare->show( 'item', $post ); First we execute the "list" template in the base class, passing in some items, and then we re-"init()" Template::Declare and execute *its* "list" template with an appropriate argument. Here's the output:
foo bar baz

Hello

first post
So the override of the "list" template in the subclass works as expected. For another example, see Jifty::View::Declare::CRUD. Wrappers There are two levels of wrappers in Template::Declare: template wrappers and smart tag wrappers. Template Wrappers "create_wrapper" declares a wrapper subroutine that can be called like a tag sub, but can optionally take arguments to be passed to the wrapper sub. For example, if you wanted to wrap all of the output of a template in the usual HTML headers and footers, you can do something like this: package MyApp::Templates; use Template::Declare::Tags; use base 'Template::Declare'; BEGIN { create_wrapper wrap => sub { my $code = shift; my %params = @_; html { head { title { outs "Hello, $params{user}!"} }; body { $code->(); div { outs 'This is the end, my friend' }; }; } }; } template inner => sub { wrap { h1 { outs "Hello, Jesse, s'up?" }; } user => 'Jesse'; }; Note how the "wrap" wrapper function is available for calling after it has been declared in a "BEGIN" block. Also note how you can pass arguments to the function after the closing brace (you don't need a comma there!). The output from the "inner" template will look something like this: Hello, Jesse!

Hello, Jesse, s'up?

This is the end, my friend
Tag Wrappers Tag wrappers are similar to template wrappers, but mainly function as syntax sugar for creating subroutines that behave just like tags but are allowed to contain arbitrary Perl code and to dispatch to other tag. To create one, simply create a named subroutine with the prototype "(&)" so that its interface is the same as tags. Within it, use "smart_tag_wrapper" to do the actual execution, like so: package My::Template; use Template::Declare::Tags; use base 'Template::Declare'; sub myform (&) { my $code = shift; smart_tag_wrapper { my %params = @_; # set using 'with' form { attr { %{ $params{attr} } }; $code->(); input { attr { type => 'submit', value => $params{value} } }; }; }; } template edit_prefs => sub { with( attr => { id => 'edit_prefs', action => 'edit.html' }, value => 'Save' ), myform { label { 'Time Zone' }; input { type is 'text'; name is 'tz' }; }; }; Note in the "edit_prefs" template that we've used "with" to set up parameters to be passed to the smart wrapper. "smart_tag_wrapper()" is the device that allows you to receive those parameters, and also handles the magic of making sure that the tags you execute within it are properly output. Here we've used "myform" similarly to "form", only "myform" does something different with the "with()" arguments and outputs a submit element. Executing this template: Template::Declare->init( dispatch_to => ['My::Template'] ); print Template::Declare->show('edit_prefs'); Yields this output:
Class Search Dispatching The classes passed via the "dispatch_to" parameter to "init()" specify all of the templates that can be executed by subsequent calls to "show()". Template searches through these classes in order to find those templates. Thus it can be useful, when you're creating your template classes and determining which to use for particular class to "show()", to have templates that override other templates. This is similar to how an operating system will search all the paths in the $PATH environment variable for a program to run, and to HTML::Mason component roots or Template::Toolkit's "INCLUDE_PATH" parameter. For example, say you have this template class that defines a template that you'll use for displaying images on your Web site. package MyApp::UI::Standard; use Template::Declare::Tags; use base 'Template::Declare'; template image => sub { my ($self, $src, $title) = @_; img { src is $src; title is $title; }; }; As usual, you can use it like so: my @template_classes = 'MyApp::UI::Standard'; Template::Declare->init( dispatch_to => \@template_classes ); print Template::Declare->show('image', 'foo.png', 'Foo'); We're explicitly using a reference to @template_classes so that we can manage this list ourselves. The output of this will be:

But say that in some sections of your site you need to have a more formal treatment of your photos. Maybe you publish photos from a wire service and need to provide an appropriate credit. You might write the template class like so: package MyApp::UI::Formal; use Template::Declare::Tags; use base 'Template::Declare'; template image => sub { my ($self, $src, $title, $credit, $caption) = @_; div { class is 'formal'; img { src is $src; title is $title; }; p { class is 'credit'; outs "Photo by $credit"; }; p { class is 'caption'; outs $caption; }; }; }; This, too, will work as expected, but the useful bit that comes in when you're mixing and matching template classes to pass to "dispatch_to" before rendering a page. Maybe you always pass have MyApp::UI::Standard to "dispatch_to" because it has all of your standard formatting templates. But when the code realizes that a particular page needs the more formal treatment, you can prepend the formal class to the list: unshift @template_classes, 'MyApp::UI::Formal'; print Template::Declare->show( 'image', 'ap.png', 'AP Photo', 'Clark Kent', 'Big news' ); shift @template_classes; In this way, made the formal "image" template will be found first, yielding this output:

Photo by Clark Kent

Big news

At the end, we've shifted the formal template class off the "dispatch_to" list in order to restore the template classes the default configuration, ready for the next request. Template Composition There are two methods of template composition: mixins and delegation. Their interfaces are very similar, the only difference being the template invocant. Mixins Let's start with a mixin. package MyApp::UtilTemplates; use Template::Declare::Tags; use base 'Template::Declare'; template content => sub { my $self = shift; my @paras = @_; h1 { $self->get_title }; div { id is 'content'; p { $_ } for @paras; }; }; package MyApp::Templates; use Template::Declare::Tags; use base 'Template::Declare'; mix MyApp::UtilTemplates under '/util'; sub get_title { 'Kashmir' } template story => sub { my $self = shift; html { head { title { "My Site: " . $self->get_title }; }; body { show( 'util/content' => 'first paragraph', 'second paragraph' ); }; }; }; The first template class, "MyApp::UtilTemplates", defines a utility template, called "content", for outputting the contents of page. Note its call to "$self->get_title" even though it doesn't have a "get_title" method. This is part of the mixin's "contract": it requires that the class it's mixed into have a "get_title()" method. The second template class, "MyApp::Templates", mixes "MyApp::UtilTemplates" into itself under the path "/util" and defines a "get_title()" method as required by the mixin. Then, its "story" template calls the mixed-in template as "util/content", because the "content" template was mixed into the current template under "/util". Get it? Now we can use the usual template invocation: package main; Template::Declare->init( dispatch_to => ['MyApp::Templates'] ); print Template::Declare->show('story'); To appreciate our output: My Site: Kashmir

Kashmir

fist paragraph

second paragraph

Mixins are a very useful tool for template authors to add reusable functionality to their template classes. But it's important to pay attention to the mixin contracts so that you're sure to implement the required API in your template class (here, the "get_title()" method). Aliases Aliases are very similar to mixins, but implement delegation as a composition pattern, rather than mixins. The upshot is that there is no contract provided by an aliased class: it just works. This is because the invocant is the class from which the aliases are imported, and therefore it will dispatch to methods defined in the aliased class. For example, say that you wanted to output a sidebar on pages that need one (perhaps your CMS has sidebar things). We can define a template class that has a template for that: package MyApp::UI::Stuff; use Template::Declare::Tags; use base 'Template::Declare'; sub img_path { '/ui/css' } template sidebar => sub { my ($self, $thing) = @_; div { class is 'sidebar'; img { src is $self->img_path . '/sidebar.png' }; p { $_->content } for $thing->get_things; }; }; Note the use of the "img_path()" method defined in the template class and used by the "sidebar" template. Now let's use it: package MyApp::Render; use Template::Declare::Tags; use base 'Template::Declare'; alias MyApp::UI::Stuff under '/stuff'; template page => sub { my ($self, $page) = @_; h1 { $page->title }; for my $thing ($page->get_things) { if ($thing->is('paragraph')) { p { $thing->content }; } elsif ($thing->is('sidebar')) { show( '/stuff/sidebar' => $thing ); } } }; Here our rendering template class has aliased "MyApp::UI::Stuff" under "/stuff". So the "page" template calls "show('/stuff/sidebar')" to invoke the sidebar template. If we run this: Template::Declare->init( dispatch_to => ['MyApp::Render'] ); print Template::Declare->show( page => $page ); We get output as you might expect:

My page title

Page paragraph

Sidebar paragraph

Another paragraph

Now, let's say that you have political stuff that you want to use a different image for in the sidebar. If that's the only difference, we can subclass "MyApp::UI::Stuff" and just override the "img_path()" method: package MyApp::UI::Stuff::Politics; use Template::Declare::Tags; use base 'MyApp::UI::Stuff'; sub img_path { '/politics/ui/css' } Now let's mix that into a politics template class: package MyApp::Render::Politics; use Template::Declare::Tags; use base 'Template::Declare'; alias MyApp::UI::Stuff::Politics under '/politics'; template page => sub { my ($self, $page) = @_; h1 { $page->title }; for my $thing ($page->get_things) { if ($thing->is('paragraph')) { p { $thing->content }; } elsif ($thing->is('sidebar')) { show( '/politics/sidebar' => $thing ); } } }; The only difference between this template class and "MyApp::Render" is that it aliases "MyApp::UI::Stuff::Politics" under "/politics", and then calls "show('/politics/sidebar')" in the "page" template. Running this template: Template::Declare->init( dispatch_to => ['MyApp::Render::Politics'] ); print Template::Declare->show( page => $page ); Yields output using the value of the subclass's "img_path()" method -- that is, the sidebar image is now /politics/ui/css/sidebar.png instead of /ui/css/sidebar.png:

My page title

Page paragraph

Sidebar paragraph

Another paragraph

Other Tricks The delegation behavior of "alias" actually makes it a decent choice for template authors to mix and match libraries of template classes as appropriate, without worrying about side effects. You can even alias templates in one template class into another template class if you're not the author of that class by using the "into" keyword: alias My::UI::Widgets into Your::UI::View under '/widgets'; Now the templates defined in "Your::UI::View" are available in "My::UI::Widgets" under "/widgets". The "mix" method supports this syntax as well, though it's not necessarily recommended, given that you would not be able to fulfill any contracts unless you re-opened the class into which you mixed the templates. But in any case, authors of framework view classes might find this functionality useful for automatically aliasing template classes into a single dispatch template class. Another trick is to alias or mix your templates with package variables specific to the composition. Do so via the "setting" keyword: package My::Templates; mix Some::Mixin under '/mymix', setting { name => 'Larry' }; The templates mixed from "Some::Mixin" into "My::Templates" have package variables set for them that are accessible *only* from their mixed-in paths. For example, if this template was defined in "Some::Mixin": template howdy => sub { my $self = shift; outs "Howdy, " . $self->package_variable('name') || 'Jesse'; }; Then "show('mymix/howdy')" called on "My::Templates" will output "Howdy, Larry", while the output from "show('howdy')" will output "Howdy, Jesse". In other words, package variables defined for the mixed-in templates are available only to the mixins and not to the original. The same functionality exists for "alias" as well. Indentation configuration by default, Template::Declare renders a readable XML adding end of lines and a one column indentation. This behavior could break a webpage design or add a significant amount of chars to your XML output. This could be changed by overwriting the default values. so $Template::Declare::Tags::TAG_INDENTATION = 0; $Template::Declare::Tags::EOL = ""; say Template::Declare->show('main'); will render

hi

METHODS init This *class method* initializes the "Template::Declare" system. dispatch_to An array reference of classes to search for templates. Template::Declare will search this list of classes in order to find a template path. roots Deprecated. Just like "dispatch_to", only the classes are searched in reverse order. Maintained for backward compatibility and for the pleasure of those who want to continue using Template::Declare the way that Jesse's "crack-addled brain" intended. postprocessor A coderef called to postprocess the HTML or XML output of your templates. This is to alleviate using Tags for simple text markup. around_template A coderef called instead of rendering each template. The coderef will receive three arguments: a coderef to invoke to render the template, the template's path, an arrayref of the arguments to the template, and the coderef of the template itself. You can use this for instrumentation. For example: Template::Declare->init(around_template => sub { my ($orig, $path, $args, $code) = @_; my $start = time; $orig->(); warn "Rendering $path took " . (time - $start) . " seconds."; }); strict Die in exceptional situations, such as when a template can't be found, rather than just warn. False by default for backward compatibility. The default may be changed in the future, so specifying the value explicitly is recommended. show TEMPLATE_NAME Template::Declare->show( 'howdy', name => 'Larry' ); my $output = Template::Declare->show('index'); Call "show" with a "template_name" and "Template::Declare" will render that template. Subsequent arguments will be passed to the template. Content generated by "show()" can be accessed via the "output()" method if the output method you've chosen returns content instead of outputting it directly. If called in scalar context, this method will also just return the content when available. Template Composition Sometimes you want to mix templates from one class into another class, or delegate template execution to a class of templates. "alias()" and "mix()" are your keys to doing so. mix mix Some::Clever::Mixin under '/mixin'; mix Some::Other::Mixin under '/otmix', setting { name => 'Larry' }; mix My::Mixin into My::View, under '/mymix'; Mixes templates from one template class into another class. When the mixed-in template is called, its invocant will be the class into which it was mixed. This type of composition is known as a "mixin" in object-oriented parlance. See Template Composition for extended examples and a comparison to "alias". The first parameter is the name of the template class to be mixed in. The "under" keyword tells "mix" where to put the templates. For example, a "foo" template in "Some::Clever::Mixin" will be mixed in as "mymixin/foo". The "setting" keyword specifies package variables available only to the mixed-in copies of templates. These are available to the templates as "$self->package_variable($varname)". The "into" keyword tells "mix" into what class to mix the templates. Without this keyword, "mix" will mix them into the calling class. For those who prefer a direct OO syntax for mixins, just call "mix()" as a method on the class to be mixed in. To replicate the above three examples without the use of the sugar: Some::Clever::Mixin->mix( '/mixin' ); Some::Other::Mixin->mix( '/otmix', { name => 'Larry' } ); My::Mixin->mix( 'My::View', '/mymix' ); alias alias Some::Clever:Templates under '/delegate'; alias Some::Other::Templates under '/send_to', { name => 'Larry' }; alias UI::Stuff into My::View, under '/mystuff'; Aliases templates from one template class into another class. When an alias called, its invocant will be the class from which it was aliased. This type of composition is known as "delegation" in object-oriented parlance. See Template Composition for extended examples and a comparison to "mix". The first parameter is the name of the template class to alias. The "under" keyword tells "alias" where to put the templates. For example, a "foo" template in "Some::Clever::Templates" will be aliased as "delegate/foo". The "setting" keyword specifies package variables available only to the aliases. These are available to the templates as "$self->package_variable($varname)". The "into" keyword tells "alias" into what class to alias the templates. Without this keyword, "alias" will alias them into the calling class. For those who prefer a direct OO syntax for mixins, just call "alias()" as a method on the class to be mixed in. To replicate the above three examples without the use of the sugar: Some::Clever:Templates->alias( '/delegate' ); Some::Other::Templates->alias( '/send_to', { name => 'Larry' } ); UI::Stuff->alias( 'My::View', '/mystuff' ); package_variable( VARIABLE ) $td->package_variable( $varname => $value ); $value = $td->package_variable( $varname ); Returns a value set for a mixed-in template's variable, if any were specified when the template was mixed-in. See "mix" for details. package_variables( VARIABLE ) $td->package_variables( $variables ); $variables = $td->package_variables; Get or set a hash reference of variables for a mixed-in template. See "mix" for details. Templates registration and lookup resolve_template TEMPLATE_PATH INCLUDE_PRIVATE_TEMPLATES my $code = Template::Declare->resolve_template($template); my $code = Template::Declare->has_template($template, 1); Turns a template path ("TEMPLATE_PATH") into a "CODEREF". If the boolean "INCLUDE_PRIVATE_TEMPLATES" is true, resolves private template in addition to public ones. "has_template()" is an alias for this method. First it looks through all the valid Template::Declare classes defined via "dispatch_to". For each class, it looks to see if it has a template called $template_name directly (or via a mixin). has_template TEMPLATE_PATH INCLUDE_PRIVATE_TEMPLATES An alias for "resolve_template". register_template( TEMPLATE_NAME, CODEREF ) MyApp::Templates->register_template( howdy => sub { ... } ); This method registers a template called "TEMPLATE_NAME" in the calling class. As you might guess, "CODEREF" defines the template's implementation. This method is mainly intended to be used internally, as you use the "template" keyword to create templates, right? register_private_template( TEMPLATE_NAME, CODEREF ) MyApp::Templates->register_private_template( howdy => sub { ... } ); This method registers a private template called "TEMPLATE_NAME" in the calling class. As you might guess, "CODEREF" defines the template's implementation. Private templates can't be called directly from user code but only from other templates. This method is mainly intended to be used internally, as you use the "private template" expression to create templates, right? buffer Gets or sets the String::BufferStack object; this is a class method. You can use it to manipulate the output from tags as they are output. It's used internally to make the tags nest correctly, and be output to the right place. We're not sure if there's ever a need for you to frob it by hand, but it does enable things like the following: template simple => sub { html { head {} body { Template::Declare->buffer->set_filter( sub {uc shift} ); p { 'Whee!' } p { 'Hello, world wide web!' } Template::Declare->buffer->clear_top if rand() < 0.5; } } }; ...which outputs, with equal regularity, either:

WHEE!

HELLO, WORLD WIDE WEB!

...or: We'll leave it to you to judge whether or not that's actually useful. Helpers You don't need to call any of this directly. into $class = into $class; "into" is a helper method providing semantic sugar for the "mix" method. All it does is return the name of the class on which it was called. Old, deprecated or just better to avoid import_templates import_templates MyApp::Templates under '/something'; Like "mix()", but without support for the "into" or "setting" keywords. That is, it mixes templates into the calling template class and does not support package variables for those mixins. Deprecated in favor of "mix". Will be supported for a long time, but new code should use "mix()". new_buffer_frame $td->new_buffer_frame; # same as $td->buffer->push( private => 1 ); Creates a new buffer frame, using "push" in String::BufferStack with "private". Deprecated in favor of dealing with "buffer" directly. end_buffer_frame my $buf = $td->end_buffer_frame; # same as my $buf = $td->buffer->pop; Deletes and returns the topmost buffer, using "pop" in String::BufferStack. Deprecated in favor of dealing with "buffer" directly. path_for $template my $path = Template::Declare->path_for('index'); Returns the path for the template name to be used for show, adjusted with paths used in "mix". Note that this will only work for the last class into which you imported the template. This method is, therefore, deprecated. PITFALLS We're reusing the perl interpreter for our templating language, but Perl was not designed specifically for our purpose here. Here are some known pitfalls while you're scripting your templates with this module. * It's quite common to see tag sub calling statements without trailing semi-colons right after "}". For instance, template foo => sub { p { a { attr { src => '1.png' } } a { attr { src => '2.png' } } a { attr { src => '3.png' } } } }; is equivalent to template foo => sub { p { a { attr { src => '1.png' } }; a { attr { src => '2.png' } }; a { attr { src => '3.png' } }; }; }; But "xml_decl" is a notable exception. Please always put a trailing semicolon after "xml_decl { ... }", or you'll mess up the order of output. * Another place that requires trailing semicolon is the statements before a Perl looping statement, an if statement, or a "show" call. For example: p { "My links:" }; for (@links) { with ( src => $_ ), a {} } The ";" after " p { ... } " is required here, or Perl will complain about syntax errors. Another example is h1 { 'heading' }; # this trailing semicolon is mandatory show 'tag_tag' * The "is" syntax for declaring tag attributes also requires a trailing semicolon, unless it is the only statement in a block. For example, p { class is 'item'; id is 'item1'; outs "This is an item" } img { src is 'cat.gif' } * Literal strings that have tag siblings won't be captured. So the following template p { 'hello'; em { 'world' } } produces

world

instead of the desired output

hello world

You can use "outs" here to solve this problem: p { outs 'hello'; em { 'world' } } Note you can always get rid of "outs" if the string literal is the only element of the containing block: p { 'hello, world!' } * Look out! If the if block is the last block/statement and the condition part is evaluated to be 0: p { if ( 0 ) { } } produces

0

instead of the more intuitive output:

This is because "if ( 0 )" is the last expression, so 0 is returned as the value of the whole block, which is used as the content of

tag. To get rid of this, just put an empty string at the end so it returns empty string as the content instead of 0: p { if ( 0 ) { } '' } BUGS Crawling all over, baby. Be very, very careful. This code is so cutting edge, it can only be fashioned from carbon nanotubes. But we're already using this thing in production :) Make sure you have read the "PITFALLS" section above :) Some specific bugs and design flaws that we'd love to see fixed. Output isn't streamy. If you run into bugs or misfeatures, please report them to "bug-template-declare@rt.cpan.org". SEE ALSO Template::Declare::Tags Template::Declare::TagSet Template::Declare::TagSet::HTML Template::Declare::TagSet::XUL Jifty AUTHOR Jesse Vincent LICENSE Template::Declare is Copyright 2006-2010 Best Practical Solutions, LLC. Template::Declare is distributed under the same terms as Perl itself. Template-Declare-0.47/Makefile.PL0000644000175000017500000000101212444202623015527 0ustar chmrrchmrruse inc::Module::Install; name 'Template-Declare'; license 'perl'; author 'Jesse Vincent '; all_from 'lib/Template/Declare.pm'; perl_version '5.8.2'; build_requires 'Test::More'; build_requires 'Test::Warn' => 0.11; requires 'Class::Accessor::Fast'; requires 'Class::Data::Inheritable'; requires 'Class::ISA'; requires 'String::BufferStack' => 1.10; feature 'HTML Lint testing' => -default => 0, 'HTML::Lint' => 0; sign; auto_install; WriteAll; Template-Declare-0.47/inc/0000755000175000017500000000000012444202775014344 5ustar chmrrchmrrTemplate-Declare-0.47/inc/Module/0000755000175000017500000000000012444202775015571 5ustar chmrrchmrrTemplate-Declare-0.47/inc/Module/Install.pm0000644000175000017500000003013312444202632017525 0ustar chmrrchmrr#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.006; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.12'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::getcwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::getcwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split /\n/, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Template-Declare-0.47/inc/Module/Install/0000755000175000017500000000000012444202775017177 5ustar chmrrchmrrTemplate-Declare-0.47/inc/Module/Install/Can.pm0000644000175000017500000000615712444202632020237 0ustar chmrrchmrr#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Template-Declare-0.47/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612444202632021260 0ustar chmrrchmrr#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Template-Declare-0.47/inc/Module/Install/Base.pm0000644000175000017500000000214712444202632020403 0ustar chmrrchmrr#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.12'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Template-Declare-0.47/inc/Module/Install/Metadata.pm0000644000175000017500000004330212444202632021247 0ustar chmrrchmrr#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) [\s|;]* /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashes delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Template-Declare-0.47/inc/Module/Install/Win32.pm0000644000175000017500000000340312444202632020427 0ustar chmrrchmrr#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Template-Declare-0.47/inc/Module/Install/AutoInstall.pm0000644000175000017500000000416212444202632021767 0ustar chmrrchmrr#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; my @features_require = Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); my %seen; my @requires = map @$_, map @$_, grep ref, $self->requires; while (my ($mod, $ver) = splice(@requires, 0, 2)) { $seen{$mod}{$ver}++; } my @build_requires = map @$_, map @$_, grep ref, $self->build_requires; while (my ($mod, $ver) = splice(@build_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires; while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @deduped; while (my ($mod, $ver) = splice(@features_require, 0, 2)) { push @deduped, $mod => $ver unless $seen{$mod}{$ver}++; } $self->requires(@deduped); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub installdeps_target { my ($self, @args) = @_; $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall::_installdeps_target(1); $self->auto_install(@args); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; Template-Declare-0.47/inc/Module/Install/Makefile.pm0000644000175000017500000002743712444202632021257 0ustar chmrrchmrr#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Template-Declare-0.47/inc/Module/Install/Include.pm0000644000175000017500000000101512444202632021105 0ustar chmrrchmrr#line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; Template-Declare-0.47/inc/Module/Install/Fetch.pm0000644000175000017500000000462712444202632020567 0ustar chmrrchmrr#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Template-Declare-0.47/inc/Module/AutoInstall.pm0000644000175000017500000006225412444202632020367 0ustar chmrrchmrr#line 1 package Module::AutoInstall; use strict; use Cwd (); use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.12'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps, $UpgradeDeps ); my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps, $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps, $PostambleActionsListAllDeps, $PostambleUsed, $NoTest); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub _installdeps_target { $InstallDepsTarget = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) { $UpgradeDeps = 1; __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } elsif ( $arg =~ /^--all(?:deps)?$/ ) { $AllDeps = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::getcwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); # We want to know if we're under CPAN early to avoid prompting, but # if we aren't going to try and install anything anyway then skip the # check entirely since we don't want to have to load (and configure) # an old CPAN just for a cosmetic message $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget; while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. my $cur = _version_of($mod); if (_version_cmp ($cur, $arg) >= 0) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { if (not defined $cur) # indeed missing { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; } else { # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above print "too old. ($cur < $arg)\n"; } push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or ($mandatory and $UnderCPAN) or $AllDeps or $InstallDepsTarget or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } if ( @Missing and not( $CheckOnly or $UnderCPAN) ) { require Config; my $make = $Config::Config{make}; if ($InstallDepsTarget) { print "*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n"; } else { print "*** Dependencies will be installed the next time you type '$make'.\n"; } # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; return (@Existing, @Missing); } sub _running_under { my $thing = shift; print <<"END_MESSAGE"; *** Since we're running under ${thing}, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing or @_; if ($ENV{PERL5_CPANM_IS_RUNNING}) { return _running_under('cpanminus'); } my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING}; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS'); } require CPAN; if ($CPAN::VERSION > '1.89') { if ($cpan_env) { return _running_under('CPAN'); } return; # CPAN.pm new enough, don't need to check further } # last ditch attempt, this -will- configure CPAN, very sorry _load_cpan(1); # force initialize even though it's already loaded # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed, @modules_to_upgrade ); while (my ($pkg, $ver) = splice(@_, 0, 2)) { # grep out those already installed if (_version_cmp(_version_of($pkg), $ver) >= 0) { push @installed, $pkg; if ($UpgradeDeps) { push @modules_to_upgrade, $pkg, $ver; } } else { push @modules, $pkg, $ver; } } if ($UpgradeDeps) { push @modules, @modules_to_upgrade; @installed = (); @modules_to_upgrade = (); } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } push @config, 'prereqs', $value; } elsif ( $key eq 'force' ) { push @config, $key, $value; } elsif ( $key eq 'notest' ) { push @config, 'skiptest', $value; } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^(?:force|notest)$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } if ($args{notest} && (not CPAN::Shell->can('notest'))) { die "Your version of CPAN is too old to support the 'notest' pragma"; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = do { if ($args{force}) { CPAN::Shell->force( install => $pkg ) } elsif ($args{notest}) { CPAN::Shell->notest( install => $pkg ) } else { CPAN::Shell->install($pkg) } }; $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::getcwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # report version without loading a module sub _version_of { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; foreach my $dir ( @INC ) { next if ref $dir; my $path = File::Spec->catfile($dir, $file); next unless -e $path; require ExtUtils::MM_Unix; return ExtUtils::MM_Unix->parse_version($path); } return undef; } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION and $CPAN::Config and not @_; require CPAN; # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to # CPAN::HandleConfig->load. CPAN reports that the redirection # is deprecated in a warning printed at the user. # CPAN-1.81 expects CPAN::HandleConfig->load, does not have # $CPAN::HandleConfig::VERSION but cannot handle # CPAN::Config->load # Which "versions expect CPAN::Config->load? if ( $CPAN::HandleConfig::VERSION || CPAN::HandleConfig->can('load') ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison # return values same as <=> sub _version_cmp { my ( $cur, $min ) = @_; return -1 unless defined $cur; # if 0 keep comparing return 1 unless $min; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return version->new($cur) <=> version->new($min); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return Sort::Versions::versioncmp( $cur, $min ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return $cur <=> $min; } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); my $deps_list = join( ',', @Missing, @Existing ); $PostambleActionsUpgradeDeps = "\$(PERL) $0 --config=$config --upgradedeps=$deps_list"; my $config_notest = join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}), 'notest', 1 ) if $Config; $PostambleActionsNoTest = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); $PostambleActionsUpgradeDepsNoTest = "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list"; $PostambleActionsListDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing); my @all = (@Missing, @Existing); $PostambleActionsListAllDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; my $fragment; $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget; config :: installdeps \t\$(NOECHO) \$(NOOP) AUTO_INSTALL $fragment .= <<"END_MAKE"; checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions installdeps_notest :: \t$PostambleActionsNoTest upgradedeps :: \t$PostambleActionsUpgradeDeps upgradedeps_notest :: \t$PostambleActionsUpgradeDepsNoTest listdeps :: \t$PostambleActionsListDeps listalldeps :: \t$PostambleActionsListAllDeps END_MAKE return $fragment; } 1; __END__ #line 1197 Template-Declare-0.47/MANIFEST0000644000175000017500000000272612444202663014727 0ustar chmrrchmrrChanges inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Template/Declare.pm lib/Template/Declare/Buffer.pm lib/Template/Declare/Tags.pm lib/Template/Declare/TagSet.pm lib/Template/Declare/TagSet/HTML.pm lib/Template/Declare/TagSet/RDF.pm lib/Template/Declare/TagSet/RDF/EM.pm lib/Template/Declare/TagSet/XUL.pm Makefile.PL MANIFEST This list of files META.yml README SIGNATURE t/99-pod-coverage.t t/99-pod-spelling.t t/99-pod.t t/aliasing.t t/alternative.t t/arg-declaration-styles.t t/arg-passing.t t/attributes.t t/closures.t t/composition.t t/deep_aliasing.t t/deep_importing.t t/deep_mixing.t t/dispatch_order.t t/duplicate_element_ids.t t/forms.t t/import-regression.t t/importing.t t/indent.t t/indexhtml.t t/inline-tagset.t t/inline_xml_rendering.t t/instrumentation.t t/mixing.t t/MyTagSet.pm t/namespace.t t/nested_show.t t/overloaded.t t/pitfalls.t t/postprocessor.t t/private.t t/relative-aliasing.t t/relative-mixing.t t/relative-pathing.t t/rt-37622.t t/self.t t/siblings.t t/similar-aliases.t t/smart_tag_wrapper.t t/strict.t t/subclassing.t t/subtemplates.t t/tag_sub_list.t t/tagset_html.t t/tagset_mix.t t/tagset_rdf.t t/tagset_rdf_em.t t/tagset_xul.t t/trivial.t t/utf8.t t/utils.pl t/wrappers.t t/xss.t Template-Declare-0.47/SIGNATURE0000644000175000017500000001313012444203000015033 0ustar chmrrchmrrThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.73. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 ebfb06989d1c05fd1e2cd3963505e298c4aebb8b Changes SHA1 52e8cc2763e18ca88e01d4dd9b86810977ae38f2 MANIFEST SHA1 74fad64dc9b1ac0731fdb93ee93a0f916e623d04 META.yml SHA1 2a16061557fbfb53854b9b5e534a9dad925b63ba Makefile.PL SHA1 6b14974531d0b5bfad494febf88d6e43f1a1de12 README SHA1 248dabb0dbdd603ecf7374c69e9a51073453e15d inc/Module/AutoInstall.pm SHA1 9b5001bfa9cf8607b3b3935284d9253e0391c9f1 inc/Module/Install.pm SHA1 4d21888488f7c6a67742343a0be404bb7e1b3e66 inc/Module/Install/AutoInstall.pm SHA1 cab0e564f9bdf658535f683aa197157e06d0dcea inc/Module/Install/Base.pm SHA1 a1559b5b3b40f68efbbd256f4fef85970891b3ae inc/Module/Install/Can.pm SHA1 f15c1ba85f6d52e70c48c64bf0752c90a4ad66f9 inc/Module/Install/Fetch.pm SHA1 d44d96acd20793306dd201030c688e2a7d3083ee inc/Module/Install/Include.pm SHA1 eb48df8bafd07c6a862126d9b274df42b4395742 inc/Module/Install/Makefile.pm SHA1 95c73873c6c3cb7024614c225c53863e1e90c134 inc/Module/Install/Metadata.pm SHA1 f8b2ae3386f6ba26c33408968a953d450842eade inc/Module/Install/Win32.pm SHA1 f302bc703d76299cff243e5b44cecd61aac27b76 inc/Module/Install/WriteAll.pm SHA1 e38b756621221af50fe002d0b654d022170a3a41 lib/Template/Declare.pm SHA1 4202a05659532bea1d800bc7296d9c1312624f9b lib/Template/Declare/Buffer.pm SHA1 c86b1e4749f76137c854358f496e8a8030d39fe7 lib/Template/Declare/TagSet.pm SHA1 3db3c3d4ecf402d8309014d2bb703eddeb100846 lib/Template/Declare/TagSet/HTML.pm SHA1 c1703c1f999d27878117e0aaf59dcae1d9d98645 lib/Template/Declare/TagSet/RDF.pm SHA1 8ba58a5c640010febb799bb03b7857eda34c86bc lib/Template/Declare/TagSet/RDF/EM.pm SHA1 2941a453d2627e0c0c02b8f50e7600c648867831 lib/Template/Declare/TagSet/XUL.pm SHA1 e58cac12b1f429e78723c147090746841b3a3065 lib/Template/Declare/Tags.pm SHA1 f01b9a79b8f508729ce33693f0bb58d9cce54a3f t/99-pod-coverage.t SHA1 7103d94b3138dec4dc47014b8467ccb2744bd488 t/99-pod-spelling.t SHA1 332d20b7b38fc5728b89d46b80f5b4e9e0ce4e29 t/99-pod.t SHA1 8de6d59c7ed7c771f9cdc5e2dbaef0c31c7ab439 t/MyTagSet.pm SHA1 b29bbf71af87b128afb6899f024bbd4f5d87a98d t/aliasing.t SHA1 ecc1013f49f12123c78393cc67afc09f8bdfb607 t/alternative.t SHA1 90f697ff435105d7dd784e6323ec0ea3e1431e1f t/arg-declaration-styles.t SHA1 b49f0526b5deb026cc88a91808dcfcad9bd27c21 t/arg-passing.t SHA1 17290aa0f2a1ec6cac93ab0e38c1504daac51031 t/attributes.t SHA1 89a6d6d5efeeb0f77bf849a462bffc4ea556ef9e t/closures.t SHA1 a7d17a14951704955e0c313c5f9bbc005abd27ce t/composition.t SHA1 94ccc30fd1cf2a62f084351c85083590912bac3e t/deep_aliasing.t SHA1 584f11977b88eee3fd9b0e7048c324a4ec6fc3b6 t/deep_importing.t SHA1 c59fe68c7aacee19956b470eec403acfebb9e200 t/deep_mixing.t SHA1 589e07a8e42e67a4939b5b555f71cb5cc5bbb822 t/dispatch_order.t SHA1 c094720c3e2611439633d8baaabe96e7c5af3352 t/duplicate_element_ids.t SHA1 930cd4a44466eb6fb70d5cb91a1431a73515cca8 t/forms.t SHA1 4cc4cf8beb543796d715d003da52866b7c5304e0 t/import-regression.t SHA1 bf1dfd4cf42d43798b4ea9c89c21e87c91ce9d3e t/importing.t SHA1 11343aaa0aeae231361997ccd44abf188de98fe2 t/indent.t SHA1 176eeceeac1b46d5ff1ce7d9e6363b3ec6b5a9d8 t/indexhtml.t SHA1 56a834f2099d3956f2b4a490c04063b36edbf0cd t/inline-tagset.t SHA1 407d9dbbe3c8da6ed865f014ccdb8a3e10c4c7c3 t/inline_xml_rendering.t SHA1 ef67dee0bb8db682889745e0cb8cee8c7c61edc5 t/instrumentation.t SHA1 b6e93d9604ede87001d1ad15f824afafa66964f2 t/mixing.t SHA1 9559b6333443a1f6e7d44f7f5a7cfe9639b5464d t/namespace.t SHA1 b70fce7cec938d2f93536602ff88a18e87f7967d t/nested_show.t SHA1 53c336678679a10902d9e06c55084855bd0e9fdc t/overloaded.t SHA1 00e6e826e3a1e07f3feda22f00e616c2ac70590b t/pitfalls.t SHA1 cbbc166955a5a37313870658d203b9cd55be2338 t/postprocessor.t SHA1 166d756de9f1f5165d9fa83521ebb62726ce8544 t/private.t SHA1 22eb04e6c0859f15f77759b18dcf19cc2d2b0e9d t/relative-aliasing.t SHA1 1dcc317cb5029491a44a9c7eaee5add8219da74c t/relative-mixing.t SHA1 f14389331a4b463d69cd6705087d1e1327808bc7 t/relative-pathing.t SHA1 9f631c569f86a38441540ae6dd051aff177db678 t/rt-37622.t SHA1 dad25f5c714947cf7fb5954fb876b18114c43ed5 t/self.t SHA1 771c903ee077531f0829b9d4efda1ca4fbd2fdfd t/siblings.t SHA1 31a78875cd464b5b2c21cee53c5498c97c395ebb t/similar-aliases.t SHA1 9beebbb3620de49a078f0c663e4bae758a2c339f t/smart_tag_wrapper.t SHA1 b4e187860320bbcdffa8036a76b47752521fb1ff t/strict.t SHA1 5a4d6002efea9daf71d3d291bf2a35751a51cba8 t/subclassing.t SHA1 679b39abb4812ca1c61ad9e9dd3f5aab97f8829c t/subtemplates.t SHA1 44f81200ec38ebf8bc9c836e34942f70990e7207 t/tag_sub_list.t SHA1 72fcdef5a4a16376dcb45b858864652a44287d17 t/tagset_html.t SHA1 17263784a1a80112896cd157de834709a387fbff t/tagset_mix.t SHA1 cb48ee69151cf5b07ef19f4b2c727cb5580b1471 t/tagset_rdf.t SHA1 d6b90c5e540749b6f2b7ffa9f6ae84838a234503 t/tagset_rdf_em.t SHA1 5da0e537331e19e918c5bbf641922bf9af84ff3c t/tagset_xul.t SHA1 38da4b71fd139cc8f56b4b93636debf1a52f8351 t/trivial.t SHA1 a86db44f9d1f77887f9dffbe3ece263ebaee864c t/utf8.t SHA1 c6780f36485d147ee0a7b295f095995532e19618 t/utils.pl SHA1 506e99d34f44e087b0d0f6880513648bb37de32a t/wrappers.t SHA1 7bdcccbdd5253f4eae12d3c279183e10577a0184 t/xss.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1 iEYEARECAAYFAlSRBf0ACgkQMflWJZZAbqAHDQCfT9jcyBvSG2QS8juyWwxtnjp0 CqcAni5F2LwAbUgzUWPypwrF7c4hA9Zo =UCgq -----END PGP SIGNATURE----- Template-Declare-0.47/t/0000755000175000017500000000000012444202775014036 5ustar chmrrchmrrTemplate-Declare-0.47/t/relative-aliasing.t0000644000175000017500000000501312442630701017612 0ustar chmrrchmrruse warnings; use strict; ############################################################################## package SearchPlugin::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'search' => sub { h1 {'SearchPlugin::View::search'}; }; ############################################################################## package ListPlugin::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'listing' => sub { h1 {'ListPlugin::View::listing'}; }; alias SearchPlugin::View under '/'; ############################################################################## package MyApp::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'toplevel' => sub {h1{'Toplevel'}}; alias ListPlugin::View under 'plugin/'; ############################################################################## package main; Template::Declare->init( dispatch_to => ['MyApp::View'] ); use Test::More tests => 14; use Test::Warn; require "t/utils.pl"; ok( MyApp::View->has_template('toplevel'), 'Should have toplevel template' ); ok( !MyApp::View->has_template('listing'), "the listing template isn't imported to the top level"); ok( !MyApp::View->has_template('search'), "The search template isn't imported to the top level" ); ok( MyApp::View->has_template('/plugin/listing'), 'has listing template' ); ok( MyApp::View->has_template('/plugin/search'), 'has search template' ); { my $simple = ( Template::Declare->show('toplevel')); like( $simple, qr'Toplevel', 'Can execute toplevel template' ); } { warning_like { my $simple = ( Template::Declare->show('listing') ||''); unlike( $simple, qr'listing', 'Cannot call a toplevel "listing" template' ); } qr/The template 'listing' could not be found/, "listing is private" } warning_like { my $simple = ( Template::Declare->show('search')||''); unlike( $simple, qr'search', "Cannot call a toplevel /search" ); } qr/The template 'search' could not be found/, "Search could not be found"; { my $simple = ( Template::Declare->show('/plugin/listing')); like( $simple, qr'listing', "Can call /plugin/listing" ); $simple = ( Template::Declare->show('plugin/listing')); like( $simple, qr'listing', "Can call plugin/listing" ); } { my $simple = ( Template::Declare->show('/plugin/search')); like( $simple, qr'search' , "Can call /plugin/search"); $simple = ( Template::Declare->show('plugin/search')); like( $simple, qr'search' , "Can call plugin/search"); } 1; Template-Declare-0.47/t/99-pod-coverage.t0000644000175000017500000000042712442630701017030 0ustar chmrrchmrruse Test::More; # XXX we need more POD... my $skip_all = 1; eval "use Test::Pod::Coverage"; plan skip_all => "Test::Pod::Coverage required for testing POD coverage" if $@; plan skip_all => "Coverage tests only run for authors" unless (-d 'inc/.author'); all_pod_coverage_ok(); Template-Declare-0.47/t/siblings.t0000644000175000017500000000200112442630701016016 0ustar chmrrchmrruse warnings; use strict; package Wifty::UI; use base qw/Template::Declare/; use Template::Declare::Tags; use Test::More tests => 7; require "t/utils.pl"; template tag_tag => sub { head { } body { } }; template tag_show => sub { h1 { 'heading' } show('tag_tag') }; template tag_text => sub { h1 { } 'text' }; Template::Declare->init(dispatch_to => ['Wifty::UI']); { Template::Declare->buffer->clear; my $simple =(show('tag_tag')); like($simple, qr/head.*body/ms, 'body after head'); ok_lint($simple); } { Template::Declare->buffer->clear; my $simple =(show('tag_show')); TODO: { local $TODO = 'fixme'; like($simple, qr/\A\s*

buffer->clear; my $simple =(show('tag_text')); like($simple, qr/\A\s*

sub { html { head {}; body { show 'private-content'; }; } }; private template 'private-content' => sub { my $self = shift; with( id => 'body' ), div { outs('This is my content from'.$self); }; }; package Baseclass::UI; use base qw/Template::Declare/; use Template::Declare::Tags; private template 'private-content' => sub { with( id => 'body' ), div { outs('This is baseclass content'); }; }; package Childclass::UI; use base qw/Template::Declare/; use Template::Declare::Tags; private template 'private-content' => sub { with( id => 'body' ), div { outs('This is child class content'); }; }; package main; use Template::Declare::Tags; Template::Declare->init(dispatch_to => ['Wifty::UI', 'Baseclass::UI']); use Test::More tests => 11; use Test::Warn; require "t/utils.pl"; { local $Template::Declare::Tags::self = 'Wifty::UI'; my $simple = Template::Declare::Tags::show('simple') ; like( $simple, qr'This is my content' ); like( $simple, qr'Wifty::UI', '$self is correct in template block' ); ok_lint($simple); } Template::Declare->init( dispatch_to => [ 'Childclass::UI', 'Wifty::UI', 'Baseclass::UI' ] ); { my $simple = ( show('simple') ); like( $simple, qr'This is child class content' ); ok_lint($simple); } { my $simple; warning_like { $simple = ( show('does_not_exist') ); } qr/could not be found.*private/, "got warning"; unlike( $simple , qr'This is my content' ); is ($simple,''); } { my $simple; warning_like { $simple = ( show('private-content')||'' ); } qr/could not be found.*private/, "got warning"; unlike( $simple , qr'This is my content', "Can't call private templates" ); ok_lint($simple); } 1; Template-Declare-0.47/t/import-regression.t0000644000175000017500000000162312442630701017705 0ustar chmrrchmrruse warnings; use strict; package Wifty::UI; use base qw/Template::Declare/; use Template::Declare::Tags; template 'test' => sub { my $self = shift; outs 'wowza'; }; import_templates Wifty::UI under '/here'; package Wifty::UI::Woot; use base 'Wifty::UI'; package main; #use Test::More tests => 19; use Test::More 'no_plan'; use Template::Declare::Tags; Template::Declare->init( dispatch_to => ['Wifty::UI'] ); ok +Wifty::UI->has_template('here/test'), 'Template should be under new path'; ok +Wifty::UI->has_template('test'), 'Original template name should be visible'; ok +Wifty::UI::Woot->has_template('here/test'), 'Moved template should be visible from subclass'; ok +Wifty::UI::Woot->has_template('test'), 'Original template name should be visible from subclass'; ok my $out = Template::Declare->show('here/test'), 'Should get output'; is $out, 'wowza', 'Output should be correct'; Template-Declare-0.47/t/smart_tag_wrapper.t0000644000175000017500000000441712442630701017742 0ustar chmrrchmrruse warnings; use strict; package Wifty::UI; use base qw/Template::Declare/; use Template::Declare::Tags; sub test_smart_tag (&) { my $code = shift; smart_tag_wrapper { my %args = @_; outs( "START " . join( ', ', map { "$_: $args{$_}" } sort keys %args ) . "\n" ); $code->(); outs("END\n"); }; } template simple => sub { with( foo => 'bar' ), # test_smart_tag { outs("simple\n"); }; }; template leak_check => sub { with( foo => 'bar' ), # test_smart_tag { outs("first\n"); }; test_smart_tag { outs("second\n"); }; }; package main; use Template::Declare::Tags; Template::Declare->init( dispatch_to => ['Wifty::UI'] ); use Test::More tests => 4; require "t/utils.pl"; my $simple = show('simple'); is( $simple, "\nSTART foo: bar\nsimple\nEND\n", "got correct output for simple" ); my $leak_check = show('leak_check'); is( $leak_check, # "\nSTART foo: bar\nfirst\nEND\n" # . "\nSTART \nsecond\nEND\n", # "got correct output for simple" ); ############################################################################## # Documentation example. package My::Template; use Template::Declare::Tags; use base 'Template::Declare'; sub myform (&) { my $code = shift; smart_tag_wrapper { my %params = @_; # set using 'with' form { attr { map {$_ => $params{attr}{$_} } sort keys %{ $params{attr} } }; $code->(); input { attr { type => 'submit', value => $params{value} } }; }; }; } template edit_prefs => sub { with( attr => { id => 'edit_prefs', action => 'edit.html' }, value => 'Save' ), myform { label { 'Time Zone' }; input { type is 'text'; name is 'tz' }; }; }; package main; Template::Declare->init( dispatch_to => ['My::Template'] ); ok my $output = Template::Declare->show('edit_prefs'), 'Get edit_prefs output'; is( $output, qq{
}, "got correct output for simple" ); Template-Declare-0.47/t/tagset_xul.t0000644000175000017500000000201512442630701016370 0ustar chmrrchmrruse strict; use warnings; package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags qw/ XUL /; template main => sub { xml_decl { 'xml', version => '1.0' }; xml_decl { 'xml-stylesheet', href => "chrome://global/skin/", type => "text/css" }; groupbox { caption { attr { label => 'Colors' } } radiogroup { for my $id ( qw< orange violet yellow > ) { radio { attr { id => $id, label => ucfirst($id), $id eq 'violet' ? (selected => 'true') : () } } } } } }; package main; use Test::More tests => 1; Template::Declare->init( dispatch_to => ['MyApp::Templates']); my $out = Template::Declare->show('main') . "\n"; is $out, <<_EOC_; _EOC_ Template-Declare-0.47/t/dispatch_order.t0000644000175000017500000002226712442630701017216 0ustar chmrrchmrruse warnings; use strict; ############################################################################## package Wifty::Foo; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Foo' }; ############################################################################## package Wifty::Bar; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Bar' }; ############################################################################## package Wifty::Baz; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Baz' }; ############################################################################## package Wifty::Bip; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Bip' }; ############################################################################## package main; use Test::More tests => 24; #use Test::More 'no_plan'; # Check template resolution with the deprecated `roots` parameterx. ok !Template::Declare->init( roots => ['Wifty::Foo', 'Wifty::Bar'] ), 'init with Foo and Bar as roots'; is +Template::Declare->show('hello'), 'hello from Bar', 'Bar should have precedence'; # Check template resolution with the new `dispatch_to` parameter. ok !Template::Declare->init( dispatch_to => ['Wifty::Foo', 'Wifty::Bar'] ), 'init to dispatch to Foo and Bar'; is +Template::Declare->show('hello'), 'hello from Foo', 'Foo should have precedence'; ############################################################################## # Import the Baz templates into Bar. package Wifty::Bar; import_templates Wifty::Baz under '/'; ############################################################################## package main; ok !Template::Declare->init( dispatch_to => ['Wifty::Foo', 'Wifty::Bar'] ), 'init to dispatch to Foo and Bar again'; is +Template::Declare->show('hello'), 'hello from Foo', 'Foo should still have precedence'; ############################################################################## # Import the Baz templates into Foo. package Wifty::Foo; import_templates Wifty::Baz under '/'; ############################################################################## package main; ok !Template::Declare->init( dispatch_to => ['Wifty::Foo', 'Wifty::Bar'] ), 'init to dispatch to Foo and Bar one more time'; is +Template::Declare->show('hello'), 'hello from Baz', 'Baz::hello should have replaced Foo::hello'; # Now dispatch only to Bip and Foo. ok !Template::Declare->init( dispatch_to => ['Wifty::Bip', 'Wifty::Foo'] ), 'init to dispatch to Bip and Foo'; is +Template::Declare->show('hello'), 'hello from Bip', 'Bip should now have precedence'; ############################################################################## # Now try the same stuff with aliases. ############################################################################## package Mifty::Foo; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Foo' }; ############################################################################## package Mifty::Bar; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Bar' }; ############################################################################## package Mifty::Baz; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Baz' }; ############################################################################## package Mifty::Bip; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Bip' }; ############################################################################## # Import the Baz templates into Bar. package Mifty::Bar; alias Mifty::Baz under '/'; ############################################################################## package main; ok !Template::Declare->init( dispatch_to => ['Mifty::Foo', 'Mifty::Bar'] ), 'init to dispatch to Mifty::Foo and Mifty::Bar'; is +Template::Declare->show('hello'), 'hello from Foo', 'Mifty::Foo should have precedence'; ############################################################################## # Import the Baz templates into Foo. package Mifty::Foo; import_templates Mifty::Baz under '/'; ############################################################################## package main; ok !Template::Declare->init( dispatch_to => ['Mifty::Foo', 'Mifty::Bar'] ), 'init to dispatch to Mifty::Foo and Mifty::Bar again'; is +Template::Declare->show('hello'), 'hello from Baz', 'Mifty::Baz::hello should have replaced Mifty::Foo::hello'; # Now dispatch only to Bip and Foo. ok !Template::Declare->init( dispatch_to => ['Mifty::Bip', 'Mifty::Foo'] ), 'init to dispatch to Mifty::Bip and Mifty::Foo'; is +Template::Declare->show('hello'), 'hello from Bip', 'Mifty::Bip should now have precedence'; ############################################################################## # Now try the same stuff with mixes. ############################################################################## package Sifty::Foo; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Foo' }; ############################################################################## package Sifty::Bar; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Bar' }; ############################################################################## package Sifty::Baz; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Baz' }; ############################################################################## package Sifty::Bip; use base qw/Template::Declare/; use Template::Declare::Tags; template hello => sub { outs 'hello from Bip' }; ############################################################################## # Import the Baz templates into Bar. package Sifty::Bar; mix Sifty::Baz under '/'; ############################################################################## package main; ok !Template::Declare->init( dispatch_to => ['Sifty::Foo', 'Sifty::Bar'] ), 'init to dispatch to Sifty::Foo and Sifty::Bar'; is +Template::Declare->show('hello'), 'hello from Foo', 'Sifty::Foo should have precedence'; ############################################################################## # Import the Baz templates into Foo. package Sifty::Foo; import_templates Sifty::Baz under '/'; ############################################################################## package main; ok !Template::Declare->init( dispatch_to => ['Sifty::Foo', 'Sifty::Bar'] ), 'init to dispatch to Sifty::Foo and Sifty::Bar again'; is +Template::Declare->show('hello'), 'hello from Baz', 'Sifty::Baz::hello should have replaced Sifty::Foo::hello'; # Now dispatch only to Bip and Foo. ok !Template::Declare->init( dispatch_to => ['Sifty::Bip', 'Sifty::Foo'] ), 'init to dispatch to Sifty::Bip and Sifty::Foo'; is +Template::Declare->show('hello'), 'hello from Bip', 'Sifty::Bip should now have precedence'; ############################################################################## # Doc example. package MyApp::UI::Standard; use Template::Declare::Tags; use base 'Template::Declare'; template image => sub { my ($self, $src, $title) = @_; img { src is $src; title is $title; }; }; package MyApp::UI::Standard; use Template::Declare::Tags; use base 'Template::Declare'; template image => sub { my ($self, $src, $title, $caption) = @_; div { class is 'std'; img { src is $src; title is $title; }; p { class is 'caption'; outs $caption; }; }; }; ############################################################################## package MyApp::UI::Formal; use Template::Declare::Tags; use base 'Template::Declare'; template image => sub { my ($self, $src, $title, $credit, $caption) = @_; div { class is 'formal'; img { src is $src; title is $title; }; p { class is 'credit'; outs "Photo by $credit"; }; p { class is 'caption'; outs $caption; }; }; }; ############################################################################## package main; my @template_classes = 'MyApp::UI::Standard'; Template::Declare->init( dispatch_to => \@template_classes ); is +Template::Declare->show('image', 'foo.png', 'Foo'), q{

}, 'Should get standard image output'; unshift @template_classes, 'MyApp::UI::Formal'; is +Template::Declare->show('image', 'ap.png', 'AP Photo', 'Clark Kent', 'Big news'), q{

Photo by Clark Kent

Big news

}, 'Should get formal image output'; Template-Declare-0.47/t/utf8.t0000644000175000017500000000321212442630701015077 0ustar chmrrchmrruse warnings; use strict; use utf8;# 'UTF-8'; package Wifty::UI; use base qw/Template::Declare/; use Template::Declare::Tags; # 'test' in Russian my $str = "\x{442}\x{435}\x{441}\x{442}"; template simple_outs => sub { outs("$str") }; template double_outs => sub { outs("$str"); outs("$str") }; template tag_outs => sub { p { outs("$str") } }; template double_tag_outs => sub { p { outs("$str") } p { outs("$str") } }; template attr => sub { p {{ title is "$str" }} }; template attr_with_escape => sub { p {{ title is "<$str>" }} }; Template::Declare->init(dispatch_to => ['Wifty::UI']); 1; use Test::More tests => 12; require "t/utils.pl"; { my $simple = (show('simple_outs')); ok($simple =~ m{^\s*$str\s*$}s); # diag ($simple); ok_lint($simple); } Template::Declare->buffer->clear; { my $simple = (show('double_outs')); ok($simple =~ m{^\s*$str\s*$str\s*$}s); # diag ($simple); ok_lint($simple); } Template::Declare->buffer->clear; { my $simple = (show('tag_outs')); ok($simple =~ m{^\s*

\s*$str\s*

\s*$}s); ok_lint($simple, 1); } Template::Declare->buffer->clear; { my $simple = (show('double_tag_outs')); ok($simple =~ m{^\s*

\s*$str\s*

\s*

\s*$str\s*

\s*$}s); ok_lint($simple, 1); } Template::Declare->buffer->clear; { my $simple = (show('attr')); ok($simple =~ m{^\s*

\s*$}s); # diag ($simple); ok_lint($simple); } Template::Declare->buffer->clear; { my $simple = (show('attr_with_escape')); ok($simple =~ m{^\s*

\s*$}s); #diag ($simple); ok_lint($simple); } Template::Declare->buffer->clear; Template-Declare-0.47/t/tagset_rdf.t0000644000175000017500000000331212442630701016334 0ustar chmrrchmrruse strict; use warnings; package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags RDF => { namespace => 'rdf' }, 'RDF'; template with_ns => sub { rdf::RDF { attr { 'xmlns:rdf' => "http://www.w3.org/1999/02/22-rdf-syntax-ns#" } rdf::Description { attr { about => "Matilda" } rdf::type {} #... } rdf::Bag { rdf::li {} rdf::_1 {} } rdf::Seq { rdf::_2 {} rdf::_9 {} rdf::_10 {} } rdf::Alt {} } }; template without_ns => sub { RDF { attr { 'xmlns:rdf' => "http://www.w3.org/1999/02/22-rdf-syntax-ns#" } Description { attr { about => "Matilda" } type {} #... } Bag { li {} _1 {} } Seq { _2 {} _9 {} _10 {} } Alt {} } }; package main; use Test::More tests => 2; Template::Declare->init( dispatch_to => ['MyApp::Templates']); my $out = Template::Declare->show('with_ns') . "\n"; is $out, <<_EOC_; _EOC_ $out = Template::Declare->show('without_ns') . "\n"; is $out, <<_EOC_;
  • <_1 /> <_2 /> <_9 /> <_10 /> _EOC_ Template-Declare-0.47/t/inline_xml_rendering.t0000644000175000017500000000134612442630701020412 0ustar chmrrchmrruse strict; use warnings; package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags; template main => sub { html { body { p { 'hi' } } } }; package main; use Test::More tests => 2; Template::Declare->init( dispatch_to => ['MyApp::Templates']); for ( [ "

    hi

    " ] , [ "

    hi

    " => sub { $Template::Declare::Tags::TAG_INDENTATION = 0; $Template::Declare::Tags::EOL = ""; } ] ) { my ( $expected, $get_ready ) = @$_; $get_ready and $get_ready->(); my $got = Template::Declare->show('main'); for ($got,$expected) { s/\n/Z/gxms; s/\s/X/g; } # easier to debug then :) is $got, $expected; } Template-Declare-0.47/t/composition.t0000644000175000017500000001036512442630701016563 0ustar chmrrchmrruse warnings; use strict; # Tests for the "Template Composition" doc examples. ############################################################################## package MyApp::UtilTemplates; use Template::Declare::Tags; use base 'Template::Declare'; template content => sub { my $self = shift; my @paras = @_; h1 { $self->get_title }; div { id is 'content'; p { $_ } for @paras; }; }; package MyApp::Templates; use Template::Declare::Tags; use base 'Template::Declare'; mix MyApp::UtilTemplates under '/util'; sub get_title { 'Kashmir' } template story => sub { my $self = shift; html { head { title { "My Site: " . $self->get_title }; }; body { show( 'util/content' => 'fist paragraph', 'second paragraph' ); }; }; }; ############################################################################## package main; use Test::More tests => 3; Template::Declare->init( dispatch_to => ['MyApp::Templates'] ); is +Template::Declare->show('story'), q{ My Site: Kashmir

    Kashmir

    fist paragraph

    second paragraph

    }, 'Should get mixed in template output'; ############################################################################## package MyApp::UI::Stuff; use Template::Declare::Tags; use base 'Template::Declare'; sub img_path { '/ui/css' } template sidebar => sub { my ($self, $thing) = @_; div { class is 'sidebar'; img { src is $self->img_path . '/sidebar.png' }; p { $_->content } for $thing->get_things; }; }; package MyApp::UI::Stuff::Politics; use Template::Declare::Tags; use base 'MyApp::UI::Stuff'; sub img_path { '/politics/ui/css' } package MyApp::Render; use Template::Declare::Tags; use base 'Template::Declare'; alias MyApp::UI::Stuff under '/stuff'; template page => sub { my ($self, $page) = @_; h1 { $page->title }; for my $thing ($page->get_things) { if ($thing->is('paragraph')) { p { $thing->content }; } elsif ($thing->is('sidebar')) { show( '/stuff/sidebar' => $thing ); } } }; package MyApp::Render::Politics; use Template::Declare::Tags; use base 'Template::Declare'; alias MyApp::UI::Stuff::Politics under '/politics'; template page => sub { my ($self, $page) = @_; h1 { $page->title }; for my $thing ($page->get_things) { if ($thing->is('paragraph')) { p { $thing->content }; } elsif ($thing->is('sidebar')) { show( '/politics/sidebar' => $thing ); } } }; package My::Thing; sub new { my $self = shift; bless {@_} => $self } sub title { shift->{title} }; sub content { shift->{content} }; sub get_things { @{ shift->{things} } }; sub is { shift->{is} eq shift }; package main; my $page = My::Thing->new( title => 'My page title', things => [ My::Thing->new( is => 'paragraph', content => 'Page paragraph' ), My::Thing->new( is => 'sidebar', things => [ My::Thing->new( content => 'Sidebar paragraph' ), My::Thing->new( content => 'Another paragraph' ), ], ) ], ); Template::Declare->init( dispatch_to => ['MyApp::Render'] ); is +Template::Declare->show( page => $page ), q{

    My page title

    Page paragraph

    Sidebar paragraph

    Another paragraph

    }, 'Should get page with default sidebar'; Template::Declare->init( dispatch_to => ['MyApp::Render::Politics'] ); is +Template::Declare->show( page => $page ), q{

    My page title

    Page paragraph

    Sidebar paragraph

    Another paragraph

    }, 'Should get page with politics sidebar'; Template-Declare-0.47/t/99-pod.t0000644000175000017500000000032412442630701015233 0ustar chmrrchmrruse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "Coverage tests only run for authors" unless (-d 'inc/.author'); all_pod_files_ok(); Template-Declare-0.47/t/forms.t0000644000175000017500000000131412442630701015340 0ustar chmrrchmrruse warnings; use strict; package Wifty::UI; use base qw/Template::Declare/; use Template::Declare::Tags; use Test::More tests =>2 ; template simple => sub { html { head { } body { form { attr { target => '/page.html', method => 'POST' }; input { attr{ type => 'text'} }; } } } }; package Template::Declare::Tags; require "t/utils.pl"; use Test::More; our $self; local $self = {}; bless $self, 'Wifty::UI'; Template::Declare->init( dispatch_to => ['Wifty::UI']); { Template::Declare->buffer->clear; my $simple =(show('simple')); ok($simple =~ ' sub { h1 {'SearchPlugin::View::search'}; }; ############################################################################## package ListPlugin::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'listing' => sub { h1 {'ListPlugin::View::listing'}; }; alias SearchPlugin::View under '/'; ############################################################################## package MyApp::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'toplevel' => sub {h1{'Toplevel'}}; alias ListPlugin::View under '/plugin'; ############################################################################## package main; Template::Declare->init( dispatch_to => ['MyApp::View'] ); use Test::More tests => 14; use Test::Warn; require "t/utils.pl"; ok( MyApp::View->has_template('toplevel'), 'Should have toplevel template' ); ok( !MyApp::View->has_template('listing'), "the listing template isn't imported to the top level"); ok( !MyApp::View->has_template('search'), "The search template isn't imported to the top level" ); ok( MyApp::View->has_template('/plugin/listing'), 'has listing template' ); ok( MyApp::View->has_template('/plugin/search'), 'has search template' ); { my $simple = ( Template::Declare->show('toplevel')); like( $simple, qr'Toplevel', 'Can execute toplevel template' ); } { warning_like { my $simple = ( Template::Declare->show('listing') ||''); unlike( $simple, qr'listing', 'Cannot call a toplevel "listing" template' ); } qr/The template 'listing' could not be found/, "listing is private" } warning_like { my $simple = ( Template::Declare->show('search')||''); unlike( $simple, qr'search', "Cannot call a toplevel /search" ); } qr/The template 'search' could not be found/, "Search could not be found"; { my $simple = ( Template::Declare->show('/plugin/listing')); like( $simple, qr'listing', "Can call /plugin/listing" ); $simple = ( Template::Declare->show('plugin/listing')); like( $simple, qr'listing', "Can call plugin/listing" ); } { my $simple = ( Template::Declare->show('/plugin/search')); like( $simple, qr'search' , "Can call /plugin/search"); $simple = ( Template::Declare->show('plugin/search')); like( $simple, qr'search' , "Can call plugin/search"); } 1; Template-Declare-0.47/t/namespace.t0000644000175000017500000000375012444202200016143 0ustar chmrrchmrruse strict; use warnings; use Test::More tests => 5; ### TEST 1: package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags 'XUL', HTML => { namespace => 'html' }; template main => sub { groupbox { caption { attr { label => 'Colors' } } html::div { html::p { 'howdy!' } } html::br {} } }; package main; Template::Declare->init( dispatch_to => ['MyApp::Templates']); my $out = Template::Declare->show('main') . "\n"; is $out, <<_EOC_; howdy! _EOC_ ### TEST 2: package MyApp::Templates2; use base 'Template::Declare'; use Template::Declare::Tags 'XUL', HTML => { namespace => 'htm', package => 'MyHtml' }; template main => sub { groupbox { caption { attr { label => 'Colors' } } MyHtml::div { MyHtml::p { 'howdy!' } } MyHtml::br {} html::label {} } }; eval "htm::div {};"; ::ok $@, 'htm:: is invalid'; ::ok !defined &htm::div, 'package htm is intact'; package main; Template::Declare->init( dispatch_to => ['MyApp::Templates']); Template::Declare->init( dispatch_to => ['MyApp::Templates2']); $out = Template::Declare->show('main') . "\n"; is $out, <<_EOC_; howdy! _EOC_ ### TEST 3: package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags HTML => { namespace => 'blah', from => 't::MyTagSet' }, Blah => { namespace => undef, from => 't::MyTagSet' }; template main => sub { foo { blah::bar { attr { label => 'Colors' } } blah::baz { 'howdy!' } } }; package main; Template::Declare->init( dispatch_to => ['MyApp::Templates']); $out = Template::Declare->show('main') . "\n"; is $out, <<_EOC_; howdy! _EOC_ Template-Declare-0.47/t/indexhtml.t0000644000175000017500000000141612442630701016211 0ustar chmrrchmrruse warnings; use strict; package Wifty::UI; use base qw/Template::Declare/; use Template::Declare::Tags; use Test::More tests => 4; template 'index.html' => sub { html { head {}; body { show 'my/content'; } } }; template 'dash-test' => sub { html { head {}; body { show 'my/content'; } } }; template 'my/content' => sub { div { attr { id => 'body' } outs('This is my content') } }; require "t/utils.pl"; Template::Declare->init(dispatch_to => ['Wifty::UI']); for('index.html', 'dash-test'){ { Template::Declare->buffer->clear; my $simple =(show($_)); ok($simple =~ 'This is my content'); #diag ($simple); ok_lint($simple); } } 1; Template-Declare-0.47/t/utils.pl0000644000175000017500000000133512442630701015525 0ustar chmrrchmrruse warnings; use strict; use Test::More; sub ok_lint { my ($html, $ignore_chars) = @_; SKIP: { skip "HTML::Lint not installed. Skipping", 1 unless eval { require HTML::Lint; 1 }; my $lint = HTML::Lint->new; do { local $SIG{__WARN__} = sub {}; # STFU HTML::Lint! $lint->parse($html); }; # Collect the errors, ignore the invalid character errors when requested. my @errors = $ignore_chars ? grep { $_->errcode ne 'text-use-entity' } $lint->errors : $lint->errors; is( @errors, 0, "Lint checked clean" ); foreach my $error ( @errors ) { diag( $error->as_string ); } } } 1; Template-Declare-0.47/t/trivial.t0000644000175000017500000001146712442630701015676 0ustar chmrrchmrruse warnings; use strict; package Wifty::UI; use base qw/Template::Declare/; use Template::Declare::Tags; use Test::More tests => 9; template simple => sub { html { head { } body { show 'content' } } }; template content => sub { div { attr { id => 'body' } outs('This is my content') } }; sub wrap { my ( $title, $coderef) = (@_); outs_raw ''; with ( xmlns => "http://www.w3.org/1999/xhtml", 'xml:lang' => "en"), html { head { meta { attr { 'http-equiv' => "content-type", 'content' => "text/html; charset=utf-8" } } meta { attr { name => 'robots', content => 'all' } } title { outs($title) } } body { $coderef->(); } } }; template markup => sub { my $self = shift; wrap( 'My page!', sub { with( id => 'syntax' ), div { div { a { attr { href => '#', onclick => "Element.toggle('syntax_content');return(false);" } b {'Wiki Syntax Help'} } }; with( id => 'syntax_content' ), div { h3 {'Phrase Emphasis'} code { b { '**bold**' } i {'_italic_'} } h3 {'Links'} code {'Show me a [wiki page](WikiPage)'} code {'An [example](http://url.com/ "Title")'} h3 {'Headers'} pre { code { join( "\n", '# Header 1', '## Header 2', '###### Header 6' ) } } h3 {'Lists'} p {'Ordered, without paragraphs:'} pre { code { join( "\n", '1. Foo', '2. Bar' ) } } p {'Unordered, with paragraphs:'} pre { code { join( "\n", '* A list item.', 'With multiple paragraphs.', '* Bar' ) } } h3 {'Code Spans'} p { code {'`<code>`'} . 'spans are delimited by backticks.' } h3 {'Preformatted Code Blocks'} p { 'Indent every line of a code block by at least 4 spaces.' } pre { code { 'This is a normal paragraph.' . "\n\n" . "\n" . ' This is a preformatted' . "\n" . ' code block.' } } h3 {'Horizontal Rules'} p { 'Three or more dashes: ' . code {'---'} } address { '(Thanks to Daring Fireball)' } } } script { qq{ // javascript flyout by Eric Wilhelm // TODO use images for minimize/maximize button // Is there a way to add a callback? Element.toggle('syntax_content') } } } ) }; package Template::Declare::Tags; require "t/utils.pl"; use Test::More; our $self; local $self = {}; bless $self, 'Wifty::UI'; Template::Declare->init( dispatch_to => ['Wifty::UI']); { Template::Declare->buffer->clear; my $simple =(show('simple')); ok($simple =~ 'This is my content', "show fucntion returned context "); #diag ($simple); ok_lint($simple); } { Template::Declare->buffer->clear; my $simple =Template::Declare->show('simple'); ok($simple =~ 'This is my content', "T::D->show returns a string"); #diag ($simple); ok_lint($simple); } { Template::Declare->buffer->clear; Template::Declare->show('simple'); ok(Template::Declare->buffer->data() =~ 'This is my content', "show simple filled the buffer"); #diag ($simple); ok_lint(Template::Declare->buffer->data()); } { Template::Declare->buffer->clear; my $out = (show('markup')); #diag($out); my @lines = split("\n",$out); ok($out =~ /Fireball/, "We found fireball in the output"); my $count = grep { /Fireball/} @lines; is($count, 1, "Only found one"); ok_lint($out); } 1; Template-Declare-0.47/t/tagset_rdf_em.t0000644000175000017500000000210012442630701017007 0ustar chmrrchmrruse strict; use warnings; package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags 'RDF::EM' => { namespace => 'em' }, 'RDF'; template foo => sub { RDF { attr { 'xmlns' => "http://www.w3.org/1999/02/22-rdf-syntax-ns#", 'xmlns:em' => 'http://www.mozilla.org/2004/em-rdf#' } Description { attr { about => 'urn:mozilla:install-manifest' } em::id { 'foo@bar.com' } em::version { '1.2.0' } em::type { '2' } em::creator { 'Agent Zhang' } } } }; package main; use Test::More tests => 1; Template::Declare->init( dispatch_to => ['MyApp::Templates']); my $out = Template::Declare->show('foo') . "\n"; is $out, <<'_EOC_'; foo@bar.com 1.2.0 2 Agent Zhang _EOC_ Template-Declare-0.47/t/subtemplates.t0000644000175000017500000000250112442630701016721 0ustar chmrrchmrruse warnings; use strict; package Wifty::UI; use base qw/Template::Declare/; use Template::Declare::Tags; use Test::More tests => 9; require "t/utils.pl"; template simple => sub { html { head { }; body { show 'my/content' } } }; template toplevel => sub { html { head {}; body { show 'content' } }; }; template 'my/content' => sub { div { attr { id => 'body' }; p {'This is my content'} } }; template 'my/wrapper' => sub { show './content'; }; template 'content' => sub { p { 'TOPLEVEL CONTENT'}; }; Template::Declare->init(dispatch_to => ['Wifty::UI']); { Template::Declare->buffer->clear; my $simple =(show('my/content')); ok($simple =~ 'This is my content'); #diag ($simple); ok_lint($simple); } { Template::Declare->buffer->clear; my $simple =(show('simple')); ok($simple =~ 'This is my content'); #diag ($simple); ok_lint($simple); } { Template::Declare->buffer->clear; my $simple = (show('toplevel')); #diag $simple; ok ($simple =~ /TOPLEVEL/, "CAlling /toplevel does call /content"); ok_lint($simple); } { Template::Declare->buffer->clear; my $simple = (show('my/wrapper')); ok ($simple !~ /TOPLEVEL/, " Calling my/wrapper doesn't call /content" ); ok ($simple =~/my content/, "calling my/wrapper does call my/content"); ok_lint($simple); } 1; Template-Declare-0.47/t/arg-declaration-styles.t0000644000175000017500000000467212442630701020601 0ustar chmrrchmrruse warnings; use strict; package TestApp::UI; use base qw/Template::Declare/; use Template::Declare::Tags; template content => sub { with( id => 'body' ), div { outs('This is my content'); }; }; template content_curly => sub { div { { id is 'body' } outs('This is my content'); } }; template content_explicit => sub { div { attr { id is 'body' } outs('This is my content'); } }; template content_mixed1 => sub { div { { class is 'text' } attr { style => 'red', id is 'body' } outs('This is my red body text'); } }; template content_mixed2 => sub { with( class => 'text' ), div { { id is 'body' } attr { style => 'red' }; # Semicolon is intentional here outs('This is my red body text'); } }; template content_withs => sub { with( class => 'text', id => 'body', style => 'red' ), div { outs('This is my red body text'); } }; template content_curlies => sub { div { { class is 'text', id is 'body', style is 'red' } outs('This is my red body text'); } }; template content_attrs => sub { div { attr { class => 'text', id => 'body', style => 'red' } outs('This is my red body text'); } }; use Test::More tests => 39; require "t/utils.pl"; Template::Declare->init(dispatch_to => ['TestApp::UI']); for (qw(content content_curly content_explicit)) { Template::Declare->buffer->clear; ok_content( show_page($_), $_ ); } for ( qw(content_mixed1 content_mixed2 content_attrs content_withs content_curlies) ) { Template::Declare->buffer->clear; ok_multicontent( show_page($_), $_ ); } sub ok_multicontent { my $simple = shift; my $test = shift; like( $simple, qr{This is my red body text}, $test ); like( $simple, qr{^
    This is my red body text\s*
    $}m, $test ); like( $simple, qr{class="text"}, $test ); like( $simple, qr{style="red"}, $test ); like( $simple, qr{id="body"}, $test ); #diag ($simple); ok_lint($simple); } sub ok_content { my $simple = shift; my $test = shift; like( $simple, qr{This is my content}, $test ); like( $simple, qr{
    This is my content\s*
    }, $test ); #diag ($simple); ok_lint($simple); } 1; Template-Declare-0.47/t/closures.t0000644000175000017500000000463012442630701016055 0ustar chmrrchmrruse warnings; use strict; package TestApp::UI; use base qw/Template::Declare/; use Template::Declare::Tags; use Test::More tests => 16; template simple => sub { html { head { } body { show 'content' } } }; template content => sub { div { attr { id => 'body' } outs('This is my content') } }; template closure_1 => sub { my $item = b { 'Bolded'}; i { $item->() }; }; template closure_2 => sub { my $item = b { 'Bolded'}; i { $item }; }; template closure_3 => sub { my $item = b { 'Bolded'}; i { outs_raw($item)}; }; template closure_4 => sub { my $item = b { 'Bolded'}; i { "My ". $item}; }; template closure_5 => sub { my $item = b { 'Bolded'}; i { "My " , $item}; }; template closure_6 => sub { outs('I decided to do '), i{'Something else'}, outs(' rather than ') }; package Template::Declare::Tags; require "t/utils.pl"; use Test::More; our $self; local $self = {}; bless $self, 'TestApp::UI'; Template::Declare->init( dispatch_to => ['TestApp::UI']); { Template::Declare->buffer->clear; my $simple =(show('simple')); ok($simple =~ 'This is my content'); #diag ($simple); ok_lint($simple); } { Template::Declare->buffer->clear; my $simple =Template::Declare->show('simple'); ok($simple =~ 'This is my content'); #diag ($simple); ok_lint($simple); } { Template::Declare->buffer->clear; Template::Declare->show('simple'); ok(Template::Declare->buffer->data() =~ 'This is my content'); ok_lint(Template::Declare->buffer->data()); } for (qw(closure_1 closure_2 )) { Template::Declare->buffer->clear; my $simple = Template::Declare->show($_); #diag ($simple); like($simple, qr/\s*\s*Bolded\s*<\/b>\s*<\/i>/ms, "$_ matched"); ok_lint($simple); } for (qw(closure_3)) { Template::Declare->buffer->clear; my $simple = Template::Declare->show($_); #diag ($simple); like($simple, qr/\s*\s*Bolded\s*<\/b>\s*<\/i>/ms, "$_ matched"); ok_lint($simple); for (qw(closure_5)) { Template::Declare->buffer->clear; my $simple = Template::Declare->show($_); ok($simple =~ /My\s*Bolded\s*<\/b>\s*<\/i>/ms, "Showed $_"); #diag ($simple); ok_lint(Template::Declare->buffer->data()); } { Template::Declare->buffer->clear; my $simple = Template::Declare->show('closure_6'); ok($simple =~ /I decided to do\s*\s*Something else\s*<\/i>/); #diag ($simple); ok_lint(Template::Declare->buffer->data()); } }; 1; Template-Declare-0.47/t/tagset_mix.t0000644000175000017500000000164312442630701016363 0ustar chmrrchmrruse strict; use warnings; package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags qw/ HTML XUL /; template main => sub { groupbox { caption { attr { label => 'Colors' } } radiogroup { for my $id ( qw< orange violet yellow > ) { radio { attr { id => $id, label => ucfirst($id), $id eq 'violet' ? (selected => 'true') : () } } } } html { body { p { 'hi' } } } } }; package main; use Test::More tests => 1; Template::Declare->init( dispatch_to => ['MyApp::Templates']); my $out = Template::Declare->show('main') . "\n"; is $out, <<_EOC_;

    hi

     _EOC_ Template-Declare-0.47/t/wrappers.t0000644000175000017500000000170312442630701016057 0ustar chmrrchmrr#!/usr/bin/perl package MyApp::Templates; use strict; use warnings; use Template::Declare::Tags; use base 'Template::Declare'; BEGIN { create_wrapper wrap => sub { my $code = shift; my %params = @_; html { head { title { outs "Hello, $params{user}!"} }; body { $code->(); div { outs 'This is the end, my friend' }; }; } }; } template inner => sub { wrap { h1 { outs "Hello, Jesse, s'up?" }; } user => 'Jesse'; }; package main; use strict; use warnings; use Test::More tests => 2; use Template::Declare; Template::Declare->init(dispatch_to => ['MyApp::Templates']); ok my $out = Template::Declare->show('inner'), 'Get inner output'; is $out, ' Hello, Jesse!

    Hello, Jesse, s'up?

    This is the end, my friend
    ', 'Should have the wrapped output'; Template-Declare-0.47/t/deep_mixing.t0000644000175000017500000000500712442630701016505 0ustar chmrrchmrruse warnings; use strict; ############################################################################## package SearchPlugin::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'search' => sub { h1 {'SearchPlugin::View::search'}; }; ############################################################################## package ListPlugin::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'listing' => sub { h1 {'ListPlugin::View::listing'}; }; mix SearchPlugin::View under '/'; ############################################################################## package MyApp::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'toplevel' => sub {h1{'Toplevel'}}; mix ListPlugin::View under '/plugin'; ############################################################################## package main; Template::Declare->init( dispatch_to => ['MyApp::View'] ); use Test::More tests => 14; use Test::Warn; require "t/utils.pl"; ok( MyApp::View->has_template('toplevel'), 'Should have toplevel template' ); ok( !MyApp::View->has_template('listing'), "the listing template isn't imported to the top level"); ok( !MyApp::View->has_template('search'), "The search template isn't imported to the top level" ); ok( MyApp::View->has_template('/plugin/listing'), 'has listing template' ); ok( MyApp::View->has_template('/plugin/search'), 'has search template' ); { my $simple = ( Template::Declare->show('toplevel')); like( $simple, qr'Toplevel', 'Can execute toplevel template' ); } { warning_like { my $simple = ( Template::Declare->show('listing') ||''); unlike( $simple, qr'listing', 'Cannot call a toplevel "listing" template' ); } qr/The template 'listing' could not be found/, "listing is private" } warning_like { my $simple = ( Template::Declare->show('search')||''); unlike( $simple, qr'search', "Cannot call a toplevel /search" ); } qr/The template 'search' could not be found/, "Search could not be found"; { my $simple = ( Template::Declare->show('/plugin/listing')); like( $simple, qr'listing', "Can call /plugin/listing" ); $simple = ( Template::Declare->show('plugin/listing')); like( $simple, qr'listing', "Can call plugin/listing" ); } { my $simple = ( Template::Declare->show('/plugin/search')); like( $simple, qr'search' , "Can call /plugin/search"); $simple = ( Template::Declare->show('plugin/search')); like( $simple, qr'search' , "Can call plugin/search"); } 1; Template-Declare-0.47/t/tagset_html.t0000644000175000017500000000215112442630701016525 0ustar chmrrchmrruse strict; use warnings; package MyApp::Templates; use base 'Template::Declare'; use Template::Declare::Tags qw/ HTML /; my $time; template main => sub { $time = time; caption { attr { id => 'a' } } link {}; table { row { cell { "Hello, world!" } }; row { cell { datetime { $time } }; }; } img { attr { src => 'cat.gif' } } label {} canvas { attr { id => 'foo' } } }; package main; use Test::More tests => 4; use Template::Declare::TagSet::HTML; my $tagset = Template::Declare::TagSet::HTML->new(); ok $tagset->can_combine_empty_tags('img'), ''; ok !$tagset->can_combine_empty_tags('label'), ''; ok !$tagset->can_combine_empty_tags('caption'), ''; Template::Declare->init( dispatch_to => ['MyApp::Templates']); my $out = Template::Declare->show('main') . "\n"; is $out, <<_EOC_;
    Hello, world!
    _EOC_ Template-Declare-0.47/t/rt-37622.t0000644000175000017500000000134612442630701015325 0ustar chmrrchmrr#!/usr/bin/env perl package MyTemplates; use strict; use warnings; use Template::Declare::Tags; use base 'Template::Declare'; sub wrap (&) { my $code = shift; smart_tag_wrapper { my %p = @_; html { head { title { $p{title} } }; $code->(); div { outs 'footer'; } } } } template 'test' => sub { with(title => 'Test'), wrap { h1 { "Hello, world!" } }; }; package main; use Test::More tests => 2; Template::Declare->init(dispatch_to => ['MyTemplates']); my $output = Template::Declare->show('test'); unlike($output, qr{}); like($output, qr{\s*Test\s*}); Template-Declare-0.47/t/relative-mixing.t0000644000175000017500000000500712442630701017321 0ustar chmrrchmrruse warnings; use strict; ############################################################################## package SearchPlugin::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'search' => sub { h1 {'SearchPlugin::View::search'}; }; ############################################################################## package ListPlugin::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'listing' => sub { h1 {'ListPlugin::View::listing'}; }; mix SearchPlugin::View under '/'; ############################################################################## package MyApp::View; use base qw/Template::Declare/; use Template::Declare::Tags; template 'toplevel' => sub {h1{'Toplevel'}}; mix ListPlugin::View under 'plugin/'; ############################################################################## package main; Template::Declare->init( dispatch_to => ['MyApp::View'] ); use Test::More tests => 14; use Test::Warn; require "t/utils.pl"; ok( MyApp::View->has_template('toplevel'), 'Should have toplevel template' ); ok( !MyApp::View->has_template('listing'), "the listing template isn't imported to the top level"); ok( !MyApp::View->has_template('search'), "The search template isn't imported to the top level" ); ok( MyApp::View->has_template('/plugin/listing'), 'has listing template' ); ok( MyApp::View->has_template('/plugin/search'), 'has search template' ); { my $simple = ( Template::Declare->show('toplevel')); like( $simple, qr'Toplevel', 'Can execute toplevel template' ); } { warning_like { my $simple = ( Template::Declare->show('listing') ||''); unlike( $simple, qr'listing', 'Cannot call a toplevel "listing" template' ); } qr/The template 'listing' could not be found/, "listing is private" } warning_like { my $simple = ( Template::Declare->show('search')||''); unlike( $simple, qr'search', "Cannot call a toplevel /search" ); } qr/The template 'search' could not be found/, "Search could not be found"; { my $simple = ( Template::Declare->show('/plugin/listing')); like( $simple, qr'listing', "Can call /plugin/listing" ); $simple = ( Template::Declare->show('plugin/listing')); like( $simple, qr'listing', "Can call plugin/listing" ); } { my $simple = ( Template::Declare->show('/plugin/search')); like( $simple, qr'search' , "Can call /plugin/search"); $simple = ( Template::Declare->show('plugin/search')); like( $simple, qr'search' , "Can call plugin/search"); } 1; Template-Declare-0.47/t/private.t0000644000175000017500000000340512442630701015667 0ustar chmrrchmrruse warnings; use strict; package Wifty::UI; use base qw/Template::Declare/; use Template::Declare::Tags; template simple => sub { html { head {}; body { show 'private-content'; show 'other-content'; }; } }; private template 'private-content' => sub { with( id => 'private-content-body' ), div { outs('This is my content'); }; }; private template 'other-content' => sub { with( id => 'other-content-body' ), div { outs('This is other content'); }; }; template 'private_not_found' => sub { show('does_not_exist'); }; package main; use Template::Declare::Tags; Template::Declare->init(dispatch_to => ['Wifty::UI']); use Test::More tests => 14; use Test::Warn; require "t/utils.pl"; { my $simple = ( show('simple') ); like( $simple, qr'This is my content' ); like( $simple, qr'This is other content' ); ok_lint($simple); } { my $simple; warning_like { $simple = ( show('does_not_exist') )||''; } qr/could not be found.*private/, "got warning"; unlike( $simple , qr'This is my content' ); ok_lint($simple); } { my $simple; warning_like { $simple = ( show('private_not_found') ); } qr/could not be found/, "got warning"; unlike( $simple , qr'This is my content' ); ok_lint($simple); } { my $simple; warning_like { $simple = ( show('private-content') ||''); } qr/could not be found.*private/, "got warning"; unlike( $simple , qr'This is my content', "Can't call private templates" ); ok_lint($simple); } { my $simple; warning_like { $simple = ( Template::Declare->show('private-content') ); } qr/could not be found.*private/, "got warning"; is($simple, ''); } 1; Template-Declare-0.47/t/99-pod-spelling.t0000644000175000017500000000120312442630701017043 0ustar chmrrchmrr#!/usr/bin/env perl -w use strict; use Test::More; eval "use Test::Spelling"; plan skip_all => "Test::Spelling required for testing POD spelling" if $@; plan skip_all => "Coverage tests only run for authors" unless (-d 'inc/.author'); add_stopwords(); local $ENV{LC_ALL} = 'C'; set_spell_cmd('aspell list -l en'); all_pod_files_spelling_ok(); __DATA__ API CMS Mixin Mixins PHP Postprocessing RDF XUL inline invocant mixin mixins mixin's namespace postprocessor Zhang namespaces postprocessing ATTR OO TAGNAME TAGSET TEMPLATENAME WRAPPERNAME LLC attr PARAMS XHTML Mozilla's rdf frob init lookup nanotubes postprocess streamy webpage Template-Declare-0.47/t/alternative.t0000644000175000017500000000130412442630701016527 0ustar chmrrchmrruse strict; use warnings; use Test::More tests => 7; package MyApp::Templates; use Template::Declare::Tags 'HTML'; eval "td { 'hi' }"; ::ok $@, 'td is invalid'; ::is $@, "td {...} is invalid; use cell {...} instead.\n"; eval "tr { 'hi' }"; ::ok $@, 'tr is invalid'; ::like $@, qr/Transliteration replacement not terminated/; eval "base { 'hi' }"; ::ok $@; ::like $@, qr/Can't locate object method "base"/; package MyApp::Templates2; use base 'Template::Declare'; use Template::Declare::Tags 'XUL'; template main => sub { xul_tempalte {} }; Template::Declare->init( dispatch_to => ['MyApp::Templates2']); my $out = Template::Declare->show('main') . "\n"; ::is $out, <<_EOC_;