[Bast-commits] r3256 - in trunk/Class-Data-Accessor: . lib/Class/Data t

claco at dev.catalyst.perl.org claco at dev.catalyst.perl.org
Sun May 6 04:54:59 GMT 2007


Author: claco
Date: 2007-05-06 04:54:57 +0100 (Sun, 06 May 2007)
New Revision: 3256

Added:
   trunk/Class-Data-Accessor/Makefile.PL
   trunk/Class-Data-Accessor/README
   trunk/Class-Data-Accessor/t/accessor.t
   trunk/Class-Data-Accessor/t/basic.t
   trunk/Class-Data-Accessor/t/manifest.t
   trunk/Class-Data-Accessor/t/pod_coverage.t
   trunk/Class-Data-Accessor/t/pod_spelling.t
   trunk/Class-Data-Accessor/t/pod_syntax.t
   trunk/Class-Data-Accessor/t/strict.t
   trunk/Class-Data-Accessor/t/style_no_tabs.t
   trunk/Class-Data-Accessor/t/warnings.t
Removed:
   trunk/Class-Data-Accessor/MANIFEST
   trunk/Class-Data-Accessor/t/pod-coverage.t
   trunk/Class-Data-Accessor/t/pod-spelling.t
   trunk/Class-Data-Accessor/t/pod.t
Modified:
   trunk/Class-Data-Accessor/Build.PL
   trunk/Class-Data-Accessor/Changes
   trunk/Class-Data-Accessor/MANIFEST.SKIP
   trunk/Class-Data-Accessor/lib/Class/Data/Accessor.pm
Log:
Converted to Module::Install
Added culterific tests/TEST_AUTHOR
Converted to distro friendly version number


Modified: trunk/Class-Data-Accessor/Build.PL
===================================================================
--- trunk/Class-Data-Accessor/Build.PL	2007-05-06 03:50:00 UTC (rev 3255)
+++ trunk/Class-Data-Accessor/Build.PL	2007-05-06 03:54:57 UTC (rev 3256)
@@ -1,14 +1,2 @@
-#!/usr/bin/perl
-use warnings;
-use strict;
-use Module::Build;
-
-Module::Build->new(
-    module_name => 'Class::Data::Accessor',
-    license => 'perl',
-    requires => {
-        Carp => 0
-    },
-    create_makefile_pl => 'passthrough',
-    create_readme => 1,
-)->create_build_script;
+# $Id$
+require 'Makefile.PL';
\ No newline at end of file


Property changes on: trunk/Class-Data-Accessor/Build.PL
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Modified: trunk/Class-Data-Accessor/Changes
===================================================================
--- trunk/Class-Data-Accessor/Changes	2007-05-06 03:50:00 UTC (rev 3255)
+++ trunk/Class-Data-Accessor/Changes	2007-05-06 03:54:57 UTC (rev 3256)
@@ -1,5 +1,10 @@
 Revision history for Class::Data::Accessor.
 
+0 04000 Sat May 05 21:17:23 2007
+    - Converted to Module::Install
+    - Added culterific tests/TEST_AUTHOR
+    - Converted to distro friendly version number
+
 0.03  2006-06-23 19:50:23
     - Added warning when attempting to make DESTROY accessor
     - Added mk_classaccessors class method


Property changes on: trunk/Class-Data-Accessor/Changes
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Deleted: trunk/Class-Data-Accessor/MANIFEST
===================================================================
--- trunk/Class-Data-Accessor/MANIFEST	2007-05-06 03:50:00 UTC (rev 3255)
+++ trunk/Class-Data-Accessor/MANIFEST	2007-05-06 03:54:57 UTC (rev 3256)
@@ -1,11 +0,0 @@
-Build.PL
-Changes
-lib/Class/Data/Accessor.pm
-MANIFEST			This list of files
-MANIFEST.SKIP
-t/Accessor.t
-t/pod-coverage.t
-t/pod.t
-META.yml
-Makefile.PL
-README

Modified: trunk/Class-Data-Accessor/MANIFEST.SKIP
===================================================================
--- trunk/Class-Data-Accessor/MANIFEST.SKIP	2007-05-06 03:50:00 UTC (rev 3255)
+++ trunk/Class-Data-Accessor/MANIFEST.SKIP	2007-05-06 03:54:57 UTC (rev 3256)
@@ -19,6 +19,8 @@
 # Avoid Module::Build generated and utility files.
 \bBuild$
 \b_build
+Build.PL
+Build.bat
 
 # Avoid temp and backup files.
 ~$


Property changes on: trunk/Class-Data-Accessor/MANIFEST.SKIP
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/Class-Data-Accessor/Makefile.PL
===================================================================
--- trunk/Class-Data-Accessor/Makefile.PL	                        (rev 0)
+++ trunk/Class-Data-Accessor/Makefile.PL	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,21 @@
+# $Id$
+use strict;
+use warnings;
+use inc::Module::Install 0.65;
+
+name 'Class-Data-Accessor';
+license 'perl';
+perl_version '5.006001';
+all_from 'lib/Class/Data/Accessor.pm';
+
+requires 'Carp';
+
+tests "t/*.t t/*/*.t";
+clean_files "Class-Data-Accessor-* t/var";
+
+eval {
+    system 'pod2text lib/Class/Data/Accessor.pm > README';
+};
+
+auto_install;
+WriteAll;


Property changes on: trunk/Class-Data-Accessor/Makefile.PL
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/Class-Data-Accessor/README
===================================================================
--- trunk/Class-Data-Accessor/README	                        (rev 0)
+++ trunk/Class-Data-Accessor/README	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,152 @@
+NAME
+    Class::Data::Accessor - Inheritable, overridable class and instance data
+    accessor creation
+
+SYNOPSIS
+      package Stuff;
+      use base qw(Class::Data::Accessor);
+
+      # Set up DataFile as inheritable class data.
+      Stuff->mk_classaccessor('DataFile');
+
+      # Declare the location of the data file for this class.
+      Stuff->DataFile('/etc/stuff/data');
+
+      # Or, all in one shot:
+      Stuff->mk_classaccessor(DataFile => '/etc/stuff/data');
+
+      Stuff->DataFile; # returns /etc/stuff/data
+
+      my $stuff = Stuff->new; # your new, not ours
+
+      $stuff->DataFile; # returns /etc/stuff/data
+
+      $stuff->DataFile('/etc/morestuff'); # sets it on the object
+
+      Stuff->DataFile; # still returns /etc/stuff/data
+
+DESCRIPTION
+    Class::Data::Accessor is the marriage of Class::Accessor and
+    Class::Data::Inheritable into a single module. It is used for creating
+    accessors to class data that overridable in subclasses as well as in
+    class instances.
+
+    For example:
+
+      Pere::Ubu->mk_classaccessor('Suitcase');
+
+    will generate the method Suitcase() in the class Pere::Ubu.
+
+    This new method can be used to get and set a piece of class data.
+
+      Pere::Ubu->Suitcase('Red');
+      $suitcase = Pere::Ubu->Suitcase;
+
+    Taking this one step further, you can make a subclass that inherits from
+    Pere::Ubu:
+
+      package Raygun;
+      use base qw(Pere::Ubu);
+
+      # Raygun's suitcase is Red.
+      $suitcase = Raygun->Suitcase;
+
+    Raygun inherits its Suitcase class data from Pere::Ubu.
+
+    Inheritance of class data works analogous to method inheritance. As long
+    as Raygun does not "override" its inherited class data (by using
+    Suitcase() to set a new value) it will continue to use whatever is set
+    in Pere::Ubu and inherit further changes:
+
+      # Both Raygun's and Pere::Ubu's suitcases are now Blue
+      Pere::Ubu->Suitcase('Blue');
+
+    However, should Raygun decide to set its own Suitcase() it has now
+    "overridden" Pere::Ubu and is on its own, just like if it had overridden
+    a method:
+
+      # Raygun has an orange suitcase, Pere::Ubu's is still Blue.
+      Raygun->Suitcase('Orange');
+
+    Now that Raygun has overridden Pere::Ubu, further changes by Pere::Ubu
+    no longer effect Raygun.
+
+      # Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite.
+      Pere::Ubu->Suitcase('Samsonite');
+
+    You can also override this class data on a per-object basis. If $obj isa
+    Pere::Ubu then
+
+      $obj->Suitcase; # will return Samsonite
+
+      $obj->Suitcase('Purple'); # will set Suitcase *for this object only*
+
+    And after you've done that,
+
+      $obj->Suitcase; # will return Purple
+
+    but
+
+      Pere::Ubu->Suitcase; # will still return Samsonite
+
+    If you don't want this behaviour use Class::Data::Inheritable instead.
+
+    "mk_classaccessor" will die if used as an object method instead of as a
+    class method.
+
+METHODS
+  mk_classaccessor
+      Class->mk_classaccessor($data_accessor_name);
+      Class->mk_classaccessor($data_accessor_name => $value);
+
+    This is a class method used to declare new class data accessors. A new
+    accessor will be created in the Class using the name from
+    $data_accessor_name, and optionally initially setting it to the given
+    value.
+
+    To facilitate overriding, mk_classaccessor creates an alias to the
+    accessor, _field_accessor(). So Suitcase() would have an alias
+    _Suitcase_accessor() that does the exact same thing as Suitcase(). This
+    is useful if you want to alter the behavior of a single accessor yet
+    still get the benefits of inheritable class data. For example.
+
+      sub Suitcase {
+          my($self) = shift;
+          warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid';
+
+          $self->_Suitcase_accessor(@_);
+      }
+
+    Overriding accessors does not work in the same class as you declare the
+    accessor in. It only works in subclasses due to the fact that
+    subroutines are loaded at compile time and accessors are loaded at
+    runtime, thus overriding any subroutines with the same name in the same
+    class.
+
+  mk_classaccessors(@accessornames)
+    Takes a list of names and generates an accessor for each name in the
+    list using "mk_classaccessor".
+
+AUTHORS
+    Based on the creative stylings of Damian Conway, Michael G Schwern, Tony
+    Bowden (Class::Data::Inheritable) and Michael G Schwern, Marty Pauley
+    (Class::Accessor).
+
+    Coded by Matt S Trout Tweaks by Christopher H. Laco.
+
+BUGS and QUERIES
+    If your object isn't hash-based, this will currently break. My
+    modifications aren't exactly sophisticated so far.
+
+    mstrout at cpan.org or bug me on irc.perl.org, nick mst claco at cpan.org or
+    irc.perl.org, nick claco
+
+LICENSE
+    This module is free software. It may be used, redistributed and/or
+    modified under the terms of the Perl Artistic License (see
+    http://www.perl.com/perl/misc/Artistic.html)
+
+SEE ALSO
+    perltootc has a very elaborate discussion of class data in Perl.
+    Class::Accessor, Class::Data::Inheritable
+


Property changes on: trunk/Class-Data-Accessor/README
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Modified: trunk/Class-Data-Accessor/lib/Class/Data/Accessor.pm
===================================================================
--- trunk/Class-Data-Accessor/lib/Class/Data/Accessor.pm	2007-05-06 03:50:00 UTC (rev 3255)
+++ trunk/Class-Data-Accessor/lib/Class/Data/Accessor.pm	2007-05-06 03:54:57 UTC (rev 3256)
@@ -1,8 +1,9 @@
 package Class::Data::Accessor;
-use strict qw(vars subs);
+use strict;
+use warnings;
 use Carp;
 use vars qw($VERSION);
-$VERSION = '0.03';
+$VERSION = '0.04000';
 
 sub mk_classaccessor {
     my ($declaredclass, $attribute, $data) = @_;
@@ -31,6 +32,7 @@
     };
 
     no warnings qw/redefine/;
+    no strict qw/refs/;
     my $alias = "_${attribute}_accessor";
     *{$declaredclass.'::'.$attribute} = $accessor;
     *{$declaredclass.'::'.$alias}     = $accessor;


Property changes on: trunk/Class-Data-Accessor/lib/Class/Data/Accessor.pm
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/Class-Data-Accessor/t/accessor.t
===================================================================
--- trunk/Class-Data-Accessor/t/accessor.t	                        (rev 0)
+++ trunk/Class-Data-Accessor/t/accessor.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,77 @@
+use strict;
+use warnings;
+use Test::More tests => 19;
+
+package Ray;
+use base qw(Class::Data::Accessor);
+Ray->mk_classaccessors('Ubu');
+Ray->mk_classaccessor(DataFile => '/etc/stuff/data');
+
+package Gun;
+use base qw(Ray);
+Gun->Ubu('Pere');
+
+package Suitcase;
+use base qw(Gun);
+Suitcase->DataFile('/etc/otherstuff/data');
+
+package main;
+
+foreach my $class (qw/Ray Gun Suitcase/) {
+	can_ok $class =>
+		qw/mk_classaccessor Ubu _Ubu_accessor DataFile _DataFile_accessor/;
+}
+
+# Test that superclasses effect children.
+is +Gun->Ubu, 'Pere', 'Ubu in Gun';
+is +Suitcase->Ubu, 'Pere', "Inherited into children";
+is +Ray->Ubu, undef, "But not set in parent";
+
+# Set value with data
+is +Ray->DataFile, '/etc/stuff/data', "Ray datafile";
+is +Gun->DataFile, '/etc/stuff/data', "Inherited into gun";
+is +Suitcase->DataFile, '/etc/otherstuff/data', "Different in suitcase";
+
+# Now set the parent
+ok +Ray->DataFile('/tmp/stuff'), "Set data in parent";
+is +Ray->DataFile, '/tmp/stuff', " - it sticks";
+is +Gun->DataFile, '/tmp/stuff', "filters down to unchanged children";
+is +Suitcase->DataFile, '/etc/otherstuff/data', "but not to changed";
+
+
+my $obj = bless {}, 'Gun';
+eval { $obj->mk_classaccessor('Ubu') };
+ok $@ =~ /^mk_classaccessor\(\) is a class method, not an object method/,
+"Can't create classaccessor for an object";
+
+is $obj->DataFile, "/tmp/stuff", "But objects can access the data";
+
+is $obj->DataFile("/tmp/morestuff"), "/tmp/morestuff",
+  "And they can set their own copy";
+
+is +Gun->DataFile, "/tmp/stuff", "But it doesn't touch the value on the class";
+
+
+{
+    my $warned = 0;
+
+    local $SIG{__WARN__} = sub {
+        if  (shift =~ /DESTROY/i) {
+            $warned++;
+        };
+    };
+
+    Ray->mk_classaccessor('DESTROY');
+
+    ok($warned, 'Warn when creating DESTROY');
+
+    # restore non-accessorized DESTROY
+    no warnings;
+    *Ray::DESTROY = sub {};
+};
+
+eval {
+    $obj->mk_classaccessor('foo');
+};
+like($@, qr{not an object method}, 'Die when used as an object method');
+


Property changes on: trunk/Class-Data-Accessor/t/accessor.t
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/Class-Data-Accessor/t/basic.t
===================================================================
--- trunk/Class-Data-Accessor/t/basic.t	                        (rev 0)
+++ trunk/Class-Data-Accessor/t/basic.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,11 @@
+#!perl -wT
+# $Id$
+use strict;
+use warnings;
+
+BEGIN {
+    use lib 't/lib';
+    use Test::More tests => 1;
+
+    use_ok('Class::Data::Accessor');
+};


Property changes on: trunk/Class-Data-Accessor/t/basic.t
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/Class-Data-Accessor/t/manifest.t
===================================================================
--- trunk/Class-Data-Accessor/t/manifest.t	                        (rev 0)
+++ trunk/Class-Data-Accessor/t/manifest.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,22 @@
+#!perl -wT
+# $Id$
+use strict;
+use warnings;
+
+BEGIN {
+    use lib 't/lib';
+    use Test::More;
+
+    plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};
+
+    eval 'use Test::CheckManifest 0.09';
+    if($@) {
+        plan skip_all => 'Test::CheckManifest 0.09 not installed';
+    };
+};
+
+ok_manifest({
+    exclude => ['/t/var', '/cover_db'],
+    filter  => [qr/\.svn/, qr/cover/, qr/Build(.(PL|bat))?/, qr/_build/],
+    bool    => 'or'
+});


Property changes on: trunk/Class-Data-Accessor/t/manifest.t
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Deleted: trunk/Class-Data-Accessor/t/pod-coverage.t
===================================================================
--- trunk/Class-Data-Accessor/t/pod-coverage.t	2007-05-06 03:50:00 UTC (rev 3255)
+++ trunk/Class-Data-Accessor/t/pod-coverage.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -1,4 +0,0 @@
-use Test::More;
-eval "use Test::Pod::Coverage 1.00";
-plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
-all_pod_coverage_ok();

Deleted: trunk/Class-Data-Accessor/t/pod-spelling.t
===================================================================
--- trunk/Class-Data-Accessor/t/pod-spelling.t	2007-05-06 03:50:00 UTC (rev 3255)
+++ trunk/Class-Data-Accessor/t/pod-spelling.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -1,23 +0,0 @@
-use Test::More;
-eval 'use Test::Spelling 0.11';
-plan skip_all => 'Test::Spelling 0.11 not installed' if $@;
-plan skip_all => 'set TEST_SPELLING to enable this test' unless $ENV{TEST_SPELLING};
-
-set_spell_cmd('aspell list');
-
-add_stopwords(<DATA>);
-
-all_pod_files_spelling_ok();
-
-__DATA__
-Bowden
-Raygun
-isa
-mst
-behaviour
-further
-overridable
-Laco
-Pauley
-claco
-stylings

Deleted: trunk/Class-Data-Accessor/t/pod.t
===================================================================
--- trunk/Class-Data-Accessor/t/pod.t	2007-05-06 03:50:00 UTC (rev 3255)
+++ trunk/Class-Data-Accessor/t/pod.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -1,4 +0,0 @@
-use Test::More;
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
-all_pod_files_ok();

Added: trunk/Class-Data-Accessor/t/pod_coverage.t
===================================================================
--- trunk/Class-Data-Accessor/t/pod_coverage.t	                        (rev 0)
+++ trunk/Class-Data-Accessor/t/pod_coverage.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,23 @@
+#!perl -wT
+# $Id$
+use strict;
+use warnings;
+
+BEGIN {
+    use lib 't/lib';
+    use Test::More;
+
+    plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};
+
+    eval 'use Test::Pod::Coverage 1.04';
+    plan skip_all => 'Test::Pod::Coverage 1.04' if $@;
+
+    eval 'use Pod::Coverage 0.14';
+    plan skip_all => 'Pod::Coverage 0.14 not installed' if $@;
+};
+
+my $trustme = {
+    trustme => [qr/^(g|s)et_component_class$/]
+};
+
+all_pod_coverage_ok($trustme);


Property changes on: trunk/Class-Data-Accessor/t/pod_coverage.t
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/Class-Data-Accessor/t/pod_spelling.t
===================================================================
--- trunk/Class-Data-Accessor/t/pod_spelling.t	                        (rev 0)
+++ trunk/Class-Data-Accessor/t/pod_spelling.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,35 @@
+#!perl -w
+# $Id$
+use strict;
+use warnings;
+
+BEGIN {
+    use lib 't/lib';
+    use Test::More;
+
+    plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};
+
+    eval 'use Test::Spelling 0.11';
+    plan skip_all => 'Test::Spelling 0.11 not installed' if $@;
+};
+
+set_spell_cmd('aspell list');
+
+add_stopwords(<DATA>);
+
+all_pod_files_spelling_ok();
+
+__DATA__
+Bowden
+Raygun
+isa
+mst
+behaviour
+further
+overridable
+Laco
+Pauley
+claco
+stylings
+fieldspec
+listref


Property changes on: trunk/Class-Data-Accessor/t/pod_spelling.t
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + LF

Added: trunk/Class-Data-Accessor/t/pod_syntax.t
===================================================================
--- trunk/Class-Data-Accessor/t/pod_syntax.t	                        (rev 0)
+++ trunk/Class-Data-Accessor/t/pod_syntax.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,16 @@
+#!perl -wT
+# $Id$
+use strict;
+use warnings;
+
+BEGIN {
+    use lib 't/lib';
+    use Test::More;
+
+    plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};
+
+    eval 'use Test::Pod 1.00';
+    plan skip_all => 'Test::Pod 1.00 not installed' if $@;
+};
+
+all_pod_files_ok();


Property changes on: trunk/Class-Data-Accessor/t/pod_syntax.t
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/Class-Data-Accessor/t/strict.t
===================================================================
--- trunk/Class-Data-Accessor/t/strict.t	                        (rev 0)
+++ trunk/Class-Data-Accessor/t/strict.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,53 @@
+#!perl -wT
+# $Id$
+use strict;
+use warnings;
+
+BEGIN {
+    use lib 't/lib';
+    use Test::More;
+    use File::Find;
+    use File::Basename;
+
+    plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};
+
+    eval 'use Test::Strict';
+    plan skip_all => 'Test::Strict not installed' if $@;
+    plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006;
+};
+
+## I hope this can go away if Test::Strict or File::Find::Rule
+## finally run under -T. Until then, I'm on my own here. ;-)
+my @files;
+my %trusted = (
+
+);
+
+find({  wanted => \&wanted,
+        untaint => 1,
+        untaint_pattern => qr|^([-+@\w./]+)$|,
+        untaint_skip => 1,
+        no_chdir => 1
+}, qw(lib t));
+
+sub wanted {
+    my $name = $File::Find::name;
+    my $file = fileparse($name);
+
+    return if $name =~ /TestApp/;
+
+    if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) {
+        push @files, $name;
+    };
+};
+
+if (scalar @files) {
+    plan tests => scalar @files;
+} else {
+    plan tests => 1;
+    fail 'No perl files found for Test::Strict checks!';
+};
+
+foreach (@files) {
+    strict_ok($_);
+};


Property changes on: trunk/Class-Data-Accessor/t/strict.t
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/Class-Data-Accessor/t/style_no_tabs.t
===================================================================
--- trunk/Class-Data-Accessor/t/style_no_tabs.t	                        (rev 0)
+++ trunk/Class-Data-Accessor/t/style_no_tabs.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,15 @@
+#!perl -wT
+# $Id$
+use strict;
+use warnings;
+
+BEGIN {
+    use Test::More;
+
+    plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};
+
+    eval 'use Test::NoTabs 0.03';
+    plan skip_all => 'Test::NoTabs 0.03 not installed' if $@;
+};
+
+all_perl_files_ok('lib');


Property changes on: trunk/Class-Data-Accessor/t/style_no_tabs.t
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Added: trunk/Class-Data-Accessor/t/warnings.t
===================================================================
--- trunk/Class-Data-Accessor/t/warnings.t	                        (rev 0)
+++ trunk/Class-Data-Accessor/t/warnings.t	2007-05-06 03:54:57 UTC (rev 3256)
@@ -0,0 +1,53 @@
+#!perl -wT
+# $Id$
+use strict;
+use warnings;
+
+BEGIN {
+    use lib 't/lib';
+    use Test::More;
+    use File::Find;
+    use File::Basename;
+
+    plan skip_all => 'set TEST_AUTHOR to enable this test' unless $ENV{TEST_AUTHOR};
+
+    eval 'use Test::Strict 0.05';
+    plan skip_all => 'Test::Strict 0.05 not installed' if $@;
+    plan skip_all => 'Need untaint in newer File::Find' if $] <= 5.006;
+};
+
+## I hope this can go away if Test::Strict or File::Find::Rule
+## finally run under -T. Until then, I'm on my own here. ;-)
+my @files;
+my %trusted = (
+
+);
+
+find({  wanted => \&wanted,
+        untaint => 1,
+        untaint_pattern => qr|^([-+@\w./]+)$|,
+        untaint_skip => 1,
+        no_chdir => 1
+}, qw(lib t));
+
+sub wanted {
+    my $name = $File::Find::name;
+    my $file = fileparse($name);
+
+    return if $name =~ /TestApp/;
+
+    if ($name =~ /\.(pm|pl|t)$/i && !exists($trusted{$file})) {
+        push @files, $name;
+    };
+};
+
+if (scalar @files) {
+    plan tests => scalar @files;
+} else {
+    plan tests => 1;
+    fail 'No perl files found for Test::Strict checks!';
+};
+
+foreach (@files) {
+   warnings_ok($_);
+};


Property changes on: trunk/Class-Data-Accessor/t/warnings.t
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native




More information about the Bast-commits mailing list