Permalink
Browse files

Refactor for testing

  • Loading branch information...
1 parent 0ba95c4 commit 351d998e740631002963267a104d652c907cd0af @perlpilot committed Dec 14, 2011
Showing with 199 additions and 101 deletions.
  1. +1 −0 dist.ini
  2. +112 −98 lib/Dancer/Plugin/TTHelpers.pm
  3. +0 −3 t/00-basic.t
  4. +27 −0 t/01-button.t
  5. +16 −0 t/02-hidden.t
  6. +16 −0 t/03-text.t
  7. +27 −0 t/foo
View
@@ -19,6 +19,7 @@ copyright_year = 2011
[Prereqs / TestRequires]
Template = 0
+Test::XPath = 0
[SubmittingPatches]
[PkgVersion]
@@ -137,6 +137,19 @@ use Dancer ':syntax';
use Try::Tiny;
use Scalar::Util qw/ blessed /;
+hook 'before_template' => sub {
+ my $tokens = shift;
+
+ $tokens->{css} = \&css;
+ $tokens->{js} = \&js;
+ $tokens->{radio} = \&radio;
+ $tokens->{text} = \&text;
+ $tokens->{select} = \&select;
+ $tokens->{button} = \&button;
+ $tokens->{checkbox} = \&checkbox;
+ $tokens->{hidden} = \&hidden;
+};
+
sub make_attribute_string {
return defined $_[0]
? join " ", map { $_ . '="' . $_[0]->{$_} . '"' } keys %{$_[0]}
@@ -157,109 +170,110 @@ sub process_attributes {
sub compute_idx {
my $obj = shift;
- my $idx = try { $obj->can('id') && "[" . ($obj->id // "") . "]" } catch { "[]" };
+ my $idx = try { $obj->can('id') && "[" . ($obj->id // "") . "]" } catch { "" };
return $idx;
}
-hook 'before_template' => sub {
- my $tokens = shift;
+sub js {
+ my $attributes = &process_attributes;
+ my ( $uri, $ie_cond ) = @_;
+ $uri .= '.css' unless $uri =~ /\.css$/;
+ return
+ ($ie_cond ? "<!--[if $ie_cond]>" : '')
+ . qq(<link rel='stylesheet' href=')
+ . request->uri_base . "/css/$uri"
+ . qq(' type='text/css' $attributes />)
+ . ($ie_cond ? "<![endif]-->" : '');
+}
+
+sub css {
+ my ( $uri, $ie_cond ) = @_;
+ $uri .= '.js' unless $uri =~ /\.js$/;
+ return
+ ($ie_cond ? "<!--[if $ie_cond]>" : '')
+ . qq(<script languages='javascript' src=')
+ . request->uri_base . "/js/$uri"
+ . qq(' type='text/javascript'></script>)
+ . ($ie_cond ? "<![endif]-->" : '');
+}
+
+
+sub radio {
+ my $obj = shift if blessed $_[0];
+ my $attributes = &process_attributes;
+ my ($name, $values, $sep) = @_;
+ $sep ||= '';
+ my ($i, @ret) = 0;
+ my $on = do { try { $obj->$name } } // @{$values}[0];
+ my $idx = compute_idx($obj);
+ while ($i < @$values) {
+ my ($val,$disp) = @{$values}[$i, $i+1];
+ my $checked = $on eq $val ? 'checked="checked"' : "";
+ push @ret, qq(<input type="radio" name="$name$idx" value="$val" $checked $attributes />$disp);
+ } continue { $i+=2 }
+ return ref $sep eq 'ARRAY' ? @ret : join $sep,@ret;
+}
+
- $tokens->{css} = sub {
- my $attributes = &process_attributes;
- my ( $uri, $ie_cond ) = @_;
- $uri .= '.css' unless $uri =~ /\.css$/;
- return
- ($ie_cond ? "<!--[if $ie_cond]>" : '')
- . qq(<link rel='stylesheet' href=')
- . request->uri_base . "/css/$uri"
- . qq(' type='text/css' $attributes />)
- . ($ie_cond ? "<![endif]-->" : '');
- };
-
- $tokens->{js} = sub {
- my ( $uri, $ie_cond ) = @_;
- $uri .= '.js' unless $uri =~ /\.js$/;
- return
- ($ie_cond ? "<!--[if $ie_cond]>" : '')
- . qq(<script languages='javascript' src=')
- . request->uri_base . "/js/$uri"
- . qq(' type='text/javascript'></script>)
- . ($ie_cond ? "<![endif]-->" : '');
- };
-
- $tokens->{radio} = sub {
- my $obj = shift if blessed $_[0];
- my $attributes = &process_attributes;
- my ($name, $values, $sep) = @_;
- $sep ||= '';
- my ($i, @ret) = 0;
- my $on = do { try { $obj->$name } } // @{$values}[0];
- my $idx = compute_idx($obj);
- while ($i < @$values) {
- my ($val,$disp) = @{$values}[$i, $i+1];
- my $checked = $on eq $val ? 'checked="checked"' : "";
- push @ret, qq(<input type="radio" name="$name$idx" value="$val" $checked $attributes />$disp);
- } continue { $i+=2 }
- return ref $sep eq 'ARRAY' ? @ret : join $sep,@ret;
- };
-
- $tokens->{text} = sub {
- my $obj = shift if blessed $_[0];
- my $attributes = &process_attributes;
- my ($name, $value) = @_;
- my $idx = compute_idx($obj);
- my $val = do { try { $obj->$name } } // $value // "";
- return qq(<input type="text" name="$name$idx" value="$val" $attributes />);
- };
-
- $tokens->{select} = sub {
- my $obj = shift if blessed $_[0];
- my $attributes = &process_attributes;
- my ($name, $options, $key, $value) = @_;
- my $idx = compute_idx($obj);
- my $str = $name ? qq(<select name="$name$idx" $attributes>) : "<select>";
- my $on = $obj && $name ? ($obj->$name // "") : "";
- for my $o (@$options) {
- my ($disp, $val);
- if ($key && $value) {
- $disp = do { try { $o->$value } catch { $o->{$value} } } // "";
- $val = do { try { $o->$key } catch { $o->{$key} } } // "";
- } else {
- $disp = $val = $o;
- }
- my $selected = $on eq $val ? " selected" : "";
- $str .= qq(<option value="$val"$selected>$disp</option>);
+sub text {
+ my $obj = shift if blessed $_[0];
+ my $attributes = &process_attributes;
+ my ($name, $value) = @_;
+ my $idx = compute_idx($obj);
+ my $val = do { try { $obj->$name } } // $value // "";
+ return qq(<input type="text" name="$name$idx" value="$val" $attributes />);
+}
+
+
+sub select {
+ my $obj = shift if blessed $_[0];
+ my $attributes = &process_attributes;
+ my ($name, $options, $key, $value) = @_;
+ my $idx = compute_idx($obj);
+ my $str = $name ? qq(<select name="$name$idx" $attributes>) : "<select>";
+ my $on = $obj && $name ? ($obj->$name // "") : "";
+ for my $o (@$options) {
+ my ($k, $v);
+ if (ref $o eq 'HASH') {
+ ($k,$v) = each %$o;
+ } elsif ($key && $value) {
+ $k = do { try { $o->$key } catch { $o->{$key} } } // "";
+ $v = do { try { $o->$value } catch { $o->{$value} } } // "";
+ } else {
+ $k = $v = $o;
}
- $str .= "</select>";
- return $str;
- };
-
- $tokens->{button} = sub {
- my $obj = shift if blessed $_[0];
- my $attributes = &process_attributes;
- my ($name, $value) = @_;
- $value //= $name;
- return qq(<input type="button" name="$name" value="$value" $attributes />);
- };
-
- $tokens->{hidden} = sub {
- my $obj = shift if blessed $_[0];
- my $attributes = &process_attributes;
- my ($name, $value) = @_;
- my $idx = compute_idx($obj);
- return qq(<input type="hidden" name="$name$idx" value="$value" $attributes />);
- };
-
- $tokens->{checkbox} = sub {
- my $obj = shift if blessed $_[0];
- my $attributes = &process_attributes;
- my ($name, $checked) = @_;
- my $idx = compute_idx($obj);
- $checked = try { $obj->$name } catch { $checked // 1 };
- $attributes .= " checked" if $checked;
- return qq(<input type="checkbox" name="$name$idx" value="1" $attributes />);
- };
+ $str .= qq(<option value="$k") . ($on eq $k ? " selected" : "") . qq(>$v</option>);
+ }
+ $str .= "</select>";
+ return $str;
+}
-};
+
+sub button {
+ my $obj = shift if blessed $_[0];
+ my $attributes = &process_attributes;
+ my ($name, $value) = @_;
+ $value //= $name;
+ return qq(<input type="button" name="$name" value="$value" $attributes />);
+}
+
+sub hidden {
+ my $obj = shift if blessed $_[0];
+ my $attributes = &process_attributes;
+ my ($name, $value) = @_;
+ my $idx = compute_idx($obj);
+ return qq(<input type="hidden" name="$name$idx" value="$value" $attributes />);
+}
+
+
+sub checkbox {
+ my $obj = shift if blessed $_[0];
+ my $attributes = &process_attributes;
+ my ($name, $checked) = @_;
+ my $idx = compute_idx($obj);
+ $checked = try { $obj->$name } catch { $checked // 1 };
+ $attributes .= " checked" if $checked;
+ return qq(<input type="checkbox" name="$name$idx" value="1" $attributes />);
+}
1;
View
@@ -2,10 +2,7 @@
use 5.10.0;
use Test::More tests => 1;
-use Dancer qw/ :syntax :tests /;
BEGIN { use_ok 'Dancer::Plugin::TTHelpers' }
-# More tests here!
-
1;
View
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+
+use 5.10.0;
+use Test::More tests => 8;
+use Dancer::Plugin::TTHelpers;
+use Test::XPath;
+
+{
+ my $generated = Dancer::Plugin::TTHelpers::button('foo');
+ my $tx = Test::XPath->new( xml => $generated, is_html => 1 );
+
+ $tx->ok('//input', 'Has input tag');
+ $tx->ok('//input[@type="button"]', 'input tag is a button');
+ $tx->ok('//input[@name="foo"]', 'input tag has name attr with value "foo"');
+ $tx->ok('//input[@value="foo"]', 'input tag has value attr with value "foo"');
+}
+
+{
+
+ my $generated = Dancer::Plugin::TTHelpers::button('foo', 'bar');
+ my $tx = Test::XPath->new( xml => $generated, is_html => 1 );
+
+ $tx->ok('//input', 'Has input tag');
+ $tx->ok('//input[@type="button"]', 'input tag is a button');
+ $tx->ok('//input[@name="foo"]', 'input tag has name attr with value "foo"');
+ $tx->ok('//input[@value="bar"]', 'input tag has value attr with value "bar"');
+}
View
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+
+use 5.10.0;
+use Test::More tests => 4;
+use Dancer::Plugin::TTHelpers;
+use Test::XPath;
+
+{
+ my $generated = Dancer::Plugin::TTHelpers::hidden('foo','bar');
+ my $tx = Test::XPath->new( xml => $generated, is_html => 1 );
+
+ $tx->ok('//input', "Has input tag");
+ $tx->ok('//input[@type="hidden"]', "\ttype = hidden");
+ $tx->ok('//input[@name="foo"]', "\tname = foo");
+ $tx->ok('//input[@value="bar"]', "\tvalue = bar");
+}
View
@@ -0,0 +1,16 @@
+#!/usr/bin/env perl
+
+use 5.10.0;
+use Test::More tests => 4;
+use Dancer::Plugin::TTHelpers;
+use Test::XPath;
+
+{
+ my $generated = Dancer::Plugin::TTHelpers::text('foo', 'bar');
+ my $tx = Test::XPath->new( xml => $generated, is_html => 1 );
+
+ $tx->ok('//input', "Has input tag");
+ $tx->ok('//input[@type="text"]', "\ttype = text");
+ $tx->ok('//input[@name="foo"]', "\tname = 'foo'");
+ $tx->ok('//input[@value="bar"]', "\tvalue = 'bar'");
+}
View
27 t/foo
@@ -0,0 +1,27 @@
+#!/usr/bin/env perl
+
+use 5.10.0;
+use Test::More tests => 8;
+use Dancer::Plugin::TTHelpers;
+use Test::XPath;
+
+{
+ my $generated = Dancer::Plugin::TTHelpers::button('foo');
+ my $tx = Test::XPath->new( xml => $generated, is_html => 1 );
+
+ $tx->ok('//input', 'Has input tag');
+ $tx->ok('//input[@type="button"]', 'input tag is a button');
+ $tx->ok('//input[@name="foo"]', 'input tag has name attr with value "foo"');
+ $tx->ok('//input[@value="foo"]', 'input tag has value attr with value "foo"');
+}
+
+{
+
+ my $generated = Dancer::Plugin::TTHelpers::button('foo', 'bar');
+ my $tx = Test::XPath->new( xml => $generated, is_html => 1 );
+
+ $tx->ok('//input', 'Has input tag');
+ $tx->ok('//input[@type="button"]', 'input tag is a button');
+ $tx->ok('//input[@name="foo"]', 'input tag has name attr with value "foo"');
+ $tx->ok('//input[@value="bar"]', 'input tag has value attr with value "bar"');
+}

0 comments on commit 351d998

Please sign in to comment.