—
—
—

              
package Test::Class::Most;
use warnings;
use strict;
use Test::Class;
use Carp 'croak';
HideShow 10 lines of Pod
=head1 NAME
Test::Class::Most - Test Classes the easy way
=head1 VERSION
Version 0.08
=cut
our $VERSION = '0.08';
$VERSION = eval $VERSION;
HideShow 169 lines of Pod
=head1 SYNOPSIS
Instead of this:
    use strict;
    use warnings;
    use Test::Exception 0.88;
    use Test::Differences 0.500;
    use Test::Deep 0.106;
    use Test::Warn 0.11;
    use Test::More 0.88;
    use parent 'My::Test::Class';
    sub some_test : Tests { ... }
You type this:
    use Test::Class::Most parent => 'My::Test::Class';
    sub some_test : Tests { ... }
=head1 DESCRIPTION
When people write test classes with the excellent C<Test::Class>, you often
see the following at the top of the code:
  package Some::Test::Class;
  use strict;
  use warnings;
  use base 'My::Test::Class';
  use Test::More;
  use Test::Exception;
  # and then the tests ...
That's a lot of boilerplate and I don't like boilerplate.  So now you can do
this:
  use Test::Class::Most parent => 'My::Test::Class';
That automatically imports L<strict> and L<warnings> for you.  It also gives
you all of the testing goodness from L<Test::Most>.
=head1 CREATING YOUR OWN BASE CLASS
You probably want to create your own base class for testing.  To do this,
simply specify no import list:
  package My::Test::Class;
  use Test::Class::Most; # we now inherit from Test::Class
  INIT { Test::Class->runtests }
  1;
And then your other classes inherit as normal (well, the way we do it):
  package Tests::For::Foo;
  use Test::Class::Most parent => 'My::Test::Class';
And you can inherit from those other classes, too:
  package Tests::For::Foo::Child;
  use Test::Class::Most parent => 'Tests::For::Foo';
Of course, it's quite possible that you're a fan of multiple inheritance, so
you can do that, too (I was I<soooooo> tempted to not allow this, but I
figured I shouldn't force too many of my personal beliefs on you):
 package Tests::For::ISuckAtOO;
 use Test::Class::Most parent => [qw/
    Tests::For::Foo
    Tests::For::Bar
    Some::Other::Class::For::Increased::Stupidity
 /];
As a side note, it's recommended that even if you don't need test control
methods in your base class, put stubs in there:
  package My::Test::Class;
  use Test::Class::Most; # we now inherit from Test::Class
  INIT { Test::Class->runtests }
  sub startup  : Tests(startup)  {}
  sub setup    : Tests(setup)    {}
  sub teardown : Tests(teardown) {}
  sub shutdown : Tests(shutdown) {}
  1;
This allows developers to I<always> be able to safely call parent test control
methods rather than wonder if they are there:
  package Tests::For::Customer;
  use Test::Class::Most parent => 'My::Test::Class';
  sub setup : Tests(setup) {
    my $test = shift;
    $test->next::method; # safe due to stub in base class
    ...
  }
=head1 ATTRIBUTES
You can also specify "attributes" which are merely very simple getter/setters.
  use Test::Class::Most 
    parent      => 'My::Test::Class',
    attributes  => [qw/customer items/],
    is_abstract => 1;
  sub setup : Tests(setup) {
    my $test = shift;
    $test->SUPER::setup;
    $test->customer( ... );
    $test->items( ... );
  }
  sub some_tests : Tests {
    my $test     = shift;
    my $customer = $test->customer;
    ...
  }
If called with no arguments, returns the current value.  If called with one
argument, sets that argument as the current value.  If called with more than
one argument, it croaks.
=head1 ABSTRACT CLASSES
You may pass an optional C<is_abstract> parameter in the import list. It takes
a boolean value. This value is advisory only and is not inherited. It defaults
to false if not provided.
Sometimes you want to identify a test class as "abstract". It may have a bunch
of tests, but those should only run for its subclasses. You can pass
C<<is_abstract => 1>> in the import list. Then, to test if a given class or
instance of that class is "abstract":
 sub dont_run_in_abstract_base_class : Tests {
     my $test = shift;
     return if Test::Class::Most->is_abstract($test);
     ...
 }
Note that C<is_abstract> is strictly B<advisory only>. You are expected
(required) to check the value yourself and take appropriate action.
We recommend adding the following method to your base class:
 sub is_abstract {
     my $test = shift;
     return Test::Class::Most->is_abstract($test);
 }
And later in a subclass:
 if ( $test->is_abstract ) { ... }
=head1 EXPORT
All functions from L<Test::Most> are automatically exported into your
namespace.
=cut
{
    my %IS_ABSTRACT;
    sub is_abstract {
        my ( undef, $proto ) = @_;
        my $test_class = ref $proto || $proto;
        return $IS_ABSTRACT{$test_class};
    }
    sub import {
        my ( $class, %args ) = @_;
        my $caller = caller;
        eval "package $caller; use Test::Most;";
        croak($@) if $@;
        warnings->import;
        strict->import;
        if ( my $parent = delete $args{parent} ) {
            if ( ref $parent && 'ARRAY' ne ref $parent ) {
                croak(
    "Argument to 'parent' must be a classname or array of classnames, not ($parent)"
                );
            }
            $parent = [$parent] unless ref $parent;
            foreach my $p (@$parent) {
                eval "use $p";
                croak($@) if $@;
            }
            no strict 'refs';
            push @{"${caller}::ISA"} => @$parent;
        }
        else {
            no strict 'refs';
            push @{"${caller}::ISA"} => 'Test::Class';
        }
        if ( my $attributes = delete $args{attributes} ) {
            if ( ref $attributes && 'ARRAY' ne ref $attributes ) {
                croak(
    "Argument to 'attributes' must be a classname or array of classnames, not ($attributes)"
                );
            }
            $attributes = [$attributes] unless ref $attributes;
            foreach my $attr (@$attributes) {
                my $method = "$caller\::$attr";
                no strict 'refs';
                *$method = sub {
                    my $test = shift;
                    return $test->{$method} unless @_;
                    if ( @_ > 1 ) {
                        croak("You may not pass more than one argument to '$method'");
                    }
                    $test->{$method} = shift;
                    return $test;
                };
            }
        }
        if ( my $is_abstract = delete $args{is_abstract} ) {
            $IS_ABSTRACT{$caller} = $is_abstract;
        }
        else {
            $IS_ABSTRACT{$caller} = 0;
        }
    }
}
HideShow 91 lines of Pod
=head1 TUTORIAL
If you're not familiar with using L<Test::Class>, please see my tutorial at:
=over 4
=item * L<http://www.modernperlbooks.com/mt/2009/03/organizing-test-suites-with-testclass.html>
=item * L<http://www.modernperlbooks.com/mt/2009/03/reusing-test-code-with-testclass.html>
=item * L<http://www.modernperlbooks.com/mt/2009/03/making-your-testing-life-easier.html>
=item * L<http://www.modernperlbooks.com/mt/2009/03/using-test-control-methods-with-testclass.html>
=item * L<http://www.modernperlbooks.com/mt/2009/03/working-with-testclass-test-suites.html>
=back
=head1 AUTHOR
Curtis "Ovid" Poe, C<< <ovid at cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-test-class-most at
rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Class-Most>.  I will be
notified, and then you'll automatically be notified of progress on your bug as
I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
    perldoc Test::Class::Most
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Class-Most>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Test-Class-Most>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Test-Class-Most>
=item * Search CPAN
L<http://search.cpan.org/dist/Test-Class-Most/>
=back
=head1 SEE ALSO
=over 4
=item * L<Test::Class>
xUnit-style testing in Perl
=item * L<Test::Most>
The most popular CPAN test modules bundled into one module.
=item * L<Modern::Perl>
I stole this code.  Thanks C<chromatic>!
=back
=head1 ACKNOWLEDGEMENTS
Thanks to Adrian Howard for L<Test::Class>, Adam Kennedy for maintaining it
and C<chromatic> for L<Modern::Perl>.
=head1 COPYRIGHT & LICENSE
Copyright 2010 Curtis "Ovid" Poe, all rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
no warnings 'void';
"Boilerplate is bad, m'kay";