Testing-code-and-assuring-quality-1196966365909693-4

Write tests for your code

A Simple Class

#!/usr/bin/perl use strict; use warnings; package myObj;

sub new { my $class = shift; my %args = @_; my $self = {}; $self->{ name } = $args{ name return bless $self, $class; } sub set_name { my $self = shift; $self->{ name } = shift; } sub get_name { my $self = shift; return $self->{ name }; } 1;

} || 'default';

A Simple Class

#!/usr/bin/perl use strict; use warnings; package myObj;

sub new { my $class = shift; my %args = @_; my $self = {}; $self->{ name } = $args{ name return bless $self, $class; } sub set_name { my $self = shift; $self->{ name } = shift; } sub get_name { my $self = shift; return $self->{ name }; } 1;

Constructor

(http://en.wikipedia.org/wiki/Constructor_%28computer_science%29)

} || 'default';

A Simple Class

#!/usr/bin/perl use strict; use warnings; package myObj;

sub new { my $class = shift; my %args = @_; my $self = {}; $self->{ name } = $args{ name return bless $self, $class; } sub set_name { my $self = shift; $self->{ name } = shift; } sub get_name { my $self = shift; return $self->{ name }; } 1;

Constructor

(http://en.wikipedia.org/wiki/Constructor_%28computer_science%29)

} || 'default';

Mutator

(http://en.wikipedia.org/wiki/Mutator_method)

A Simple Class

#!/usr/bin/perl use strict; use warnings; package myObj;

sub new { my $class = shift; my %args = @_; my $self = {}; $self->{ name } = $args{ name return bless $self, $class; } sub set_name { my $self = shift; $self->{ name } = shift; } sub get_name { my $self = shift; return $self->{ name }; } 1;

Constructor

(http://en.wikipedia.org/wiki/Constructor_%28computer_science%29)

} || 'default';

Mutator

(http://en.wikipedia.org/wiki/Mutator_method)

Accessor

(http://en.wikipedia.org/wiki/Accessor)

Using A Simple Class #!/usr/bin/perl use strict; use warnings; use myObj; ...

Using A Simple Class #!/usr/bin/perl use strict; use warnings; use myObj; my $obj = myObj->new( name => 'My Object' ); ...

Calling the Constructor

Using A Simple Class #!/usr/bin/perl use strict; use warnings; use myObj;

Calling the Constructor

my $obj = myObj->new( name => 'My Object' ); my $objName = $obj->get_name(); ...

Calling the Accessor

Using A Simple Class #!/usr/bin/perl use strict; use warnings; use myObj;

Calling the Constructor

my $obj = myObj->new( name => 'My Object' ); my $objName = $obj->get_name(); my $new_name = 'Your Object' ); $obj->set_name( $new_name );

Calling the Accessor Calling the Mutator

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan';

It's fine to start out without a testing plan (number of tests to run)

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); }

Make sure you can "use" the object

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); }

Make sure you can instantiate the object (call the constructor) ),

ok( my $obj1 = myObj->new( name => 'test1' "can create a myObj specifying values" );

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' "can create a myObj specifying values" isa_ok( $obj1, 'myObj' );

Make sure your ), ); instantiated object "isa" type of object you created

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' ), "can create a myObj specifying values" ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), "can create a myObj not specifying values" );

Instantiate another object

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' ), "can create a myObj specifying values" ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), "can create a myObj not specifying values" ); isa_ok( $obj2, 'myObj' );

Make sure the new object "isa" "myObj" object

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); }

Test using the mutator of the name property of the object

ok( my $obj1 = myObj->new( name => 'test1' ), "can create a myObj specifying values" ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), "can create a myObj not specifying values" ); isa_ok( $obj2, 'myObj' ); ok( $obj2->set_name( 'test1' ), "can set name" );

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); }

Make sure the accessor returns the value we just set

ok( my $obj1 = myObj->new( name => 'test1' ), "can create a myObj specifying values" ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), "can create a myObj not specifying values" ); isa_ok( $obj2, 'myObj' ); ok( $obj2->set_name( 'test1' ), "can set name" ); ok( 'test1' eq $obj2->get_name(), "can get name" );

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; BEGIN { use_ok( 'myObj' ); }

Perform a "deep" comparison of the two objects (created in ), different ways)

ok( my $obj1 = myObj->new( name => 'test1' "can create a myObj specifying values" ); isa_ok( $obj1, 'myObj' );

ok( my $obj2 = myObj->new(), "can create a myObj not specifying values" ); isa_ok( $obj2, 'myObj' ); ok( $obj2->set_name( 'test1' ), "can set name" ); ok( 'test1' eq $obj2->get_name(), "can get name" ); is_deeply( $obj1, $obj2, "obj1 seems deeply similar to obj2" );

Testing A Simple Class #!/usr/bin/perl use strict; use warnings; use Test::More tests => 8; BEGIN { use_ok( 'myObj' ); }

Specify the number of tests we intend to run

ok( my $obj1 = myObj->new( name => 'test1' ), "can create a myObj specifying values" ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), "can create a myObj not specifying values" ); isa_ok( $obj2, 'myObj' ); ok( $obj2->set_name( 'test1' ), "can set name" ); ok( 'test1' eq $obj2->get_name(), "can get name" ); is_deeply( $obj1, $obj2, "obj1 seems deeply similar to obj2" );

Testing A Simple Class Output: $ prove -v testobj.t testobj....1..8 ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 ok All tests successful. Files=1, Tests=8, 0 wallclock secs ( 0.02 cusr + = 0.03 CPU)

0.01 csys

That's great

but...

how does that help me? :-|

Testing Zfml $ cat testindex.t ... BEGIN { use_ok( 'index.zfml' ) }; ... $ prove testindex.t testindex.... # Failed test 'use index.zfml;' # in testindex.t at line 8. # Tried to use 'index.zfml'. # Error: syntax error at (eval 3) line 2, near "use index." # Looks like you failed 1 test of 1. testindex....dubious Test returned status 1 (wstat 256, 0x100) DIED. FAILED test 1 Failed 1/1 tests, 0.00% okay Failed Test Stat Wstat Total Fail List of Failed --------------------------------------------------------------------testindex.t 1 256 1 1 1 Failed 1/1 test scripts. 1/1 subtests failed. Files=1, Tests=1, 0 wallclock secs ( 0.03 cusr + 0.01 csys = 0.04 CPU) Failed 1/1 test programs. 1/1 subtests failed.

Ensuring your code is high* quality**

* for some values of high

** for some values of quality

Introducing Perl::Critic and perlcritic Perl::Critic(3)

User Contributed Perl Documentation

Perl::Critic(3)

NAME Perl::Critic - Critique Perl source code for best-practices SYNOPSIS use Perl::Critic; my $file = shift; my $critic = Perl::Critic->new(); my @violations = $critic->critique($file); print @violations; DESCRIPTION Perl::Critic is an extensible framework for creating and applying coding standards to Perl source code. Essentially, it is a static source code analysis engine. Perl::Critic is distributed with a number of Perl::Critic::Policy modules that attempt to enforce various coding guidelines. Most Policy modules are based on Damian Conway's book Perl Best Practices.

Introducing Perl::Critic and perlcritic PERLCRITIC(1)

User Contributed Perl Documentation

PERLCRITIC(1)

NAME "perlcritic" - Command-line interface to critique Perl source SYNOPSIS perlcritic [-12345 | -severity number] [-noprofile | -profile file] [-top [ number ]] [-include pattern] [-exclude pattern] [-theme expression] [-verbose number | format] [-list] [-only | -noonly] [-force | -noforce] [-nocolor] [-Version] [-help] [-man] [-quiet] [FILE | DIRECTORY | STDIN] DESCRIPTION "perlcritic" is a Perl source code analyzer. It is the executable front-end to the Perl::Critic engine, which attempts to identify awkward, hard to read, error-prone, or unconventional constructs in your code. Most of the rules are based on Damian Conway's book Perl Best Practices.

Don't worry, it's all in perldoc.

Working with perlcritic $ perlcritic -1 myObj.pm RCS keywords $Id$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) RCS keywords $Revision$, $HeadURL$, $Date$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) RCS keywords $Revision$, $Source$, $Date$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) No "VERSION" variable found at line 1, column 1. See page 404 of PBP. (Severity: 2) Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1) Subroutine does not end with "return" at line 16, column 1. See page 197 of PBP. (Severity: 4)

Working with perlcritic $ perlcritic -1 myObj.pm RCS keywords $Id$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) RCS keywords $Revision$, $HeadURL$, $Date$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) RCS keywords $Revision$, $Source$, $Date$ not found at line 1, column 1. See page 441 of PBP. (Severity: 2) No "VERSION" variable found at line 1, column 1. See page 404 of PBP. (Severity: 2) Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1) Subroutine does not end with "return" at line 16, column 1. See page 197 of PBP. (Severity: 4)

Working with .perlcriticrc $ cat .perlcriticrc [-Miscellanea::RequireRcsKeywords] [-Modules::RequireVersionVar]

Working with perlcritic $ perlcritic -1 myObj.pm Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1) Subroutine does not end with "return" at line 16, column 1. See page 197 of PBP. (Severity: 4)

Working with perlcritic $ perlcritic -1 myObj.pm Code is not tidy at line 1, column 1. See page 33 of PBP. (Severity: 1) Subroutine does not end with "return" at line 16, column 1. See page 197 of PBP. (Severity: 4)

Working with perlcritic sub set_name { my $self = shift; $self->{ name } = shift; return; }

Working with perlcritic Output: $ prove -v testobj.t testobject....1..8 # Failed test 'can set name' # in testobject.t at line 17. # Looks like you failed 1 test of 8. ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj not ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 Files=1, Tests=8, 0 wallclock secs ( 0.03 cusr + = 0.04 CPU) Failed 1/1 test programs. 1/8 subtests failed.

0.01 csys

Working with perlcritic #!/usr/bin/perl use strict; use warnings; use Test::More tests => 8; BEGIN { use_ok( 'myObj' ); } ok( my $obj1 = myObj->new( name => 'test1' ), "can create a myObj specifying values" ); isa_ok( $obj1, 'myObj' ); ok( my $obj2 = myObj->new(), "can create a specifying values" ); isa_ok( $obj2, 'myObj' );

The mutator shouldn't return myObj not a value!

ok( ! $obj2->set_name( 'test1' ), "can set name" ); ok( 'test1' eq $obj2->get_name(), "can get name" ); is_deeply( $obj1, $obj2, "obj1 seems deeply similar to obj2" );

Working with perlcritic Output: $ prove -v testobj.t testobj....1..8 ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 ok All tests successful. Files=1, Tests=8, 0 wallclock secs ( 0.02 cusr + = 0.03 CPU)

0.01 csys

Perl::Critic and Zfml $ perlcritic -1 index.zfml Code not contained in explicit package at line 1, column 1. Violates encapsulation. (Severity: 4) Code before strictures are enabled at line 1, column 1. 429 of PBP. (Severity: 5)

See page

Code before warnings are enabled at line 1, column 1. of PBP. (Severity: 4)

See page 431

Useless interpolation of literal string at line 1, column 23. PBP. (Severity: 1)

See page 51 of

Mixed high and low-precedence booleans at line 1, column 1. of PBP. (Severity: 4) Useless interpolation of literal string at line 1, column 64. (Severity: 1) Useless interpolation of literal string at line 2, column 13. (Severity: 1) Hard tabs used at line 4, column 60.

See page 20 of PBP.

Code not contained in explicit package at line 5, column 54.

See page 51 of PBP.

See page 51 of PBP.

(Severity: 3)

Violates encapsulation.

(Severity: 4)

Mixed high and low-precedence booleans at line 5, column 54. See page 70 of PBP. (Severity: 4) Hard tabs used at line 5, column 72. See page 20 of PBP. (Severity: 3) Useless interpolation of literal string at line 5, column 72. See page 51 of PBP. (Severity: 1) Useless interpolation of literal string at line 6, column 26.

See page 51 of PBP.

Postfix control "for" used at line 6, column 164. See page 96 of PBP. (Severity: 1) Hard tabs used at line 6, column 259. See page 20 of PBP. (Severity: 3)

Useless interpolation of literal string at line 6, column 259. See page 51 of PBP. (Severity: 1) Useless interpolation of literal string at line 7, column 23. See page 51 of PBP. (Severity: 1) Postfix control "for" used at line 7, column 261. See page 96 of PBP. (Severity: 1) Postfix control "for" used at line 7, column 393. See page 96 of PBP. (Severity: 1) Postfix control "for" used at line 7, column 568. See page 96 of PBP. (Severity: 1) Postfix control "for" used at line 7, column 587. See page 96 of PBP. (Severity: 1) Hard tabs used at line 7, column 678. See page 20 of PBP. (Severity: 3) Useless interpolation of literal string at line 7, column 678. See page 51 of PBP. (Severity: 1) Hard tabs used at line 8, column 24. See page 20 of PBP. (Severity: 3) Useless interpolation of literal string at line 33, column 22. See page 51 of PBP. (Severity: 1) Mismatched operator at line 34, column 15. Numeric/string operators and operands should match. (Severity: 3) Useless interpolation of literal string at line 34, column 45. See page 51 of PBP. (Severity: 1) Useless interpolation of literal string at line 34, column 64. See page 51 of PBP. (Severity: 1) Mismatched operator at line 34, column 86. Numeric/string operators and operands should match. (Severity: 3) Useless interpolation of literal string at line 34, column 186. See page 51 of PBP. (Severity: 1) Hard tabs used at line 34, column 209. See page 20 of PBP. (Severity: 3) Useless interpolation of literal string at line 34, column 209. See page 51 of PBP. (Severity: 1)

See page 70

(Severity: 1)

Working with perlcritic $ perlcritic -1 myObj.pm Code is not tidy at line 1, column 1.

See page 33 of PBP.

(Severity: 1)

Working with perlcritic $ perlcritic -1 myObj.pm Code is not tidy at line 1, column 1.

See page 33 of PBP.

(Severity: 1)

Working with perltidy PERLTIDY(1)

NAME

User Contributed Perl Documentation

PERLTIDY(1)

perltidy - a perl script indenter and reformatter

SYNOPSIS perltidy [ options ] file1 file2 file3 ... (output goes to file1.tdy, file2.tdy, ...) perltidy [ options ] file1 -o outfile perltidy [ options ] file1 -st >outfile perltidy [ options ] outfile

Working with perltidy $ cat .perltidyrc -l=78 # Max line width is 78 cols -i=2 # Indent level is 2 cols -ci=2 # Continuation indent is 2 cols -lp # line up parenthesis -vt=2 # Maximal vertical tightness -vtc=1 # medium vertical something tightness -cti=1 # No extra indentation for closing brackets -pt=1 # Medium parenthesis tightness -bt=1 # Medium brace tightness -sbt=1 # Medium square bracket tightness -bbt=1 # Medium block brace tightness -nsfs # No space before semicolons -nolq # Don't outdent long quoted strings -wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" # Break before all operators -nsak="my local our if elsif until unless while for foreach return switch case given when" -bar -cab=3 -wrs="! ," # want right space after these tokens -wls="!" # want left space after !

Screencast demonstration removed for PDF

ZFML

$ perltidy index.zfml There is no previous '?' to match a ':' on line 4 4: ^ 5: <meta http-equiv="content-type" content="text/html;charset=iso-8 ... -------------- ^ found bareword where operator expected (previous token underlined) 5: ... ent="text/html;charset=iso-8859-1" /> -^ found > where term expected (previous token underlined) 7: <meta NAME="keywords" CONTENT="AcmeCorp, widgets, gadgets ... ---------- ^ found bareword where operator expected (previous token underlined) 9: @import url(/AcmeCorp/templates/gateway85styles.css); ^ found Array where operator expected Missing ';' above? 9: @import url(/AcmeCorp/templates/gateway85styles.css); ------- ^ found bareword where operator expected (previous token underlined) 9: @import url(/AcmeCorp/templates/gateway85styles.css); ---------^ found bareword where operator expected (previous token underlined) Missing ';' above? There is no previous '?'

to match a ':' on line 14 fix valid */

14: max-height: 140px; /* to Missing ';' above?

^ 15

There is no previous '?' to match a ':' on line 15: padding: 12px; margin-top: 5px; border-top: 1px solid #e0e0e0; ^ There is no previous '?' to match a ':' on line 15 15: padding: 12px; margin-top: 5px; border-top: 1px solid #e0e0e0; ^ There is no previous '?' to match a ':' on line 15 15: padding: 12px; margin-top: 5px; border-top: 1px solid #e0e0e0; ^

Working with perlcritic $ perlcritic -1 myObj.pm myObj.pm source OK

That's great

but...

how does that help me? :-\

Ensuring your tests fully exercise your code

Introducing Devel::Cover Devel::Cover(3)

NAME

Perl Documentation

Devel::Cover(3)

Devel::Cover - Code coverage metrics for Perl

SYNOPSIS perl -MDevel::Cover yourprog args cover perl -MDevel::Cover=-db,cover_db,-coverage,statement,time yourprog args To test an uninstalled module: cover -delete HARNESS_PERL_SWITCHES=-MDevel::Cover make test cover

huh?

Introducing Devel::Cover $ perl -MDevel::Cover testobj.t 1..8 ok 1 - use myObj; ... # some Devel::Cover output snipped ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 Devel::Cover: Writing coverage database to /Users/kentcowgill/cover_db/runs/ 1169095517.23575.48192 ---------------------------- ------ ------ ------ ------ ------ ------ -----File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ -----myObj.pm 100.0 n/a 100.0 100.0 n/a 23.5 100.0 testobj.t 100.0 n/a n/a 100.0 n/a 76.5 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ ------

Introducing cover $ cover Reading database from /Users/kentcowgill/cover_db ---------------------------- ------ ------ ------ ------ ------ ------ -----File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ -----myObj.pm 100.0 n/a 100.0 100.0 n/a 23.5 100.0 testobj.t 100.0 n/a n/a 100.0 n/a 76.5 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ -----Writing HTML output to /Users/kentcowgill/cover_db/coverage.html ... done.

Introducing cover $ cover Reading database from /Users/kentcowgill/cover_db ---------------------------- ------ ------ ------ ------ ------ ------ -----File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ -----myObj.pm 100.0 n/a 100.0 100.0 n/a 23.5 100.0 testobj.t 100.0 n/a n/a 100.0 n/a 76.5 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ -----Writing HTML output to /Users/kentcowgill/cover_db/coverage.html ... done.

html? :-D

Tweaking Devel::Cover Devel::Cover(3)

Perl Documentation

Devel::Cover(3)

OPTIONS ... -ignore RE +ignore RE

- Set REs of files to ignore - Append to REs of files to ignore.

Tweaking Devel::Cover $ perl -MDevel::Cover=+ignore,.*\.t testobj.t 1..8 ok 1 - use myObj; ... # Devel::Cover output snipped Ignoring packages matching: /Devel/Cover[./] .*.t ... # Devel::Cover output snipped ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 Devel::Cover: Writing coverage database to /Users/kentcowgill/cover_db/runs/ 1169096938.23619.10353 ---------------------------- ------ ------ ------ ------ ------ ------ -----File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ -----myObj.pm 100.0 n/a 100.0 100.0 n/a 100.0 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ ------

what happened to prove?

Tweaking prove $ prove -MDevel::Cover=+ignore,.*\.t testobj.t

Tweaking prove $ prove Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown Unknown

-MDevel::Cover=+ignore,.*\.t testobj.t option: M option: e option: e option: : option: : option: C option: o option: e option: = option: + option: i option: g option: n option: o option: e option: , option: . option: * option: .

ouch!

Tweaking prove $ PERL5OPT=-MDevel::Cover=+ignore,.*\.t prove -v testobj.t testobj....1..8 ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 ok All tests successful. Files=1, Tests=8, 3 wallclock secs ( 3.18 cusr + 0.08 csys =

3.26 CPU)

Tweaking prove $ cover Reading database from /Users/kentcowgill/cover_db ---------------------------- ------ ------ ------ ------ ------ ------ -----File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ -----/usr/bin/prove 73.7 43.8 0.0 46.7 n/a 98.0 61.1 myObj.pm 100.0 n/a 100.0 100.0 n/a 2.0 100.0 Total 78.0 43.8 40.0 60.0 n/a 100.0 66.9 ---------------------------- ------ ------ ------ ------ ------ ------ -----Writing HTML output to /Users/kentcowgill/cover_db/coverage.html ... done.

uh, was that 'prove' in there?

Tweaking prove $ cover Reading database from /Users/kentco ---------------------------- -----File stmt ---------------------------- -----/usr/bin/prove 73.7 myObj.pm 100.0

Tweaking prove $ cover Reading database from /Users/kentco ---------------------------- -----File stmt ---------------------------- -----/usr/bin/prove 73.7 myObj.pm 100.0

yeah :(

Tweaking prove $ PERL5OPT=-MDevel::Cover=+ignore,.*\.t,+ignore,prove prove -v testobj.t testobj....1..8 ok 1 - use myObj; ok 2 - can create a myObj specifying values ok 3 - The object isa myObj ok 4 - can create a myObj not specifying values ok 5 - The object isa myObj ok 6 - can set name ok 7 - can get name ok 8 - obj1 seems deeply similar to obj2 ok All tests successful. Files=1, Tests=8, 3 wallclock secs ( 3.18 cusr + 0.08 csys = 3.26 CPU)

Saving Some Typing $ cat Makefile OPENCMD = open BROWSER = /Applications/Safari.app clean: cover -delete test: prove testobj.t cover: make clean PERL5OPT=-MDevel::Cover=+ignore,.*\.t,+ignore,prove make test 2>&1 cover make report report: $(OPENCMD) $(BROWSER) cover_db/coverage.html

Saving Some Typing $ make cover make clean cover -delete Deleting database /Users/kentcowgill/cover_db PERL5OPT=-MDevel::Cover=+ignore,.*\.t,+ignore,prove make test 2>&1 prove testobj.t testobj....1..8 testobj....ok All tests successful. Files=1, Tests=8, 7 wallclock secs ( 3.22 cusr + 0.09 csys = 3.31 CPU) cover Reading database from /Users/kentcowgill/cover_db ---------------------------- ------ ------ ------ ------ ------ ------ -----File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ -----myObj.pm 100.0 n/a 100.0 100.0 n/a 100.0 100.0 Total 100.0 n/a 100.0 100.0 n/a 100.0 100.0 ---------------------------- ------ ------ ------ ------ ------ ------ -----Writing HTML output to /Users/kentcowgill/cover_db/coverage.html ... done. make report open /Applications/Safari.app cover_db/coverage.html

100% yay! 8-D

Introducing Test::ZFML Test::Zfml(3)

User Contributed Perl Documentation

Test::Zfml(3)

NAME Test::ZFML - Custom Test:: module built specifically for parsing ZFML. DESCRIPTION Long has it been lamented that AcmeCorp's implementation of ZFML (and who knows what that really stands for) is unmaintainable, and more importantly untestable. No more. Test::ZFML attempts to make the unparseable parseable, the unmaintainable maintainable, and the untestable testable. It does this by implementing it's own mini ZFML parser and places chunks of ZFML inside their own package, surrounded by their own subroutines which have defined inputs and testable outputs.

Using Test::ZFML #!/usr/bin/perl use strict; use warnings; use Test::More qw/no_plan/; use Test::ZFML; use ZFML; my $p = ZFML->new(); my $file = q[test.zfml]; load_ok( parse_ok( evaluate_ok( critique_ok(

$file, $file, $file, $file,

"Loaded ZFML file $file" ); "Parsed ZFML file $file" ); "Evaluated ZFML file $file" ); "Critiqued ZFML file $file" );

That's great

but...

How about a demo?

Screencast demonstration removed for PDF

How'd you do that?

Test::Builder::Module NAME Test::Builder::Module - Base class for test modules SYNOPSIS # Emulates Test::Simple package Your::Module; my $CLASS = __PACKAGE__; use base 'Test::Builder::Module'; @EXPORT = qw(ok); sub ok ($;$) { my $tb = $CLASS->builder; return $tb->ok(@_); } 1;

Test::Builder::Module NAME Test::Builder::Module - Base class for test modules SYNOPSIS # Emulates Test::Simple package Your::Module; my $CLASS = __PACKAGE__; use base 'Test::Builder::Module'; @EXPORT = qw(ok); sub ok ($;$) { my $tb = $CLASS->builder; return $tb->ok(@_); } 1;

Start Here

Test::ZFML package Test::ZFML; use strict; use warnings; use Perl::Critic qw/critique/; use Test::HTML::Lint (); use Carp; use lib '/Users/kentcowgill/acmecorp/lib'; use ZFML; use vars qw/$VERSION @ISA @EXPORT %EXPORT_TAGS $TODO/; use base q/Test::Builder::Module/; @EXPORT = qw/load_ok parse_ok evaluate_ok critique_ok replace_ok contains_ok lacks_ok html_ok/;

Test::ZFML package Test::ZFML; use strict; use warnings;

Standard stuff

use Perl::Critic qw/critique/; use Test::HTML::Lint (); use Carp; use lib '/Users/kentcowgill/acmecorp/lib'; use ZFML; use vars qw/$VERSION @ISA @EXPORT %EXPORT_TAGS $TODO/; use base q/Test::Builder::Module/; @EXPORT = qw/load_ok parse_ok evaluate_ok critique_ok replace_ok contains_ok lacks_ok html_ok/;

Test::ZFML # global regexes my $includeparse = qr//s; my $htmlparse = qr//s; my $zfmlparse = qr/()/s; my $zfmlextract = qr//s;

Test::ZFML

Icky regexes

# global regexes my $includeparse = qr//s; my $htmlparse = qr//s; my $zfmlparse = qr/()/s; my $zfmlextract = qr//s;

Test::ZFML sub load_ok { my $desc; ( $file_to_test, $desc ) = @_; _load_file( $file_to_test ); $zfml_filestate = LOADED; my $tb = Test::ZFML->builder; # minimal (testable) sanity check, ensures that # $file_contents has contents $tb->ok( $file_contents, $desc ); }

Test::ZFML sub load_ok { my $desc; ( $file_to_test, $desc ) = @_; _load_file( $file_to_test ); $zfml_filestate = LOADED; my $tb = Test::ZFML->builder;

Load the file

# minimal (testable) sanity check, ensures that # $file_contents has contents $tb->ok( $file_contents, $desc ); }

Test::ZFML sub _load_file { $file_to_test = shift; _get_contents( \$file_contents, $file_to_test ); push @vars, grep { ! /^\$(ENV|inp)/ } $file_contents =~ m/(\$[A-Z_]+)/g; return; }

Test::ZFML sub _load_file { $file_to_test = shift; _get_contents( \$file_contents, $file_to_test ); push @vars, grep { ! /^\$(ENV|inp)/ } $file_contents =~ m/(\$[A-Z_]+)/g; return; }

Just does a slurp

Test::ZFML sub parse_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; croak 'You must load the file first' if $zfml_filestate != LOADED; _parse_file( $p ); $zfml_filestate = PARSED; my $tb = Test::ZFML->builder; # minimal (testable) sanity check, ensures that # $stuff got stuffed $tb->ok( $stuff, $desc ); }

Test::ZFML sub parse_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; croak 'You must load the file first' if $zfml_filestate != LOADED; _parse_file( $p ); $zfml_filestate = PARSED; my $tb = Test::ZFML->builder; # minimal (testable) sanity check, ensures that # $stuff got stuffed $tb->ok( $stuff, $desc ); }

Parse the file

Test::ZFML sub _parse_file { my( $p ) = @_; # grab the executable hunks of perl code my @zfml = $file_contents =~ /$zfmlparse/g; $file_contents =~ s/$zfmlparse//g; # grab the hunks that are responsible for templates my %includes = $file_contents =~ /$includeparse/g; $file_contents =~ s/$includeparse//g; # finally, grab the hunks that get turned into HTML my %zfmlvars = $file_contents =~ /$htmlparse/g; $file_contents =~ s/$htmlparse//g; ...

Test::ZFML sub _parse_file { my( $p ) = @_;

Really parse it

# grab the executable hunks of perl code my @zfml = $file_contents =~ /$zfmlparse/g; $file_contents =~ s/$zfmlparse//g; # grab the hunks that are responsible for templates my %includes = $file_contents =~ /$includeparse/g; $file_contents =~ s/$includeparse//g; # finally, grab the hunks that get turned into HTML my %zfmlvars = $file_contents =~ /$htmlparse/g; $file_contents =~ s/$htmlparse//g; ...

...

Test::ZFML

for my $key( keys %includes ){ # process all the include files :) my $tb = Test::Zfml->builder; $tb->ok( _get_includes( $key, $includes{ $key }, $file_to_test ), "Included $key file $includes{ $key }" ); } for my $key( keys %zfmlvars ){ $p->var->{$key} = $zfmlvars{$key}; } for my $zfml( @zfml ){ if( $zfml =~ m/$zfmlextract/s ) { push @{ $stuff->{$1} }, { $2 => $3 }; } } } # end

...

Test::ZFML

for my $key( keys %includes ){ # process all the include files :) my $tb = Test::Zfml->builder; $tb->ok( _get_includes( $key, $includes{ $key }, $file_to_test ), "Included $key file $includes{ $key }" ); } for my $key( keys %zfmlvars ){ $p->var->{$key} = $zfmlvars{$key}; } for my $zfml( @zfml ){ if( $zfml =~ m/$zfmlextract/s ) { push @{ $stuff->{$1} }, { $2 => $3 }; } } } # end

Chug through it

Test::ZFML sub _get_includes { my( $name, $file, $fromfile ) = @_; my $filepath = "$webroot/$file"; if( $filepath =~ /\$VERSION/ ){ $filepath =~ s/\$VERSION/$version/; } if( $filepath =~ /\$LOCAL/ ){ my $path = $fromfile; $path =~ s/^.+?\/(.+)\/[a-z\.]+$/$version\/$1/; $filepath =~ s/\$LOCAL/$path/; } my $tb = Test::ZFML->builder(); $tb->ok( -e $filepath, "Inlude/Template file ($filepath) Exists" ); ...

Test::ZFML sub _get_includes { my( $name, $file, $fromfile ) = @_; my $filepath = "$webroot/$file"; if( $filepath =~ /\$VERSION/ ){ $filepath =~ s/\$VERSION/$version/; }

Process included files

if( $filepath =~ /\$LOCAL/ ){ my $path = $fromfile; $path =~ s/^.+?\/(.+)\/[a-z\.]+$/$version\/$1/; $filepath =~ s/\$LOCAL/$path/; } my $tb = Test::ZFML->builder(); $tb->ok( -e $filepath, "Inlude/Template file ($filepath) Exists" ); ...

...

Test::ZFML

open( my $tmp, '<', $filepath ) or die "can't open include file"; my @file = <$tmp>; my $contents; for my $line ( @file ){ $contents .= $line; if( $line =~ m/\$([A-Z]+)\s/ ){ eval "\$testzfml::$1 = 'dummy content'"; } if( $line =~ m/var->{'([A-Z_]+)'}/ ){ eval "\$testzfml::$1 = 'dummy content'"; } } my %includes = $contents =~ /$includeparse/g; for my $key( keys %includes ){ _get_includes( $key, $includes{ $key }, $file ); } close( $tmp ); }

...

Test::ZFML Evaluate, evaluate, evaluate

open( my $tmp, '<', $filepath ) or die "can't open include file"; my @file = <$tmp>; my $contents; for my $line ( @file ){ $contents .= $line; if( $line =~ m/\$([A-Z]+)\s/ ){ eval "\$testzfml::$1 = 'dummy content'"; } if( $line =~ m/var->{'([A-Z_]+)'}/ ){ eval "\$testzfml::$1 = 'dummy content'"; } } my %includes = $contents =~ /$includeparse/g; for my $key( keys %includes ){ _get_includes( $key, $includes{ $key }, $file ); } close( $tmp ); }

Test::ZFML sub evaluate_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; croak 'You must parse the file first' if $zfml_filestate != PARSED; $zfml_filestate = EVALED; for my $hunk ( keys %{$stuff} ) { for my $evals ( @{ $stuff->{$hunk} } ) { for my $var ( keys %{$evals} ) { _evaluate_code( $p, $hunk, $var, $evals->{$var}, $file, $desc ); } } } # loads everything into memory for testing require $_ for @cov_files; ## no critic }

Test::ZFML sub evaluate_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; croak 'You must parse the file first' if $zfml_filestate != PARSED; $zfml_filestate = EVALED; for my $hunk ( keys %{$stuff} ) { for my $evals ( @{ $stuff->{$hunk} } ) { for my $var ( keys %{$evals} ) { _evaluate_code( $p, $hunk, $var, $evals->{$var}, $file, $desc ); } } } # loads everything into memory for testing require $_ for @cov_files; ## no critic }

Really evaluate it

Test::ZFML sub _evaluate_code { my( $p, $eval_init, $name, $hunk, $file, $desc ) = @_; $file =~ s/.*\/(.*)$/$1/; my $subname = "$eval_init$name"; $hunk = _wrap_hunk( $hunk, $subname ); my $filename = "$file.$subname"; my $tb = Test::ZFML->builder; # Writing the contents out to a file so I can run # the tests with Devel::Cover turned on. open my $cov, '>', ".$filename"; print {$cov} $hunk; close $cov; push @cov_files, ".$filename"; eval "require '.$filename';"; ## no critic $tb->ok( ! $@, "$desc chunk ( $filename ) $@" ); eval "testzfml::$subname( \$p );"; die "eval failed - $@" if $@; }

Test::ZFML sub _evaluate_code { my( $p, $eval_init, $name, $hunk, $file, $desc ) = @_; $file =~ s/.*\/(.*)$/$1/; my $subname = "$eval_init$name"; $hunk = _wrap_hunk( $hunk, $subname ); my $filename = "$file.$subname"; my $tb = Test::ZFML->builder; # Writing the contents out to a file so I can run # the tests with Devel::Cover turned on. open my $cov, '>', ".$filename"; print {$cov} $hunk; close $cov; push @cov_files, ".$filename"; eval "require '.$filename';"; ## no critic $tb->ok( ! $@, "$desc chunk ( $filename ) $@" ); eval "testzfml::$subname( \$p );"; die "eval failed - $@" if $@; }

Write out files for Code Coverage

Test::ZFML

sub _wrap_hunk { my( $hunk, $subname ) = @_;

# HEREDOCs inside eval aren't recognizable as HEREDOCs. # This re-quotes HEREDOCs as q()/qq() strings. if( $hunk =~ m/<
chars with an HTML entity start of an assignment involving a heredoc using a quoting delimiter

(?{ $1 eq q(") ? 'qq' : 'q' }) # which we'll remember in $^R ([A-Z]+) \1; (.*?)\n \2 /= $^R|$3|;/gsx; } ...

# # # # #

next the heredoc token close quoting delimiter the heredoc closing heredoc token replace with quoting

Test::ZFML

sub _wrap_hunk { my( $hunk, $subname ) = @_;

# HEREDOCs inside eval aren't recognizable as HEREDOCs. # This re-quotes HEREDOCs as q()/qq() strings. if( $hunk =~ m/<
Wrap Heredocs ...

start of an assignment involving a heredoc using a quoting delimiter

(?{ $1 eq q(") ? 'qq' : 'q' }) # which we'll remember in $^R

([A-Z]+) \1; (.*?)\n \2 /= $^R|$3|;/gsx;

}

chars with an HTML entity

# # # # #

next the heredoc token close quoting delimiter the heredoc closing heredoc token replace with quoting

Test::ZFML ... my $chunk; # wrap the hunk with its own package, strictures and # warnings enabled, a sigwarn handler that causes eval # errors ($@) to throw a test ok() error, and callable via a # subroutine call. $chunk = <<"EOC"; package testzfml; use strict; use warnings; use ZFML; BEGIN { \$SIG{'__WARN__'} = sub { die \$_[0] } } ## no critic sub $subname { $hunk } 1; EOC return $chunk; }

Test::ZFML ... my $chunk; # wrap the hunk with its own package, strictures and # warnings enabled, a sigwarn handler that causes eval # errors ($@) to throw a test ok() error, and callable via a # subroutine call. $chunk = <<"EOC"; package testzfml; use strict; use warnings; use ZFML; BEGIN { \$SIG{'__WARN__'} = sub { die \$_[0] } } ## no critic sub $subname { $hunk } 1; EOC return $chunk; }

Wrap it in it's own namespace

Test::ZFML sub critique_ok { my( $file, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; for my $hunk ( keys %{$stuff} ) { for my $evals ( @{ $stuff->{$hunk} } ) { for my $var ( keys %{$evals} ) { _critique_code( $hunk, $var, $evals->{$var}, $desc ); } } } }

Test::ZFML sub critique_ok { my( $file, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; for my $hunk ( keys %{$stuff} ) { for my $evals ( @{ $stuff->{$hunk} } ) { for my $var ( keys %{$evals} ) { _critique_code( $hunk, $var, $evals->{$var}, $desc ); } } } }

Critique it

Test::ZFML sub _critique_code { my( $eval_init, $name, $hunk, $desc ) = @_; my $subname = "$eval_init$name"; my $problems = 0; $hunk = _wrap_hunk( $hunk, $subname ); my $tb = Test::ZFML->builder; for my $violation ( critique( { -severity => 1, -verbose => 1 }, \$hunk ) ){ $tb->ok( ! $violation, "Critique problem: $violation" ); $problems++; } $tb->ok( ! $problems, "$desc chunk ( $subname )" ); return; }

Test::ZFML sub _critique_code { my( $eval_init, $name, $hunk, $desc ) = @_; my $subname = "$eval_init$name"; my $problems = 0;

Report violations

$hunk = _wrap_hunk( $hunk, $subname ); my $tb = Test::ZFML->builder; for my $violation ( critique( { -severity => 1, -verbose => 1 }, \$hunk ) ){ $tb->ok( ! $violation, "Critique problem: $violation" ); $problems++; } $tb->ok( ! $problems, "$desc chunk ( $subname )" ); return; }

Test::ZFML sub replace_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; my $tb = Test::ZFML->builder; for my $var (@vars) { my $varname = $var; $varname =~ s/^\$//; my $pname = $p->var->{$varname}; $tb->ok( $p->var->{$varname}, "$varname found in $file" ); $file_contents =~ s/\Q$var\E/$pname/g; } my %input = %{ $p->input }; $file_contents =~ s/\$(input\{)'?([A-Za-z_]+)'?\}/\$$1$2}/g; eval "\$file_contents = qq|$file_contents|;"; }

Test::ZFML sub replace_ok { my( $file, $p, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; my $tb = Test::ZFML->builder;

Replace special variables

for my $var (@vars) { my $varname = $var; $varname =~ s/^\$//; my $pname = $p->var->{$varname}; $tb->ok( $p->var->{$varname}, "$varname found in $file" ); $file_contents =~ s/\Q$var\E/$pname/g; } my %input = %{ $p->input }; $file_contents =~ s/\$(input\{)'?([A-Za-z_]+)'?\}/\$$1$2}/g; eval "\$file_contents = qq|$file_contents|;"; }

Test::ZFML sub contains_ok { my( $file, $p, $regex, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; $p->render(); my $tb = Test::ZFML->builder; $tb->like( $file_contents, $regex, $desc ); }

Check its' contents

Test::ZFML

sub contains_ok { my( $file, $p, $regex, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; $p->render(); my $tb = Test::ZFML->builder; $tb->like( $file_contents, $regex, $desc ); }

Test::ZFML sub lacks_ok { my( $file, $p, $regex, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; $p->render(); my $tb = Test::ZFML->builder; $tb->unlike( $file_contents, $regex, $desc ); }

Test::ZFML sub lacks_ok { my( $file, $p, $regex, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; $p->render(); my $tb = Test::ZFML->builder; $tb->unlike( $file_contents, $regex, $desc ); }

Make sure it doesn't have specific bits

Test::ZFML sub html_ok { my( $file, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; Test::HTML::Lint::html_ok( $file_contents, $desc ); return; }

Test::ZFML

Check the HTML

sub html_ok { my( $file, $desc ) = @_; croak 'wrong file' if $file ne $file_to_test; Test::HTML::Lint::html_ok( $file_contents, $desc ); return; }

Putting it all together • Test::More • prove • Perl::Critic • Devel::Cover • Makefile • Test::ZFML

The Test File

Screencast demonstration removed for PDF

The Makefile Kent-Cowgills-Computer(~/acmecorp)$ cat Makefile OPENCMD = open BROWSER = /Applications/Safari.app clean: cover -delete test: prove t/ verbose: prove -v t/ shuffle: prove -s t/ cover: make clean PERL5OPT=-MDevel::Cover=+ignore,prove,+ignore,lib.*\.pm, +ignore,zfml\.t make test cover make report report: $(OPENCMD) $(BROWSER) cover_db/coverage.html

Running Tests Kent-Cowgills-Computer(~/acmecorp)$ make test prove t/ t/artdesign-zfml....ok t/index-zfml........ok t/testlogin-zfml....ok All tests successful. Files=3, Tests=59, 2 wallclock secs ( 1.24 cusr + 1.44 CPU)

0.20 csys =

Test Failure Kent-Cowgills-Computer(~/acmecorp)$ make test prove t/ t/artdesign-zfml....ok 1/29 # Failed test 'HTML passes Lint test' # in /Users/kentcowgill/acmecorp/lib/Test/ZFML.pm at line 136.

Test Code Coverage Kent-Cowgills-Computer(~/acmecorp)$ make cover make clean cover -delete Deleting database /Users/kentcowgill/acmecorp/cover_db PERL5OPT=-MDevel::Cover=-ignore,prove,+ignore,lib.*\.pm, +ignore,zfml\.t make test prove t/ t/artdesign-zfml....ok t/index-zfml........ok t/testlogin-zfml....ok All tests successful. Files=3, Tests=59, 22 wallclock secs (18.46 cusr + 0.48 csys = 18.94 CPU) cover Reading database from /Users/kentcowgill/acmecorp/cover_db Devel::Cover: merging data for .artdesign.zfml.EVALCOPYRIGHT_YEAR into .index.zfml.EVALCOPYRIGHT_YEAR

Test Code Coverage Continued... ---------------------------- ------ ------ ------ ------ ------ ------ -----File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ -----.artdesign.zfml.INITSETUP 100.0 n/a n/a 100.0 n/a 12.9 100.0 .index.zfml.EVALCOPYRIGHT_YEAR 92.3 n/a n/a 100.0 n/a 63.9 94.4 .index.zfml.INITSETUP 100.0 n/a n/a 100.0 n/a 11.5 100.0 .testlogin.zfml.INITFORM 100.0 75.0 n/a 100.0 n/a 11.8 96.0 Total 98.3 75.0 n/a 100.0 n/a 100.0 97.6 ---------------------------- ------ ------ ------ ------ ------ ------ ------

Writing HTML output to /Users/kentcowgill/acmecorp/cover_db/ coverage.html ... done. make report open /Applications/Safari.app cover_db/coverage.html

Test Code Coverage

Sweet! =D

Functional Testing

Introducing Test::WWW::Mechanize Test::WWW::Mechanize(3)

Test::WWW::Mechanize(3)

NAME Test::WWW::Mechanize - Testing-specific WWW::Mechanize subclass VERSION Version 1.12 SYNOPSIS Test::WWW::Mechanize is a subclass of WWW::Mechanize that incorporates features for web application testing. For example: $mech->get_ok( $page ); $mech->base_is( 'http://petdance.com/', 'Proper ' ); $mech->title_is( "Invoice Status", "On the invoice page" ); $mech->content_contains( "Andy Lester", "My name somewhere" ); $mech->content_like( qr/(cpan|perl)\.org/, "Link: perl or CPAN" );

Planetary::DblClick_tag.pm #!/usr/bin/perl use strict; use warnings; #use Test::More tests => 40; use Test::More 'no_plan'; use Test::WWW::Mechanize; ...

Planetary::DblClick_tag.pm #!/usr/bin/perl use strict; use warnings; #use Test::More tests => 40; use Test::More 'no_plan'; use Test::WWW::Mechanize; # .fwpwd contains my AcmeCorp user id and password our( $AcmeCorp_username, $AcmeCorp_password ); require '/Users/kentcowgill/acmecorp/.fwpwd'; # create a new Test::WWW:Mechanize object. my $ua = Test::WWW::Mechanize->new; ...

Planetary::DblClick_tag.pm ... # first, get the home page $ua->get_ok( "http://test.AcmeCorp.com", "Check base URL" ); # log in (using kcowgill credentials) $ua->form_number( 1 ); $ua->field( 'EMAIL_ADDRESS', $AcmeCorp_username ); $ua->field( 'PASSWORD', $AcmeCorp_password ); $ua->click( 'returnLogin' ); # basic sanity check that we're on the right page (/AcmeCorp/my/index) $ua->content_contains( "Hi, Kent!", "received greeting message" ); ...

Planetary::DblClick_tag.pm ... # grab the iframe src tag my( $iframe ) = $ua->content =~ m/iframe .*src="([^"]+)"/; # make sure it's got the right stuff in it. like( $iframe, qr/site=fw/, 'got site=fw in iframe src tag' ); like( $iframe, qr/affiliate=fw/, 'got affiliate=fw in iframe src tag' ); like( $iframe, qr/app=(?:my|other)/, 'got app=my in iframe src tag' );

...

Planetary::DblClick_tag.pm $ prove -v dblclick.t dblclick....ok 1 - Check base URL ok 2 - received greeting message ok 3 - got site=ac in iframe src tag ok 4 - got affiliate=ac in iframe src tag ok 5 - got app=tango in iframe src tag ok 6 - got size=160x600 in iframe src tag ok 7 - got pp=1 in iframe src tag ok 8 - got path=$ID in iframe src tag ok 9 - got dcpc=606 in iframe src tag ok 10 - got ge=2 in iframe src tag ok 11 - got age=19 in iframe src tag ok 12 - got widget=14 in iframe src tag ok 13 - got wango=5 in iframe src tag ok 14 - got state=30 in iframe src tag ok 15 - got tango=3.8 in iframe src tag ok 16 - got doodad=0 in iframe src tag ok 17 - got gadget=0075 in iframe src tag ok 18 - got mtfnpy=4 in iframe src tag ... ok All tests successful. Files=1, Tests=38, 8 wallclock secs ( 0.27 cusr +

0.08 csys =

0.35 CPU)

How To Get Started

The VIM Plugin

The VIM Plugin

Screencast demonstration removed for PDF

The VIM Plugin

The Perl Module

The Perl Module

Screencast demonstration removed for PDF

The Perl Module

~fin~

•Wikipedia:

References

http://en.wikipedia.org/wiki/Software_testing http://en.wikipedia.org/wiki/Test_Case

•Testing Reference card:

http://pub.langworth.com/perl_test_refcard.pdf

•Test modules:

http://search.cpan.org/dist/Test-Simple/

•ViM script:

http://www.vim.org/scripts/script.php?script_id=1985

•Test::StubGenerator:

http://search.cpan.org/dist/Test-StubGenerator/

•Screencast software (Mac only):

http://www.ambrosiasw.com/utilities/snapzprox/

•Cats:

http://icanhascheezburger.com/