+2.07 2007-01-30
+ * Add clear_app method which flushes items pertaining to navigation.
+ * Allow for CGI::Ex::Template PLUGIN_BASE to be a scalar OR an arrayref.
+ * Add sort keys to DUMP directive
+ * Add trim_control_chars as a validate directive
+ * Allow for . in the QR_PRIVATE of Template
+ * Add dump_parse_expr to CGI::Ex::Template
+ * Fix JSONDump to handle more number cases
+ * Fix JSONDump to output more IE friendly JS
+ * Allow fill to work only with form elements with attributes
+
2.06 2006-07-21
* Allow for JSONDump to swap --> to --"+">
* Fix memory issue in App with closures
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: CGI-Ex
-version: 2.06
+version: 2.07
version_from: lib/CGI/Ex.pm
installdirs: site
requires:
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+generated_by: ExtUtils::MakeMaker version 6.30_01
=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
use base qw(Exporter);
BEGIN {
- $VERSION = '2.06';
+ $VERSION = '2.07';
$PREFERRED_CGI_MODULE ||= 'CGI';
@EXPORT = ();
@EXPORT_OK = qw(get_form
This module may be distributed under the same terms as Perl itself.
=cut
-
-1;
###----------------------------------------------------------------###
# See the perldoc in CGI/Ex/App.pod
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
use vars qw($VERSION);
BEGIN {
- $VERSION = '2.06';
+ $VERSION = '2.07';
Time::HiRes->import('time') if eval {require Time::HiRes};
eval {require Scalar::Util};
return $self->{'stash'} ||= {};
}
+sub clear_app {
+ my $self = shift;
+
+ delete @{ $self }{qw(
+ cgix
+ vob
+ form
+ cookies
+ stash
+ path
+ path_i
+ history
+ __morph_lineage_start_index
+ __morph_lineage
+ hash_errors
+ hash_fill
+ hash_swap
+ hash_common
+ )};
+
+ return $self;
+}
+
###----------------------------------------------------------------###
### default hook implementations
=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
use Digest::MD5 qw(md5_hex);
use CGI::Ex;
-$VERSION = '2.06';
+$VERSION = '2.07';
###----------------------------------------------------------------###
=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
%CACHE
$HTML_KEY
@EXPORT_OK
+ $NO_WARN_ON_FAIL
);
@EXPORT_OK = qw(conf_read conf_write in_cache);
-$VERSION = '2.06';
+$VERSION = '2.07';
$DEFAULT_EXT = 'conf';
### don't die if the file is not found - do die otherwise
if (! -e $file) {
eval { die "Conf file $file not found" };
- warn "Conf file $file not found" if ! $args->{'no_warn_on_fail'};
+ warn "Conf file $file not found" if ! $args->{'no_warn_on_fail'} && ! $NO_WARN_ON_FAIL;
return;
}
=head1 FUNCTIONS
-=over4
+=over 4
=item conf_read
=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
use strict;
-use vars qw($no_recurse
+use vars qw($VERSION
+ $no_recurse
$EXTENDED_ERRORS $SHOW_TRACE $IGNORE_EVAL
$ERROR_TEMPLATE
$LOG_HANDLER $FINAL_HANDLER
use CGI::Ex::Dump qw(debug ctrace dex_html);
BEGIN {
+ $VERSION = '2.07';
$SHOW_TRACE = 0 if ! defined $SHOW_TRACE;
$IGNORE_EVAL = 0 if ! defined $IGNORE_EVAL;
$EXTENDED_ERRORS = 1 if ! defined $EXTENDED_ERRORS;
=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
use strict;
use Exporter;
-$VERSION = '2.06';
+$VERSION = '2.07';
@ISA = qw(Exporter);
@EXPORT = qw(dex dex_warn dex_text dex_html ctrace dex_trace);
@EXPORT_OK = qw(dex dex_warn dex_text dex_html ctrace dex_trace debug);
=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
use base qw(Exporter);
BEGIN {
- $VERSION = '2.06';
+ $VERSION = '2.07';
@EXPORT = qw(form_fill);
@EXPORT_OK = qw(fill form_fill html_escape get_tagval_by_key swap_tagval_by_key);
};
### First pass
### swap <input > form elements if they have a name
$$ref =~ s{
- (<input \s (?: ([\"\'])(?:|.*?[^\\])\2 | [^>] )* >) # nested html ok
+ (<input \s (?: ([\"\'])(?:|.*?[^\\])\2 | [^>] )+ >) # nested html ok
}{
### get the type and name - intentionally exlude names with nested "'
my $tag = $1;
my $opts = substr($$ref, $start[$i], $close[$i] - $start[$i]);
$opts =~ s{
(<select \s # opening
- (?: "" | '' | ([\"\']).*?[^\\]\2 | [^>] )* # nested html ok
+ (?: "" | '' | ([\"\']).*?[^\\]\2 | [^>] )+ # nested html ok
>) # end of tag
}{}sxi || next;
next if ! $opts;
my $oldval = substr($$ref, $start[$i] + $offset, $close[$i] - $start[$i]);
$oldval =~ s{
(<textarea \s # opening
- (?: "" | '' | ([\"\']).*?[^\\]\2 | [^>] )* # nested html ok
+ (?: "" | '' | ([\"\']).*?[^\\]\2 | [^>] )+ # nested html ok
>) # end of tag
}{}sxi || next;
my $tag = $1;
=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
use base qw(Exporter);
BEGIN {
- $VERSION = '2.06';
+ $VERSION = '2.07';
@EXPORT = qw(JSONDump);
@EXPORT_OK = @EXPORT;
return 'null' if ! defined $str;
### allow things that look like numbers to show up as numbers (and those that aren't quite to not)
- return $str if $str =~ /^ -? (?: \d{0,13} \. \d* [1-9] | \d{1,13}) $/x;
+ return $str if $str =~ /^ -? (?: [0-9]{0,13} \. \d* [1-9] | [1-9][0-9]{0,12}) $/x;
my $quote = $self->{'single_quote'} ? "'" : '"';
{
"a" : [
1,
- 2,
+ 2
]
}
Should contain an arrayref of keys or a hashref whose keys are the
keys to skip. Default is unset. Any keys of hashrefs (including
-nested hashrefs) that are in the skip_keys item will not be included
+nested hashrefs) that are listed in the skip_keys item will not be included
in the javascript output.
JSONDump({a => 1, b => 1}, {skip_keys => ['a'], pretty => 0});
=item indent
-The level to indent each nested data structure level if pretty is true. Default is " ".
+The level to indent each nested data structure level if pretty is true. Default is " " (two spaces).
=item hash_nl
=item str_nl
The whitespace to add in between newline separated strings if pretty is true or the output line is
-greater than 80 characters. Default is "\n".
+greater than 80 characters. Default is "\n" (if pretty is true).
JSONDump("This is a long string\n"
."with plenty of embedded newlines\n"
- ."and is greater than 80 characters.\n", {pretty => 1, str_nl => "\n"});
+ ."and is greater than 80 characters.\n", {pretty => 1});
Would print
+"with plenty of embedded newlines\n"
+"and is greater than 80 characters.\n"
+ JSONDump("This is a long string\n"
+ ."with plenty of embedded newlines\n"
+ ."and is greater than 80 characters.\n", {pretty => 1, str_nl => ""});
+
+ Would print
+
+ "This is a long string\nwith plenty of embedded newlines\nand is greater than 80 characters.\n"
+
If the string is less than 80 characters, or if str_nl is set to "", then the escaped
-string will be contained on a single line.
+string will be contained on a single line. Setting pretty to 0 effectively sets str_nl equal to "".
=back
###----------------------------------------------------------------###
# See the perldoc in CGI/Ex/Template.pod
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
);
BEGIN {
- $VERSION = '2.06';
+ $VERSION = '2.07';
$PACKAGE_EXCEPTION = 'CGI::Ex::Template::Exception';
$PACKAGE_ITERATOR = 'CGI::Ex::Template::Iterator';
$QR_NUM = '(?:\d*\.\d+ | \d+) (?: [eE][+-]\d+ )?';
$QR_AQ_NOTDOT = "(?! \\s* $QR_COMMENTS \\.)";
$QR_AQ_SPACE = '(?: \\s+ | \$ | (?=[;+]) )'; # the + comes into play on filenames
- $QR_PRIVATE = qr/^_/;
+ $QR_PRIVATE = qr/^[_.]/;
$WHILE_MAX = 1000;
$EXTRA_COMPILE_EXT = '.sto';
sub play_DUMP {
my ($self, $ident, $node) = @_;
require Data::Dumper;
+ local $Data::Dumper::Sortkeys = 1;
my $info = $self->node_info($node);
my $out;
my $var;
pop @var; # remove the trailing '.'
### look for a plugin_base
- my $base = $self->{'PLUGIN_BASE'} || 'Template::Plugin'; # I'm not maintaining plugins - leave that to TT
- my $package = $self->{'PLUGINS'}->{$module} ? $self->{'PLUGINS'}->{$module}
- : $self->{'PLUGIN_FACTORY'}->{$module} ? $self->{'PLUGIN_FACTORY'}->{$module}
- : "${base}::${module}";
- my $require = "$package.pm";
- $require =~ s|::|/|g;
-
- ### try and load the module - fall back to bare module if allowed
+ my $BASE = $self->{'PLUGIN_BASE'} || 'Template::Plugin'; # I'm not maintaining plugins - leave that to TT
my $obj;
- if ($self->{'PLUGIN_FACTORY'}->{$module} || eval {require $require}) {
- my $shape = $package->load;
- my $context = $self->context;
- my @args = $args ? map { $self->play_expr($_) } @$args : ();
- $obj = $shape->new($context, @args);
- } elsif (lc($module) eq 'iterator') { # use our iterator if none found (TT's works just fine)
- $obj = $PACKAGE_ITERATOR->new($args ? $self->play_expr($args->[0]) : []);
- } elsif (my @packages = grep {lc($package) eq lc($_)} @{ $self->list_plugins({base => $base}) }) {
- foreach my $package (@packages) {
- my $require = "$package.pm";
- $require =~ s|::|/|g;
- eval {require $require} || next;
+
+ foreach my $base (ref($BASE) eq 'ARRAY' ? @$BASE : $BASE) {
+ my $package = $self->{'PLUGINS'}->{$module} ? $self->{'PLUGINS'}->{$module}
+ : $self->{'PLUGIN_FACTORY'}->{$module} ? $self->{'PLUGIN_FACTORY'}->{$module}
+ : "${base}::${module}";
+ my $require = "$package.pm";
+ $require =~ s|::|/|g;
+
+ ### try and load the module - fall back to bare module if allowed
+ if ($self->{'PLUGIN_FACTORY'}->{$module} || eval {require $require}) {
my $shape = $package->load;
my $context = $self->context;
my @args = $args ? map { $self->play_expr($_) } @$args : ();
$obj = $shape->new($context, @args);
- }
- } elsif ($self->{'LOAD_PERL'}) {
- my $require = "$module.pm";
- $require =~ s|::|/|g;
- if (eval {require $require}) {
- my @args = $args ? map { $self->play_expr($_) } @$args : ();
- $obj = $module->new(@args);
+ } elsif (lc($module) eq 'iterator') { # use our iterator if none found (TT's works just fine)
+ $obj = $PACKAGE_ITERATOR->new($args ? $self->play_expr($args->[0]) : []);
+ } elsif (my @packages = grep {lc($package) eq lc($_)} @{ $self->list_plugins({base => $base}) }) {
+ foreach my $package (@packages) {
+ my $require = "$package.pm";
+ $require =~ s|::|/|g;
+ eval {require $require} || next;
+ my $shape = $package->load;
+ my $context = $self->context;
+ my @args = $args ? map { $self->play_expr($_) } @$args : ();
+ $obj = $shape->new($context, @args);
+ }
+ } elsif ($self->{'LOAD_PERL'}) {
+ my $require = "$module.pm";
+ $require =~ s|::|/|g;
+ if (eval {require $require}) {
+ my @args = $args ? map { $self->play_expr($_) } @$args : ();
+ $obj = $module->new(@args);
+ }
}
}
if (! defined $obj) {
###----------------------------------------------------------------###
sub dump_parse {
+ my $obj = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__->new;
+ my $str = shift;
+ require Data::Dumper;
+ return Data::Dumper::Dumper($obj->parse_tree(\$str));
+}
+
+sub dump_parse_expr {
my $obj = UNIVERSAL::isa($_[0], __PACKAGE__) ? shift : __PACKAGE__->new;
my $str = shift;
require Data::Dumper;
[% cet %]
- [% cet.dump_parse('1 + 2').replace('\s+', ' ') %]
+ [% cet.dump_parse_expr('1 + 2').replace('\s+', ' ') %]
Would print something like:
=item format
[% item.format('%d') %] Print the string out in the specified format. It is similar to
- the "as" virtual method, except that the item is split on newline and each line is
+ the "fmt" virtual method, except that the item is split on newline and each line is
processed separately.
=item hash
# The LOAD_PERL directive should be set to 1
[% USE cet = CGI::Ex::Template %]
- [%~ cet.dump_parse('2 * 3').replace('\s+', ' ') %]
+ [%~ cet.dump_parse_expr('2 * 3').replace('\s+', ' ') %]
Would print:
In order to not conflict with SET, FOREACH and other operations, this
operator is only available in parenthesis.
- [% a = 2 %][% a += 3 %] --- [% a %] => --- 5 # is was handled by SET
+ [% a = 2 %][% a += 3 %] --- [% a %] => --- 5 # is handled by SET
[% a = 2 %][% (a += 3) %] --- [% a %] => 5 --- 5
=item C<=>
to not conflict with SET, FOREACH and other operations, this operator is only
available in parenthesis. Returns the value of the righthand side.
- [% a = 1 %] --- [% a %] => --- 1 # is was handled by SET
+ [% a = 1 %] --- [% a %] => --- 1 # is handled by SET
[% (a = 1) %] --- [% a %] => 1 --- 1
=item C<not NOT>
Default value is Template::Plugin. The base module namespace
that template plugins will be looked for. See the USE directive
-for more information.
+for more information. May be either a single namespace, or an arrayref
+of namespaces.
=item POST_CHOMP
The following perl can be typed at the command line to view the parsed variable tree:
- perl -e 'use CGI::Ex::Template; print CGI::Ex::Template::dump_parse("foo.bar + 2")."\n"'
+ perl -e 'use CGI::Ex::Template; print CGI::Ex::Template::dump_parse_expr("foo.bar + 2")."\n"'
Also the following can be included in a template to view the output in a template:
[% USE cet = CGI::Ex::Template %]
- [%~ cet.dump_parse('foo.bar + 2').replace('\s+', ' ') %]
+ [%~ cet.dump_parse_expr('foo.bar + 2').replace('\s+', ' ') %]
=head1 SEMI PUBLIC METHODS
=item C<dump_parse>
+This method allows for returning a Data::Dumper dump of a parsed template. It is mainly used for testing.
+
+=item C<dump_parse_expr>
+
This method allows for returning a Data::Dumper dump of a parsed variable. It is mainly used for testing.
=item C<exception>
=cut
###----------------------------------------------------------------###
-# Copyright 2006 - Paul Seamons #
+# Copyright 2007 - Paul Seamons #
# Distributed under the Perl Artistic License without warranty #
###----------------------------------------------------------------###
@UNSUPPORTED_BROWSERS
);
-$VERSION = '2.06';
+$VERSION = '2.07';
$DEFAULT_EXT = 'val';
$QR_EXTRA = qr/^(\w+_error|as_(array|string|hash)_\w+|no_\w+)/;
$value =~ s/\s+$//;
$modified = 1;
}
+ if ($field_val->{'trim_control_chars'}) {
+ $value =~ y/\t/ /;
+ $value =~ y/\x00-\x1F//d;
+ $modified = 1;
+ }
if ($field_val->{'to_upper_case'}) { # uppercase
$value = uc($value);
$modified = 1;
{field => 'foo', do_not_trim => 1}
+=item C<trim_control_chars>
+
+Off by default. If set to true, removes characters in the
+\x00 to \x31 range (Tabs are translated to a single space).
+
+ {field => 'foo', trim_control_chars => 1}
+
=item C<replace>
Pass a swap pattern to change the actual value of the form.
/**----------------------------------------------------------------***
-* Copyright 2006 - Paul Seamons *
+* Copyright 2007 - Paul Seamons *
* Distributed under the Perl Artistic License without warranty *
* Based upon CGI/Ex/Validate.pm v1.14 from Perl *
* For instructions on usage, see perldoc of CGI::Ex::Validate *
***----------------------------------------------------------------**/
-// $Revision: 1.36 $
+// $Revision: 1.38 $
function Validate () {
this.error = vob_error;
if (typeof(values[i]) == 'undefined') continue;
if (! this.filter_types('do_not_trim',types).length)
values[i] = values[i].replace('^\\s+','').replace(new RegExp('\\s+$',''),'');
+ if (this.filter_types('trim_control_chars',types).length)
+ values[i] = values[i].replace(new RegExp('\t', 'g'),' ').replace(new RegExp('[^\x00-\x1F]+','g'),'');
if (this.filter_types('to_upper_case',types).length) {
values[i] = values[i].toUpperCase();
} else if (this.filter_types('to_lower_case',types).length) {
/**----------------------------------------------------------------***
-* Copyright 2006 - Paul Seamons *
+* Copyright 2007 - Paul Seamons *
* Distributed under the Perl Artistic License without warranty *
* Based upon YAML.pm v0.35 from Perl *
***----------------------------------------------------------------**/
-// $Revision: 1.17 $
+// $Revision: 1.18 $
// allow for missing methods in ie 5.0
#push @config1, (INTERPOLATE => 1);
my @config2 = (@config1, COMPILE_EXT => '.ttc');
-#use CGI::Ex::Template209;
-#my $tt1 = CGI::Ex::Template209->new(@config1);
+#use CGI::Ex::Template::XS;
+#my $tt1 = CGI::Ex::Template::XS->new(@config1);
+#my $tt2 = CGI::Ex::Template::XS->new(@config2);
my $tt1 = Template->new(@config1);
my $tt2 = Template->new(@config2);
};
use strict;
-use Test::More tests => 514 - ($is_tt ? 103 : 0);
+use Test::More tests => 515 - ($is_tt ? 103 : 0);
use Data::Dumper qw(Dumper);
use constant test_taint => 0 && eval { require Taint::Runtime };
process_ok('[% a = Hash.new(one = "ONE") %][% a.one %]' => 'ONE') if ! $is_tt;
process_ok('[% a = Hash.new(one => "ONE") %][% a.one %]' => 'ONE') if ! $is_tt;
-process_ok('[% {a => 1, b => 2} | Hash.keys | List.join(", ") %]' => 'a, b');
+process_ok('[% {a => 1, b => 2} | Hash.keys | List.join(", ") %]' => 'a, b') if ! $is_tt;
###----------------------------------------------------------------###
### chomping
process_ok("[% USE a(bar = 'baz') %]one[% a.seven %]" => '', {tt_config => [@config_p, PLUGINS => {a=>'Foo'}, ]});
process_ok("[% USE a(bar = 'baz') %]one[% a.seven %]" => 'one7', {tt_config => [@config_p, PLUGINS => {a=>'Foo2'},]});
+@config_p = (PLUGIN_BASE => ['NonExistant', 'MyTestPlugin'], LOAD_PERL => 1);
+process_ok("[% USE Foo %]one" => 'one', {tt_config => \@config_p});
+
###----------------------------------------------------------------###
### macro
projects / chaz / p5-CGI-Ex / commitdiff
