diff options
44 files changed, 2911 insertions, 0 deletions
diff --git a/CONTRIBUTING.mkdn b/CONTRIBUTING.mkdn new file mode 100644 index 0000000..761c9db --- /dev/null +++ b/CONTRIBUTING.mkdn @@ -0,0 +1,87 @@ +## HOW TO CONTRIBUTE + +Thank you for considering contributing to this distribution. This file +contains instructions that will help you work with the source code. + +The distribution is managed with Dist::Zilla. This means than many of the +usual files you might expect are not in the repository, but are generated at +release time, as is much of the documentation. Some generated files are +kept in the repository as a convenience (e.g. Makefile.PL or cpanfile). + +Generally, **you do not need Dist::Zilla to contribute patches**. You do need +Dist::Zilla to create a tarball. See below for guidance. + +### Getting dependencies + +If you have App::cpanminus 1.6 or later installed, you can use `cpanm` to +satisfy dependencies like this: + + $ cpanm --installdeps . + +Otherwise, look for either a `Makefile.PL` or `cpanfile` file for +a list of dependencies to satisfy. + +### Running tests + +You can run tests directly using the `prove` tool: + + $ prove -l + $ prove -lv t/some_test_file.t + +For most of my distributions, `prove` is entirely sufficient for you to test any +patches you have. I use `prove` for 99% of my testing during development. + +### Code style and tidying + +Please try to match any existing coding style. If there is a `.perltidyrc` +file, please install Perl::Tidy and use perltidy before submitting patches. + +If there is a `tidyall.ini` file, you can also install Code::TidyAll and run +`tidyall` on a file or `tidyall -a` to tidy all files. + +### Patching documentation + +Much of the documentation Pod is generated at release time. Some is +generated boilerplate; other documentation is built from pseudo-POD +directives in the source like C<=method> or C<=func>. + +If you would like to submit a documentation edit, please limit yourself to +the documentation you see. + +If you see typos or documentation issues in the generated docs, please +email or open a bug ticket instead of patching. + +### Installing and using Dist::Zilla + +Dist::Zilla is a very powerful authoring tool, optimized for maintaining a +large number of distributions with a high degree of automation, but it has a +large dependency chain, a bit of a learning curve and requires a number of +author-specific plugins. + +To install it from CPAN, I recommend one of the following approaches for +the quickest installation: + + # using CPAN.pm, but bypassing non-functional pod tests + $ cpan TAP::Harness::Restricted + $ PERL_MM_USE_DEFAULT=1 HARNESS_CLASS=TAP::Harness::Restricted cpan Dist::Zilla + + # using cpanm, bypassing *all* tests + $ cpanm -n Dist::Zilla + +In either case, it's probably going to take about 10 minutes. Go for a walk, +go get a cup of your favorite beverage, take a bathroom break, or whatever. +When you get back, Dist::Zilla should be ready for you. + +Then you need to install any plugins specific to this distribution: + + $ cpan `dzil authordeps` + $ dzil authordeps | cpanm + +Once installed, here are some dzil commands you might try: + + $ dzil build + $ dzil test + $ dzil xtest + +You can learn more about Dist::Zilla at http://dzil.org/ + @@ -0,0 +1,168 @@ +Revision history for Class-Tiny + +1.001 2015-01-30 21:13:07-05:00 America/New_York + + [ADDED] + + - Added support for BUILDARGS for Moo(se) compatibility + + [INTERNAL] + + - Implements BUILDALL via method (was inline) for Moo(se) compatibility + +1.000 2014-07-16 09:55:29-04:00 America/New_York + + [*** INCOMPATIBLE CHANGES ***] + + - Attributes for custom accessors *MUST* be declared for them to be + set via the constructor. It is no longer sufficient for a method of + the same name to exist. + + - Unknown constructor arguments are ignored rather than fatal; they are + not included in the object. Special instructions for using BUILD to + hide constructor arguments from validation are irrelevant and have + been removed. + + - These changes make Class::Tiny-based classes easier to subclass by + more advanced object frameworks like Moose or Moo. + +0.015 2014-07-13 23:10:47-04:00 America/New_York + + [CHANGED] + + - lowered minimum perl to 5.006 + +0.014 2013-11-28 07:12:14 America/New_York + + [FIXED] + + - put back a 'no warnings "once"' line that caused downstream warnings + +0.013 2013-11-26 12:01:13 America/New_York + + [DOCUMENTED] + + - expanded comparision to Object::Tiny and Class::Accessor + +0.012 2013-11-01 16:36:35 America/New_York + + [DOCUMENTED] + + - added documentation notes about multiple inheritance + and attribute defaults under subclassing + + [INTERNAL] + + - added tests for multiple inheritance + +0.011 2013-09-25 11:08:07 America/New_York + + [FIXED] + + - compile test could hang on Windows + + [PREREQS] + + - ExtUtils::MakeMaker configure_requires dropped to 6.17 + +0.010 2013-09-18 13:23:15 America/New_York + + [FIXED] + + - suppressed 'used only once' warnings (GH #9) + +0.009 2013-09-17 06:54:47 America/New_York + + [FIXED] + + - "won't stay shared" bug on older perls + +0.008 2013-09-08 09:49:46 America/New_York + + [FIXED] + + - META.yml encoding problems + + [DOCUMENTED] + + - revised CONTRIBUTING + + [INTERNAL] + + - refactored precaching + +0.007 2013-09-07 16:48:56 America/New_York + + [OPTIMIZED] + + - accessors without defaults are now much faster (comparable + to Class::Accessor::Fast) + + - constructor and destructors are slightly faster when there + are no superclasses except Class::Tiny::Object + + - linearized @ISA and other items are cached for speed when + the first object is created + +0.006 2013-09-05 11:56:48 America/New_York + + [ADDED] + + - added introspection method: get_all_attribute_defaults_for($class) + + [DOCUMENTED] + + - Fixed TOBYINK email address for contributors list + + - Revised rationale for why Class::Tiny vs other modules + +0.005 2013-08-28 11:51:37 America/New_York + + [ADDED] + + - Attributes now support lazy defaults passed as a hash reference + to the class declaration + +0.004 2013-08-21 16:38:01 America/New_York + + [CHANGED] + + - Base class is now Class::Tiny::Object; Class::Tiny is now only the + class builder + + - BUILD and DEMOLISH now have Moo(se) like semantics: BUILD gets + original constructor arguments. DEMOLISH is now passed a global + destruction flag (requires Devel::GlobalDestruction on Perls before + v5.14) + + - Constructor argument validation now happens after BUILD. + + - Constructor argument validation has been softened to a heuristic: + argument names must match a method name + + [ADDED] + + - added introspection method: get_all_attributes_for($class) + + [INTERNAL] + + - Refactored import() for easier subclassing of Class::Tiny should + anyone be crazy enough to do so + +0.003 2013-08-19 19:43:36 America/New_York + + [FIXED] + + - Multiple invocations of "use Class::Tiny" in a package accumulate + attributes instead of overwriting them + +0.002 2013-08-19 17:17:24 America/New_York + + [CHANGED] + + - Slight reduction in memory usage tracking attributes + +0.001 2013-08-16 10:48:33 America/New_York + + - First release + @@ -0,0 +1,207 @@ +This software is Copyright (c) 2013 by David Golden. + +This is free software, licensed under: + + The Apache License, Version 2.0, January 2004 + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..29cf78f --- /dev/null +++ b/MANIFEST @@ -0,0 +1,45 @@ +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.031. +CONTRIBUTING.mkdn +Changes +LICENSE +MANIFEST +META.json +META.yml +Makefile.PL +README +cpanfile +dist.ini +lib/Class/Tiny.pm +perlcritic.rc +t/00-report-prereqs.dd +t/00-report-prereqs.t +t/alfa.t +t/baker.t +t/charlie.t +t/delta.t +t/echo.t +t/foxtrot.t +t/golf.t +t/hotel.t +t/juliett.t +t/lib/Alfa.pm +t/lib/Baker.pm +t/lib/Charlie.pm +t/lib/Delta.pm +t/lib/Echo.pm +t/lib/Foxtrot.pm +t/lib/Golf.pm +t/lib/Hotel.pm +t/lib/India.pm +t/lib/Juliett.pm +t/lib/TestUtils.pm +tidyall.ini +xt/author/00-compile.t +xt/author/critic.t +xt/author/pod-spell.t +xt/release/distmeta.t +xt/release/minimum-version.t +xt/release/pod-coverage.t +xt/release/pod-syntax.t +xt/release/portability.t +xt/release/test-version.t diff --git a/META.json b/META.json new file mode 100644 index 0000000..2cc1230 --- /dev/null +++ b/META.json @@ -0,0 +1,113 @@ +{ + "abstract" : "Minimalist class construction", + "author" : [ + "David Golden <dagolden@cpan.org>" + ], + "dynamic_config" : 1, + "generated_by" : "Dist::Zilla version 5.031, CPAN::Meta::Converter version 2.143240", + "license" : [ + "apache_2_0" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "Class-Tiny", + "no_index" : { + "directory" : [ + "t", + "xt", + "examples", + "corpus" + ], + "package" : [ + "DB" + ] + }, + "prereqs" : { + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "6.17", + "perl" : "5.006" + } + }, + "develop" : { + "requires" : { + "Dist::Zilla" : "5", + "Dist::Zilla::Plugin::OnlyCorePrereqs" : "0.003", + "Dist::Zilla::Plugin::PerlVersionPrereqs" : "0", + "Dist::Zilla::Plugin::Prereqs" : "0", + "Dist::Zilla::Plugin::RemovePrereqs" : "0", + "Dist::Zilla::PluginBundle::DAGOLDEN" : "0.072", + "File::Spec" : "0", + "File::Temp" : "0", + "IO::Handle" : "0", + "IPC::Open3" : "0", + "Pod::Coverage::TrustPod" : "0", + "Test::CPAN::Meta" : "0", + "Test::More" : "0", + "Test::Pod" : "1.41", + "Test::Pod::Coverage" : "1.08", + "Test::Spelling" : "0.12", + "Test::Version" : "1" + } + }, + "runtime" : { + "requires" : { + "Carp" : "0", + "perl" : "5.006", + "strict" : "0", + "warnings" : "0" + } + }, + "test" : { + "recommends" : { + "CPAN::Meta" : "2.120900", + "Test::FailWarnings" : "0" + }, + "requires" : { + "Exporter" : "0", + "ExtUtils::MakeMaker" : "0", + "File::Spec" : "0", + "Test::More" : "0.96", + "base" : "0", + "lib" : "0", + "perl" : "5.006", + "subs" : "0" + } + } + }, + "provides" : { + "Class::Tiny" : { + "file" : "lib/Class/Tiny.pm", + "version" : "1.001" + }, + "Class::Tiny::Object" : { + "file" : "lib/Class/Tiny.pm", + "version" : "1.001" + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "https://github.com/dagolden/Class-Tiny/issues" + }, + "homepage" : "https://github.com/dagolden/Class-Tiny", + "repository" : { + "type" : "git", + "url" : "https://github.com/dagolden/Class-Tiny.git", + "web" : "https://github.com/dagolden/Class-Tiny" + } + }, + "version" : "1.001", + "x_authority" : "cpan:DAGOLDEN", + "x_contributors" : [ + "Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>", + "Gelu Lupas <gelu@devnull.ro>", + "Karen Etheridge <ether@cpan.org>", + "Matt S Trout <mstrout@cpan.org>", + "Olivier Mengué <dolmen@cpan.org>", + "Toby Inkster <tobyink@cpan.org>" + ] +} + diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..2510e2f --- /dev/null +++ b/META.yml @@ -0,0 +1,56 @@ +--- +abstract: 'Minimalist class construction' +author: + - 'David Golden <dagolden@cpan.org>' +build_requires: + Exporter: '0' + ExtUtils::MakeMaker: '0' + File::Spec: '0' + Test::More: '0.96' + base: '0' + lib: '0' + perl: '5.006' + subs: '0' +configure_requires: + ExtUtils::MakeMaker: '6.17' + perl: '5.006' +dynamic_config: 1 +generated_by: 'Dist::Zilla version 5.031, CPAN::Meta::Converter version 2.143240' +license: apache +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Class-Tiny +no_index: + directory: + - t + - xt + - examples + - corpus + package: + - DB +provides: + Class::Tiny: + file: lib/Class/Tiny.pm + version: '1.001' + Class::Tiny::Object: + file: lib/Class/Tiny.pm + version: '1.001' +requires: + Carp: '0' + perl: '5.006' + strict: '0' + warnings: '0' +resources: + bugtracker: https://github.com/dagolden/Class-Tiny/issues + homepage: https://github.com/dagolden/Class-Tiny + repository: https://github.com/dagolden/Class-Tiny.git +version: '1.001' +x_authority: cpan:DAGOLDEN +x_contributors: + - 'Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>' + - 'Gelu Lupas <gelu@devnull.ro>' + - 'Karen Etheridge <ether@cpan.org>' + - 'Matt S Trout <mstrout@cpan.org>' + - 'Olivier Mengué <dolmen@cpan.org>' + - 'Toby Inkster <tobyink@cpan.org>' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..990d788 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,84 @@ + +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.031. +use strict; +use warnings; + +use 5.006; + +use ExtUtils::MakeMaker 6.17; + + + +my %WriteMakefileArgs = ( + "ABSTRACT" => "Minimalist class construction", + "AUTHOR" => "David Golden <dagolden\@cpan.org>", + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => "6.17" + }, + "DISTNAME" => "Class-Tiny", + "EXE_FILES" => [], + "LICENSE" => "apache", + "MIN_PERL_VERSION" => "5.006", + "NAME" => "Class::Tiny", + "PREREQ_PM" => { + "Carp" => 0, + "strict" => 0, + "warnings" => 0 + }, + "TEST_REQUIRES" => { + "Exporter" => 0, + "ExtUtils::MakeMaker" => 0, + "File::Spec" => 0, + "Test::More" => "0.96", + "base" => 0, + "lib" => 0, + "subs" => 0 + }, + "VERSION" => "1.001", + "test" => { + "TESTS" => "t/*.t" + } +); + + +my %FallbackPrereqs = ( + "Carp" => 0, + "Exporter" => 0, + "ExtUtils::MakeMaker" => "6.17", + "File::Spec" => 0, + "Test::More" => "0.96", + "base" => 0, + "lib" => 0, + "strict" => 0, + "subs" => 0, + "warnings" => 0 +); + + +unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { + delete $WriteMakefileArgs{TEST_REQUIRES}; + delete $WriteMakefileArgs{BUILD_REQUIRES}; + $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; +} + +delete $WriteMakefileArgs{CONFIGURE_REQUIRES} + unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; + +if ($] < 5.010) { + $WriteMakefileArgs{PREREQ_PM} = { + %{ $WriteMakefileArgs{PREREQ_PM} }, + "MRO::Compat" => "0", + }; +} + +if ($] < 5.014) { + $WriteMakefileArgs{PREREQ_PM} = { + %{ $WriteMakefileArgs{PREREQ_PM} }, + "Devel::GlobalDestruction" => "0", + }; +} + +WriteMakefile(%WriteMakefileArgs); + + + @@ -0,0 +1,359 @@ +NAME + Class::Tiny - Minimalist class construction + +VERSION + version 1.001 + +SYNOPSIS + In Person.pm: + + package Person; + + use Class::Tiny qw( name ); + + 1; + + In Employee.pm: + + package Employee; + use parent 'Person'; + + use Class::Tiny qw( ssn ), { + timestamp => sub { time } # attribute with default + }; + + 1; + + In example.pl: + + use Employee; + + my $obj = Employee->new( name => "Larry", ssn => "111-22-3333" ); + + # unknown attributes are ignored + my $obj = Employee->new( name => "Larry", OS => "Linux" ); + # $obj->{OS} does not exist + +DESCRIPTION + This module offers a minimalist class construction kit in around 120 + lines of code. Here is a list of features: + + * defines attributes via import arguments + + * generates read-write accessors + + * supports lazy attribute defaults + + * supports custom accessors + + * superclass provides a standard "new" constructor + + * "new" takes a hash reference or list of key/value pairs + + * "new" supports providing "BUILDARGS" to customize constructor + options + + * "new" calls "BUILD" for each class from parent to child + + * superclass provides a "DESTROY" method + + * "DESTROY" calls "DEMOLISH" for each class from child to parent + + Multiple-inheritance is possible, with superclass order determined via + mro::get_linear_isa. + + It uses no non-core modules for any recent Perl. On Perls older than + v5.10 it requires MRO::Compat. On Perls older than v5.14, it requires + Devel::GlobalDestruction. + +USAGE + Defining attributes + Define attributes as a list of import arguments: + + package Foo::Bar; + + use Class::Tiny qw( + name + id + height + weight + ); + + For each attribute, a read-write accessor is created unless a subroutine + of that name already exists: + + $obj->name; # getter + $obj->name( "John Doe" ); # setter + + Attribute names must be valid subroutine identifiers or an exception + will be thrown. + + You can specify lazy defaults by defining attributes with a hash + reference. Keys define attribute names and values are constants or code + references that will be evaluated when the attribute is first accessed + if no value has been set. The object is passed as an argument to a code + reference. + + package Foo::WithDefaults; + + use Class::Tiny qw/name id/, { + title => 'Peon', + skills => sub { [] }, + hire_date => sub { $_[0]->_build_hire_date }, + }; + + When subclassing, if multiple accessors of the same name exist in + different classes, any default (or lack of default) is determined by + standard method resolution order. + + To make your own custom accessors, just pre-declare the method name + before loading Class::Tiny: + + package Foo::Bar; + + use subs 'id'; + + use Class::Tiny qw( name id ); + + sub id { ... } + + Even if you pre-declare a method name, you must include it in the + attribute list for Class::Tiny to register it as a valid attribute. + + If you set a default for a custom accessor, your accessor will need to + retrieve the default and do something with it: + + package Foo::Bar; + + use subs 'id'; + + use Class::Tiny qw( name ), { id => sub { int(rand(2*31)) } }; + + sub id { + my $self = shift; + if (@_) { + return $self->{id} = shift; + } + elsif ( exists $self->{id} ) { + return $self->{id}; + } + else { + my $defaults = + Class::Tiny->get_all_attribute_defaults_for( ref $self ); + return $self->{id} = $defaults->{id}->(); + } + } + + Class::Tiny::Object is your base class + If your class does not already inherit from some class, then + Class::Tiny::Object will be added to your @ISA to provide "new" and + "DESTROY". + + If your class does inherit from something, then no additional + inheritance is set up. If the parent subclasses Class::Tiny::Object, + then all is well. If not, then you'll get accessors set up but no + constructor or destructor. Don't do that unless you really have a + special need for it. + + Define subclasses as normal. It's best to define them with base, parent + or superclass before defining attributes with Class::Tiny so the @ISA + array is already populated at compile-time: + + package Foo::Bar::More; + + use parent 'Foo::Bar'; + + use Class::Tiny qw( shoe_size ); + + Object construction + If your class inherits from Class::Tiny::Object (as it should if you + followed the advice above), it provides the "new" constructor for you. + + Objects can be created with attributes given as a hash reference or as a + list of key/value pairs: + + $obj = Foo::Bar->new( name => "David" ); + + $obj = Foo::Bar->new( { name => "David" } ); + + If a reference is passed as a single argument, it must be able to be + dereferenced as a hash or an exception is thrown. + + Unknown attributes in the constructor arguments will be ignored. Prior + to version 1.000, unknown attributes were an error, but this made it + harder for people to cleanly subclass Class::Tiny classes so this + feature was removed. + + You can define a "BUILDARGS" method to change how arguments to new are + handled. It will receive the constructor arguments as they were provided + and must return a hash reference of key/value pairs (or else throw an + exception). + + sub BUILDARGS { + my $class = shift; + my $name = shift || "John Doe"; + return { name => $name }; + }; + + Foo::Bar->new( "David" ); + Foo::Bar->new(); # "John Doe" + + Unknown attributes returned from "BUILDARGS" will be ignored. + + BUILD + If your class or any superclass defines a "BUILD" method, it will be + called by the constructor from the furthest parent class down to the + child class after the object has been created. + + It is passed the constructor arguments as a hash reference. The return + value is ignored. Use "BUILD" for validation, checking required + attributes or setting default values that depend on other attributes. + + sub BUILD { + my ($self, $args) = @_; + + for my $req ( qw/name age/ ) { + croak "$req attribute required" unless defined $self->$req; + } + + croak "Age must be non-negative" if $self->age < 0; + + $self->msg( "Hello " . $self->name ); + } + + The argument reference is a copy, so deleting elements won't affect data + in the original (but changes will be passed to other BUILD methods in + @ISA). + + DEMOLISH + Class::Tiny provides a "DESTROY" method. If your class or any superclass + defines a "DEMOLISH" method, they will be called from the child class to + the furthest parent class during object destruction. It is provided a + single boolean argument indicating whether Perl is in global + destruction. Return values and errors are ignored. + + sub DEMOLISH { + my ($self, $global_destruct) = @_; + $self->cleanup(); + } + + Introspection and internals + You can retrieve an unsorted list of valid attributes known to + Class::Tiny for a class and its superclasses with the + "get_all_attributes_for" class method. + + my @attrs = Class::Tiny->get_all_attributes_for("Employee"); + # returns qw/name ssn timestamp/ + + Likewise, a hash reference of all valid attributes and default values + (or code references) may be retrieved with the + "get_all_attribute_defaults_for" class method. Any attributes without a + default will be "undef". + + my $def = Class::Tiny->get_all_attribute_defaults_for("Employee"); + # returns { + # name => undef, + # ssn => undef + # timestamp => $coderef + # } + + The "import" method uses two class methods, "prepare_class" and + "create_attributes" to set up the @ISA array and attributes. Anyone + attempting to extend Class::Tiny itself should use these instead of + mocking up a call to "import". + + When the first object is created, linearized @ISA, the valid attribute + list and various subroutine references are cached for speed. Ensure that + all inheritance and methods are in place before creating objects. (You + don't want to be changing that once you create objects anyway, right?) + +RATIONALE + Why this instead of Object::Tiny or Class::Accessor or something else? + I wanted something so simple that it could potentially be used by core + Perl modules I help maintain (or hope to write), most of which either + use Class::Struct or roll-their-own OO framework each time. + + Object::Tiny and Object::Tiny::RW were close to what I wanted, but + lacking some features I deemed necessary, and their maintainers have an + even more strict philosophy against feature creep than I have. + + I also considered Class::Accessor, which has been around a long time and + is heavily used, but it, too, lacked features I wanted and did things in + ways I considered poor design. + + I looked for something else on CPAN, but after checking a dozen class + creators I realized I could implement exactly what I wanted faster than + I could search CPAN for something merely sufficient. + + In general, compared to most things on CPAN (other than Object::Tiny), + Class::Tiny is smaller in implementation and simpler in API. + + Specifically, here is how Class::Tiny ("C::T") compares to Object::Tiny + ("O::T") and Class::Accessor ("C::A"): + + FEATURE C::T O::T C::A + -------------------------------------------------------------- + attributes defined via import yes yes no + read/write accessors yes no yes + lazy attribute defaults yes no no + provides new yes yes yes + provides DESTROY yes no no + new takes either hashref or list yes no (list) no (hash) + Moo(se)-like BUILD/DEMOLISH yes no no + Moo(se)-like BUILDARGS yes no no + no extraneous methods via @ISA yes yes no + + Why this instead of Moose or Moo? + Moose and Moo are both excellent OO frameworks. Moose offers a powerful + meta-object protocol (MOP), but is slow to start up and has about 30 + non-core dependencies including XS modules. Moo is faster to start up + and has about 10 pure Perl dependencies but provides no true MOP, + relying instead on its ability to transparently upgrade Moo to Moose + when Moose's full feature set is required. + + By contrast, Class::Tiny has no MOP and has zero non-core dependencies + for Perls in the support window. It has far less code, less complexity + and no learning curve. If you don't need or can't afford what Moo or + Moose offer, this is intended to be a reasonable fallback. + + That said, Class::Tiny offers Moose-like conventions for things like + "BUILD" and "DEMOLISH" for some minimal interoperability and an easier + upgrade path. + +SUPPORT + Bugs / Feature Requests + Please report any bugs or feature requests through the issue tracker at + <https://github.com/dagolden/Class-Tiny/issues>. You will be notified + automatically of any progress on your issue. + + Source Code + This is open source software. The code repository is available for + public review and contribution under the terms of the license. + + <https://github.com/dagolden/Class-Tiny> + + git clone https://github.com/dagolden/Class-Tiny.git + +AUTHOR + David Golden <dagolden@cpan.org> + +CONTRIBUTORS + * Dagfinn Ilmari Mannsåker <ilmari@ilmari.org> + + * Gelu Lupas <gelu@devnull.ro> + + * Karen Etheridge <ether@cpan.org> + + * Matt S Trout <mstrout@cpan.org> + + * Olivier Mengué <dolmen@cpan.org> + + * Toby Inkster <tobyink@cpan.org> + +COPYRIGHT AND LICENSE + This software is Copyright (c) 2013 by David Golden. + + This is free software, licensed under: + + The Apache License, Version 2.0, January 2004 + diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..2d91866 --- /dev/null +++ b/cpanfile @@ -0,0 +1,45 @@ +requires "Carp" => "0"; +requires "perl" => "5.006"; +requires "strict" => "0"; +requires "warnings" => "0"; + +on 'test' => sub { + requires "Exporter" => "0"; + requires "ExtUtils::MakeMaker" => "0"; + requires "File::Spec" => "0"; + requires "Test::More" => "0.96"; + requires "base" => "0"; + requires "lib" => "0"; + requires "perl" => "5.006"; + requires "subs" => "0"; +}; + +on 'test' => sub { + recommends "CPAN::Meta" => "2.120900"; + recommends "Test::FailWarnings" => "0"; +}; + +on 'configure' => sub { + requires "ExtUtils::MakeMaker" => "6.17"; + requires "perl" => "5.006"; +}; + +on 'develop' => sub { + requires "Dist::Zilla" => "5"; + requires "Dist::Zilla::Plugin::OnlyCorePrereqs" => "0.003"; + requires "Dist::Zilla::Plugin::PerlVersionPrereqs" => "0"; + requires "Dist::Zilla::Plugin::Prereqs" => "0"; + requires "Dist::Zilla::Plugin::RemovePrereqs" => "0"; + requires "Dist::Zilla::PluginBundle::DAGOLDEN" => "0.072"; + requires "File::Spec" => "0"; + requires "File::Temp" => "0"; + requires "IO::Handle" => "0"; + requires "IPC::Open3" => "0"; + requires "Pod::Coverage::TrustPod" => "0"; + requires "Test::CPAN::Meta" => "0"; + requires "Test::More" => "0"; + requires "Test::Pod" => "1.41"; + requires "Test::Pod::Coverage" => "1.08"; + requires "Test::Spelling" => "0.12"; + requires "Test::Version" => "1"; +}; diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..cf12c8f --- /dev/null +++ b/dist.ini @@ -0,0 +1,33 @@ +name = Class-Tiny +author = David Golden <dagolden@cpan.org> +license = Apache_2_0 +copyright_holder = David Golden +copyright_year = 2013 + +[@DAGOLDEN] +:version = 0.072 +RewriteVersion.global = 1 +BumpVersionAfterRelease.global = 1 +stopwords = destructor +stopwords = fatpacking +stopwords = interoperability +stopwords = linearized + +[RemovePrereqs] +remove = Devel::GlobalDestruction +remove = MRO::Compat +remove = Test::FailWarnings +remove = mro + +[Prereqs / TestRecommends ] +Test::FailWarnings = 0 + +[PerlVersionPrereqs / 5.010] +MRO::Compat = 0 + +[PerlVersionPrereqs / 5.014] +Devel::GlobalDestruction = 0 + +[OnlyCorePrereqs] +:version = 0.003 +starting_version = current diff --git a/lib/Class/Tiny.pm b/lib/Class/Tiny.pm new file mode 100644 index 0000000..6056f9b --- /dev/null +++ b/lib/Class/Tiny.pm @@ -0,0 +1,592 @@ +use 5.006; +use strict; +no strict 'refs'; +use warnings; + +package Class::Tiny; +# ABSTRACT: Minimalist class construction + +our $VERSION = '1.001'; + +use Carp (); + +# load as .pm to hide from min version scanners +require( $] >= 5.010 ? "mro.pm" : "MRO/Compat.pm" ); ## no critic: + +my %CLASS_ATTRIBUTES; + +sub import { + my $class = shift; + my $pkg = caller; + $class->prepare_class($pkg); + $class->create_attributes( $pkg, @_ ) if @_; +} + +sub prepare_class { + my ( $class, $pkg ) = @_; + @{"${pkg}::ISA"} = "Class::Tiny::Object" unless @{"${pkg}::ISA"}; +} + +# adapted from Object::Tiny and Object::Tiny::RW +sub create_attributes { + my ( $class, $pkg, @spec ) = @_; + my %defaults = map { ref $_ eq 'HASH' ? %$_ : ( $_ => undef ) } @spec; + my @attr = grep { + defined and !ref and /^[^\W\d]\w*$/s + or Carp::croak "Invalid accessor name '$_'" + } keys %defaults; + $CLASS_ATTRIBUTES{$pkg}{$_} = $defaults{$_} for @attr; + _gen_accessor( $pkg, $_ ) for grep { !*{"$pkg\::$_"}{CODE} } @attr; + Carp::croak("Failed to generate attributes for $pkg: $@\n") if $@; +} + +sub _gen_accessor { + my ( $pkg, $name ) = @_; + my $outer_default = $CLASS_ATTRIBUTES{$pkg}{$name}; + + my $sub = "sub $name { if (\@_ == 1) {"; + if ( defined $outer_default && ref $outer_default eq 'CODE' ) { + $sub .= "if ( !exists \$_[0]{$name} ) { \$_[0]{$name} = \$default->(\$_[0]) }"; + } + elsif ( defined $outer_default ) { + $sub .= "if ( !exists \$_[0]{$name} ) { \$_[0]{$name} = \$default }"; + } + $sub .= "return \$_[0]{$name} } else { return \$_[0]{$name}=\$_[1] } }"; + + # default = outer_default avoids "won't stay shared" bug + eval "package $pkg; my \$default=\$outer_default; $sub"; ## no critic + Carp::croak("Failed to generate attributes for $pkg: $@\n") if $@; +} + +sub get_all_attributes_for { + my ( $class, $pkg ) = @_; + my %attr = + map { $_ => undef } + map { keys %{ $CLASS_ATTRIBUTES{$_} || {} } } @{ mro::get_linear_isa($pkg) }; + return keys %attr; +} + +sub get_all_attribute_defaults_for { + my ( $class, $pkg ) = @_; + my $defaults = {}; + for my $p ( reverse @{ mro::get_linear_isa($pkg) } ) { + while ( my ( $k, $v ) = each %{ $CLASS_ATTRIBUTES{$p} || {} } ) { + $defaults->{$k} = $v; + } + } + return $defaults; +} + +package Class::Tiny::Object; +# ABSTRACT: Base class for classes built with Class::Tiny + +our $VERSION = '1.001'; + +my ( %HAS_BUILDARGS, %BUILD_CACHE, %DEMOLISH_CACHE, %ATTR_CACHE ); + +my $_PRECACHE = sub { + no warnings 'once'; # needed to avoid downstream warnings + my ($class) = @_; + my $linear_isa = + @{"$class\::ISA"} == 1 && ${"$class\::ISA"}[0] eq "Class::Tiny::Object" + ? [$class] + : mro::get_linear_isa($class); + $DEMOLISH_CACHE{$class} = [ + map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () } + map { "$_\::DEMOLISH" } @$linear_isa + ]; + $BUILD_CACHE{$class} = [ + map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () } + map { "$_\::BUILD" } reverse @$linear_isa + ]; + $HAS_BUILDARGS{$class} = $class->can("BUILDARGS"); + return $ATTR_CACHE{$class} = + { map { $_ => 1 } Class::Tiny->get_all_attributes_for($class) }; +}; + +sub new { + my $class = shift; + my $valid_attrs = $ATTR_CACHE{$class} || $_PRECACHE->($class); + + # handle hash ref or key/value arguments + my $args; + if ( $HAS_BUILDARGS{$class} ) { + $args = $class->BUILDARGS(@_); + } + else { + if ( @_ == 1 && ref $_[0] ) { + my %copy = eval { %{ $_[0] } }; # try shallow copy + Carp::croak("Argument to $class->new() could not be dereferenced as a hash") if $@; + $args = \%copy; + } + elsif ( @_ % 2 == 0 ) { + $args = {@_}; + } + else { + Carp::croak("$class->new() got an odd number of elements"); + } + } + + # create object and invoke BUILD (unless we were given __no_BUILD__) + my $self = + bless { map { $_ => $args->{$_} } grep { exists $valid_attrs->{$_} } keys %$args }, + $class; + $self->BUILDALL($args) if !delete $args->{__no_BUILD__} && @{ $BUILD_CACHE{$class} }; + + return $self; +} + +sub BUILDALL { $_->(@_) for @{ $BUILD_CACHE{ ref $_[0] } } } + +# Adapted from Moo and its dependencies +require Devel::GlobalDestruction unless defined ${^GLOBAL_PHASE}; + +sub DESTROY { + my $self = shift; + my $class = ref $self; + my $in_global_destruction = + defined ${^GLOBAL_PHASE} + ? ${^GLOBAL_PHASE} eq 'DESTRUCT' + : Devel::GlobalDestruction::in_global_destruction(); + for my $demolisher ( @{ $DEMOLISH_CACHE{$class} } ) { + my $e = do { + local ( $?, $@ ); + eval { $demolisher->( $self, $in_global_destruction ) }; + $@; + }; + no warnings 'misc'; # avoid (in cleanup) warnings + die $e if $e; # rethrow + } +} + +1; + + +# vim: ts=4 sts=4 sw=4 et: + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Class::Tiny - Minimalist class construction + +=head1 VERSION + +version 1.001 + +=head1 SYNOPSIS + +In F<Person.pm>: + + package Person; + + use Class::Tiny qw( name ); + + 1; + +In F<Employee.pm>: + + package Employee; + use parent 'Person'; + + use Class::Tiny qw( ssn ), { + timestamp => sub { time } # attribute with default + }; + + 1; + +In F<example.pl>: + + use Employee; + + my $obj = Employee->new( name => "Larry", ssn => "111-22-3333" ); + + # unknown attributes are ignored + my $obj = Employee->new( name => "Larry", OS => "Linux" ); + # $obj->{OS} does not exist + +=head1 DESCRIPTION + +This module offers a minimalist class construction kit in around 120 lines of +code. Here is a list of features: + +=over 4 + +=item * + +defines attributes via import arguments + +=item * + +generates read-write accessors + +=item * + +supports lazy attribute defaults + +=item * + +supports custom accessors + +=item * + +superclass provides a standard C<new> constructor + +=item * + +C<new> takes a hash reference or list of key/value pairs + +=item * + +C<new> supports providing C<BUILDARGS> to customize constructor options + +=item * + +C<new> calls C<BUILD> for each class from parent to child + +=item * + +superclass provides a C<DESTROY> method + +=item * + +C<DESTROY> calls C<DEMOLISH> for each class from child to parent + +=back + +Multiple-inheritance is possible, with superclass order determined via +L<mro::get_linear_isa|mro/Functions>. + +It uses no non-core modules for any recent Perl. On Perls older than v5.10 it +requires L<MRO::Compat>. On Perls older than v5.14, it requires +L<Devel::GlobalDestruction>. + +=head1 USAGE + +=head2 Defining attributes + +Define attributes as a list of import arguments: + + package Foo::Bar; + + use Class::Tiny qw( + name + id + height + weight + ); + +For each attribute, a read-write accessor is created unless a subroutine of that +name already exists: + + $obj->name; # getter + $obj->name( "John Doe" ); # setter + +Attribute names must be valid subroutine identifiers or an exception will +be thrown. + +You can specify lazy defaults by defining attributes with a hash reference. +Keys define attribute names and values are constants or code references that +will be evaluated when the attribute is first accessed if no value has been +set. The object is passed as an argument to a code reference. + + package Foo::WithDefaults; + + use Class::Tiny qw/name id/, { + title => 'Peon', + skills => sub { [] }, + hire_date => sub { $_[0]->_build_hire_date }, + }; + +When subclassing, if multiple accessors of the same name exist in different +classes, any default (or lack of default) is determined by standard +method resolution order. + +To make your own custom accessors, just pre-declare the method name before +loading Class::Tiny: + + package Foo::Bar; + + use subs 'id'; + + use Class::Tiny qw( name id ); + + sub id { ... } + +Even if you pre-declare a method name, you must include it in the attribute +list for Class::Tiny to register it as a valid attribute. + +If you set a default for a custom accessor, your accessor will need to retrieve +the default and do something with it: + + package Foo::Bar; + + use subs 'id'; + + use Class::Tiny qw( name ), { id => sub { int(rand(2*31)) } }; + + sub id { + my $self = shift; + if (@_) { + return $self->{id} = shift; + } + elsif ( exists $self->{id} ) { + return $self->{id}; + } + else { + my $defaults = + Class::Tiny->get_all_attribute_defaults_for( ref $self ); + return $self->{id} = $defaults->{id}->(); + } + } + +=head2 Class::Tiny::Object is your base class + +If your class B<does not> already inherit from some class, then +Class::Tiny::Object will be added to your C<@ISA> to provide C<new> and +C<DESTROY>. + +If your class B<does> inherit from something, then no additional inheritance is +set up. If the parent subclasses Class::Tiny::Object, then all is well. If +not, then you'll get accessors set up but no constructor or destructor. Don't +do that unless you really have a special need for it. + +Define subclasses as normal. It's best to define them with L<base>, L<parent> +or L<superclass> before defining attributes with Class::Tiny so the C<@ISA> +array is already populated at compile-time: + + package Foo::Bar::More; + + use parent 'Foo::Bar'; + + use Class::Tiny qw( shoe_size ); + +=head2 Object construction + +If your class inherits from Class::Tiny::Object (as it should if you followed +the advice above), it provides the C<new> constructor for you. + +Objects can be created with attributes given as a hash reference or as a list +of key/value pairs: + + $obj = Foo::Bar->new( name => "David" ); + + $obj = Foo::Bar->new( { name => "David" } ); + +If a reference is passed as a single argument, it must be able to be +dereferenced as a hash or an exception is thrown. + +Unknown attributes in the constructor arguments will be ignored. Prior to +version 1.000, unknown attributes were an error, but this made it harder for +people to cleanly subclass Class::Tiny classes so this feature was removed. + +You can define a C<BUILDARGS> method to change how arguments to new are +handled. It will receive the constructor arguments as they were provided and +must return a hash reference of key/value pairs (or else throw an +exception). + + sub BUILDARGS { + my $class = shift; + my $name = shift || "John Doe"; + return { name => $name }; + }; + + Foo::Bar->new( "David" ); + Foo::Bar->new(); # "John Doe" + +Unknown attributes returned from C<BUILDARGS> will be ignored. + +=head2 BUILD + +If your class or any superclass defines a C<BUILD> method, it will be called +by the constructor from the furthest parent class down to the child class after +the object has been created. + +It is passed the constructor arguments as a hash reference. The return value +is ignored. Use C<BUILD> for validation, checking required attributes or +setting default values that depend on other attributes. + + sub BUILD { + my ($self, $args) = @_; + + for my $req ( qw/name age/ ) { + croak "$req attribute required" unless defined $self->$req; + } + + croak "Age must be non-negative" if $self->age < 0; + + $self->msg( "Hello " . $self->name ); + } + +The argument reference is a copy, so deleting elements won't affect data in the +original (but changes will be passed to other BUILD methods in C<@ISA>). + +=head2 DEMOLISH + +Class::Tiny provides a C<DESTROY> method. If your class or any superclass +defines a C<DEMOLISH> method, they will be called from the child class to the +furthest parent class during object destruction. It is provided a single +boolean argument indicating whether Perl is in global destruction. Return +values and errors are ignored. + + sub DEMOLISH { + my ($self, $global_destruct) = @_; + $self->cleanup(); + } + +=head2 Introspection and internals + +You can retrieve an unsorted list of valid attributes known to Class::Tiny +for a class and its superclasses with the C<get_all_attributes_for> class +method. + + my @attrs = Class::Tiny->get_all_attributes_for("Employee"); + # returns qw/name ssn timestamp/ + +Likewise, a hash reference of all valid attributes and default values (or code +references) may be retrieved with the C<get_all_attribute_defaults_for> class +method. Any attributes without a default will be C<undef>. + + my $def = Class::Tiny->get_all_attribute_defaults_for("Employee"); + # returns { + # name => undef, + # ssn => undef + # timestamp => $coderef + # } + +The C<import> method uses two class methods, C<prepare_class> and +C<create_attributes> to set up the C<@ISA> array and attributes. Anyone +attempting to extend Class::Tiny itself should use these instead of mocking up +a call to C<import>. + +When the first object is created, linearized C<@ISA>, the valid attribute list +and various subroutine references are cached for speed. Ensure that all +inheritance and methods are in place before creating objects. (You don't want +to be changing that once you create objects anyway, right?) + +=for Pod::Coverage new get_all_attributes_for get_all_attribute_defaults_for +prepare_class create_attributes + +=head1 RATIONALE + +=head2 Why this instead of Object::Tiny or Class::Accessor or something else? + +I wanted something so simple that it could potentially be used by core Perl +modules I help maintain (or hope to write), most of which either use +L<Class::Struct> or roll-their-own OO framework each time. + +L<Object::Tiny> and L<Object::Tiny::RW> were close to what I wanted, but +lacking some features I deemed necessary, and their maintainers have an even +more strict philosophy against feature creep than I have. + +I also considered L<Class::Accessor>, which has been around a long time and is +heavily used, but it, too, lacked features I wanted and did things in ways I +considered poor design. + +I looked for something else on CPAN, but after checking a dozen class creators +I realized I could implement exactly what I wanted faster than I could search +CPAN for something merely sufficient. + +In general, compared to most things on CPAN (other than Object::Tiny), +Class::Tiny is smaller in implementation and simpler in API. + +Specifically, here is how Class::Tiny ("C::T") compares to Object::Tiny +("O::T") and Class::Accessor ("C::A"): + + FEATURE C::T O::T C::A + -------------------------------------------------------------- + attributes defined via import yes yes no + read/write accessors yes no yes + lazy attribute defaults yes no no + provides new yes yes yes + provides DESTROY yes no no + new takes either hashref or list yes no (list) no (hash) + Moo(se)-like BUILD/DEMOLISH yes no no + Moo(se)-like BUILDARGS yes no no + no extraneous methods via @ISA yes yes no + +=head2 Why this instead of Moose or Moo? + +L<Moose> and L<Moo> are both excellent OO frameworks. Moose offers a powerful +meta-object protocol (MOP), but is slow to start up and has about 30 non-core +dependencies including XS modules. Moo is faster to start up and has about 10 +pure Perl dependencies but provides no true MOP, relying instead on its ability +to transparently upgrade Moo to Moose when Moose's full feature set is +required. + +By contrast, Class::Tiny has no MOP and has B<zero> non-core dependencies for +Perls in the L<support window|perlpolicy>. It has far less code, less +complexity and no learning curve. If you don't need or can't afford what Moo or +Moose offer, this is intended to be a reasonable fallback. + +That said, Class::Tiny offers Moose-like conventions for things like C<BUILD> +and C<DEMOLISH> for some minimal interoperability and an easier upgrade path. + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan + +=head1 SUPPORT + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests through the issue tracker +at L<https://github.com/dagolden/Class-Tiny/issues>. +You will be notified automatically of any progress on your issue. + +=head2 Source Code + +This is open source software. The code repository is available for +public review and contribution under the terms of the license. + +L<https://github.com/dagolden/Class-Tiny> + + git clone https://github.com/dagolden/Class-Tiny.git + +=head1 AUTHOR + +David Golden <dagolden@cpan.org> + +=head1 CONTRIBUTORS + +=for stopwords Dagfinn Ilmari Mannsåker Gelu Lupas Karen Etheridge Matt S Trout Olivier Mengué Toby Inkster + +=over 4 + +=item * + +Dagfinn Ilmari Mannsåker <ilmari@ilmari.org> + +=item * + +Gelu Lupas <gelu@devnull.ro> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Matt S Trout <mstrout@cpan.org> + +=item * + +Olivier Mengué <dolmen@cpan.org> + +=item * + +Toby Inkster <tobyink@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is Copyright (c) 2013 by David Golden. + +This is free software, licensed under: + + The Apache License, Version 2.0, January 2004 + +=cut diff --git a/perlcritic.rc b/perlcritic.rc new file mode 100644 index 0000000..cef05a8 --- /dev/null +++ b/perlcritic.rc @@ -0,0 +1,23 @@ +severity = 5 +verbose = 8 + +[Variables::ProhibitPunctuationVars] +allow = $@ $! + +[TestingAndDebugging::ProhibitNoStrict] +allow = refs + +# Turn these off +[-BuiltinFunctions::ProhibitStringyEval] +[-ControlStructures::ProhibitPostfixControls] +[-ControlStructures::ProhibitUnlessBlocks] +[-Documentation::RequirePodSections] +[-InputOutput::ProhibitInteractiveTest] +[-References::ProhibitDoubleSigils] +[-RegularExpressions::RequireExtendedFormatting] +[-InputOutput::ProhibitTwoArgOpen] +[-Modules::ProhibitEvilModules] + +# Turn this on +[Lax::ProhibitStringyEval::ExceptForRequire] + diff --git a/t/00-report-prereqs.dd b/t/00-report-prereqs.dd new file mode 100644 index 0000000..044b078 --- /dev/null +++ b/t/00-report-prereqs.dd @@ -0,0 +1,55 @@ +do { my $x = { + 'configure' => { + 'requires' => { + 'ExtUtils::MakeMaker' => '6.17', + 'perl' => '5.006' + } + }, + 'develop' => { + 'requires' => { + 'Dist::Zilla' => '5', + 'Dist::Zilla::Plugin::OnlyCorePrereqs' => '0.003', + 'Dist::Zilla::Plugin::PerlVersionPrereqs' => '0', + 'Dist::Zilla::Plugin::Prereqs' => '0', + 'Dist::Zilla::Plugin::RemovePrereqs' => '0', + 'Dist::Zilla::PluginBundle::DAGOLDEN' => '0.072', + 'File::Spec' => '0', + 'File::Temp' => '0', + 'IO::Handle' => '0', + 'IPC::Open3' => '0', + 'Pod::Coverage::TrustPod' => '0', + 'Test::CPAN::Meta' => '0', + 'Test::More' => '0', + 'Test::Pod' => '1.41', + 'Test::Pod::Coverage' => '1.08', + 'Test::Spelling' => '0.12', + 'Test::Version' => '1' + } + }, + 'runtime' => { + 'requires' => { + 'Carp' => '0', + 'perl' => '5.006', + 'strict' => '0', + 'warnings' => '0' + } + }, + 'test' => { + 'recommends' => { + 'CPAN::Meta' => '2.120900', + 'Test::FailWarnings' => '0' + }, + 'requires' => { + 'Exporter' => '0', + 'ExtUtils::MakeMaker' => '0', + 'File::Spec' => '0', + 'Test::More' => '0.96', + 'base' => '0', + 'lib' => '0', + 'perl' => '5.006', + 'subs' => '0' + } + } + }; + $x; + }
\ No newline at end of file diff --git a/t/00-report-prereqs.t b/t/00-report-prereqs.t new file mode 100644 index 0000000..b0e7e65 --- /dev/null +++ b/t/00-report-prereqs.t @@ -0,0 +1,183 @@ +#!perl + +use strict; +use warnings; + +# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.020 + +use Test::More tests => 1; + +use ExtUtils::MakeMaker; +use File::Spec; + +# from $version::LAX +my $lax_version_re = + qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? + | + (?:\.[0-9]+) (?:_[0-9]+)? + ) | (?: + v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? + | + (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? + ) + )/x; + +# hide optional CPAN::Meta modules from prereq scanner +# and check if they are available +my $cpan_meta = "CPAN::Meta"; +my $cpan_meta_pre = "CPAN::Meta::Prereqs"; +my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic + +# Verify requirements? +my $DO_VERIFY_PREREQS = 1; + +sub _max { + my $max = shift; + $max = ( $_ > $max ) ? $_ : $max for @_; + return $max; +} + +sub _merge_prereqs { + my ($collector, $prereqs) = @_; + + # CPAN::Meta::Prereqs object + if (ref $collector eq $cpan_meta_pre) { + return $collector->with_merged_prereqs( + CPAN::Meta::Prereqs->new( $prereqs ) + ); + } + + # Raw hashrefs + for my $phase ( keys %$prereqs ) { + for my $type ( keys %{ $prereqs->{$phase} } ) { + for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { + $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; + } + } + } + + return $collector; +} + +my @include = qw( + +); + +my @exclude = qw( + +); + +# Add static prereqs to the included modules list +my $static_prereqs = do 't/00-report-prereqs.dd'; + +# Merge all prereqs (either with ::Prereqs or a hashref) +my $full_prereqs = _merge_prereqs( + ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), + $static_prereqs +); + +# Add dynamic prereqs to the included modules list (if we can) +my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; +if ( $source && $HAS_CPAN_META ) { + if ( my $meta = eval { CPAN::Meta->load_file($source) } ) { + $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); + } +} +else { + $source = 'static metadata'; +} + +my @full_reports; +my @dep_errors; +my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; + +# Add static includes into a fake section +for my $mod (@include) { + $req_hash->{other}{modules}{$mod} = 0; +} + +for my $phase ( qw(configure build test runtime develop other) ) { + next unless $req_hash->{$phase}; + next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); + + for my $type ( qw(requires recommends suggests conflicts modules) ) { + next unless $req_hash->{$phase}{$type}; + + my $title = ucfirst($phase).' '.ucfirst($type); + my @reports = [qw/Module Want Have/]; + + for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { + next if $mod eq 'perl'; + next if grep { $_ eq $mod } @exclude; + + my $file = $mod; + $file =~ s{::}{/}g; + $file .= ".pm"; + my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; + + my $want = $req_hash->{$phase}{$type}{$mod}; + $want = "undef" unless defined $want; + $want = "any" if !$want && $want == 0; + + my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; + + if ($prefix) { + my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); + $have = "undef" unless defined $have; + push @reports, [$mod, $want, $have]; + + if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { + if ( $have !~ /\A$lax_version_re\z/ ) { + push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; + } + elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { + push @dep_errors, "$mod version '$have' is not in required range '$want'"; + } + } + } + else { + push @reports, [$mod, $want, "missing"]; + + if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { + push @dep_errors, "$mod is not installed ($req_string)"; + } + } + } + + if ( @reports ) { + push @full_reports, "=== $title ===\n\n"; + + my $ml = _max( map { length $_->[0] } @reports ); + my $wl = _max( map { length $_->[1] } @reports ); + my $hl = _max( map { length $_->[2] } @reports ); + + if ($type eq 'modules') { + splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; + push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; + } + else { + splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; + push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; + } + + push @full_reports, "\n"; + } + } +} + +if ( @full_reports ) { + diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; +} + +if ( @dep_errors ) { + diag join("\n", + "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n", + "The following REQUIRED prerequisites were not satisfied:\n", + @dep_errors, + "\n" + ); +} + +pass; + +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/alfa.t b/t/alfa.t new file mode 100644 index 0000000..8bd97fb --- /dev/null +++ b/t/alfa.t @@ -0,0 +1,90 @@ +use 5.006; +use strict; +use warnings; +use lib 't/lib'; + +use Test::More 0.96; +use TestUtils; + +require_ok("Alfa"); + +subtest "empty list constructor" => sub { + my $obj = new_ok("Alfa"); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, undef, "bar is undef" ); +}; + +subtest "empty hash object constructor" => sub { + my $obj = new_ok( "Alfa", [ {} ] ); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, undef, "bar is undef" ); +}; + +subtest "one attribute set as list" => sub { + my $obj = new_ok( "Alfa", [ foo => 23 ] ); + is( $obj->foo, 23, "foo is set" ); + is( $obj->bar, undef, "bar is undef" ); +}; + +subtest "one attribute set as hash ref" => sub { + my $obj = new_ok( "Alfa", [ { foo => 23 } ] ); + is( $obj->foo, 23, "foo is set" ); + is( $obj->bar, undef, "bar is undef" ); +}; + +subtest "both attributes set as list" => sub { + my $obj = new_ok( "Alfa", [ foo => 23, bar => 42 ] ); + is( $obj->foo, 23, "foo is set" ); + is( $obj->bar, 42, "bar is set" ); +}; + +subtest "both attributes set as hash ref" => sub { + my $obj = new_ok( "Alfa", [ { foo => 23, bar => 42 } ] ); + is( $obj->foo, 23, "foo is set" ); + is( $obj->bar, 42, "bar is set" ); +}; + +subtest "constructor makes shallow copy" => sub { + my $fake = bless { foo => 23, bar => 42 }, "Fake"; + my $obj = new_ok( "Alfa", [$fake] ); + is( ref $fake, "Fake", "object passed to constructor is original class" ); + is( $obj->foo, 23, "foo is set" ); + is( $obj->bar, 42, "bar is set" ); +}; + +subtest "attributes are RW" => sub { + my $obj = new_ok( "Alfa", [ { foo => 23, bar => 42 } ] ); + is( $obj->foo(24), 24, "changing foo returns new value" ); + is( $obj->foo, 24, "accessing foo returns changed value" ); +}; + +subtest "unknown attributes stripped" => sub { + my $obj = new_ok( "Alfa", [ { wibble => 1 } ], "new( wibble => 1 )" ); + ok( !exists $obj->{wibble}, "unknown attribute 'wibble' not in object" ); +}; + +subtest "exceptions" => sub { + like( + exception { Alfa->new(qw/ foo bar baz/) }, + qr/Alfa->new\(\) got an odd number of elements/, + "creating object with odd elements dies", + ); + + like( + exception { Alfa->new( [] ) }, + qr/Argument to Alfa->new\(\) could not be dereferenced as a hash/, + "creating object with array ref dies", + ); +}; + +done_testing; +# +# This file is part of Class-Tiny +# +# This software is Copyright (c) 2013 by David Golden. +# +# This is free software, licensed under: +# +# The Apache License, Version 2.0, January 2004 +# +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/baker.t b/t/baker.t new file mode 100644 index 0000000..8444b86 --- /dev/null +++ b/t/baker.t @@ -0,0 +1,72 @@ +use 5.006; +use strict; +use warnings; +use lib 't/lib'; + +use Test::More 0.96; +use TestUtils; + +require_ok("Baker"); + +subtest "attribute list" => sub { + is_deeply( + [ sort Class::Tiny->get_all_attributes_for("Baker") ], + [ sort qw/foo bar baz/ ], + "attribute list correct", + ); +}; + +subtest "empty list constructor" => sub { + my $obj = new_ok("Baker"); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, undef, "bar is undef" ); + is( $obj->baz, undef, "baz is undef" ); +}; + +subtest "empty hash object constructor" => sub { + my $obj = new_ok( "Baker", [ {} ] ); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, undef, "bar is undef" ); + is( $obj->baz, undef, "baz is undef" ); +}; + +subtest "subclass attribute set as list" => sub { + my $obj = new_ok( "Baker", [ baz => 23 ] ); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, undef, "bar is undef" ); + is( $obj->baz, 23, "baz is set " ); +}; + +subtest "superclass attribute set as list" => sub { + my $obj = new_ok( "Baker", [ bar => 42, baz => 23 ] ); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, 42, "bar is set" ); + is( $obj->baz, 23, "baz is set " ); +}; + +subtest "all attributes set as list" => sub { + my $obj = new_ok( "Baker", [ foo => 13, bar => 42, baz => 23 ] ); + is( $obj->foo, 13, "foo is set" ); + is( $obj->bar, 42, "bar is set" ); + is( $obj->baz, 23, "baz is set " ); +}; + +subtest "attributes are RW" => sub { + my $obj = new_ok( "Baker", [ { foo => 23, bar => 42 } ] ); + is( $obj->foo(24), 24, "changing foo returns new value" ); + is( $obj->foo, 24, "accessing foo returns changed value" ); + is( $obj->baz(42), 42, "changing baz returns new value" ); + is( $obj->baz, 42, "accessing baz returns changed value" ); +}; + +done_testing; +# +# This file is part of Class-Tiny +# +# This software is Copyright (c) 2013 by David Golden. +# +# This is free software, licensed under: +# +# The Apache License, Version 2.0, January 2004 +# +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/charlie.t b/t/charlie.t new file mode 100644 index 0000000..faaf0ce --- /dev/null +++ b/t/charlie.t @@ -0,0 +1,37 @@ +use 5.006; +use strict; +use warnings; +use lib 't/lib'; + +use Test::More 0.96; +use TestUtils; + +require_ok("Charlie"); + +subtest "all attributes set as list" => sub { + my $obj = new_ok( "Charlie", [ foo => 13, bar => [42] ] ); + is( $obj->foo, 13, "foo is set" ); + is_deeply( $obj->bar, [42], "bar is set" ); +}; + +subtest "custom accessor" => sub { + my $obj = new_ok( "Charlie", [ foo => 13, bar => [42] ] ); + is_deeply( $obj->bar(qw/1 1 2 3 5/), [qw/1 1 2 3 5/], "bar is set" ); +}; + +subtest "custom accessor with default" => sub { + my $obj = new_ok( "Charlie", [ foo => 13, bar => [42] ] ); + is( $obj->baz, 23, "custom accessor has default" ); +}; + +done_testing; +# +# This file is part of Class-Tiny +# +# This software is Copyright (c) 2013 by David Golden. +# +# This is free software, licensed under: +# +# The Apache License, Version 2.0, January 2004 +# +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/delta.t b/t/delta.t new file mode 100644 index 0000000..d83922d --- /dev/null +++ b/t/delta.t @@ -0,0 +1,48 @@ +use 5.006; +use strict; +use warnings; +use lib 't/lib'; + +use Test::More 0.96; +use TestUtils; + +require_ok("Delta"); + +subtest "attribute set as list" => sub { + my $obj = new_ok( "Delta", [ foo => 42, bar => 23 ] ); + is( $obj->foo, 42, "foo is set" ); + is( $obj->bar, 23, "bar is set" ); +}; + +subtest "__no_BUILD__" => sub { + my $obj = new_ok( "Delta", [ __no_BUILD__ => 1 ], "new( __no_BUILD__ => 1 )" ); + is( $Delta::counter, 0, "BUILD method didn't run" ); +}; + +subtest "destructor" => sub { + my @objs = map { new_ok( "Delta", [ foo => 42, bar => 23 ] ) } 1 .. 3; + is( $Delta::counter, 3, "BUILD incremented counter" ); + @objs = (); + is( $Delta::counter, 0, "DEMOLISH decremented counter" ); +}; + +subtest "exceptions" => sub { + like( + exception { Delta->new( foo => 0 ) }, + qr/foo must be positive/, + "BUILD validation throws error", + ); + +}; + +done_testing; +# +# This file is part of Class-Tiny +# +# This software is Copyright (c) 2013 by David Golden. +# +# This is free software, licensed under: +# +# The Apache License, Version 2.0, January 2004 +# +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/echo.t b/t/echo.t new file mode 100644 index 0000000..de8cff5 --- /dev/null +++ b/t/echo.t @@ -0,0 +1,46 @@ +use 5.006; +use strict; +use warnings; +use lib 't/lib'; + +use Test::More 0.96; +use TestUtils; + +require_ok("Echo"); + +subtest "attribute set as list" => sub { + my $obj = new_ok( "Echo", [ foo => 42, bar => 23 ] ); + is( $obj->foo, 42, "foo is set" ); + is( $obj->bar, 23, "bar is set" ); + is( $obj->baz, 24, "baz is set" ); +}; + +subtest "destructor" => sub { + no warnings 'once'; + my @objs = map { new_ok( "Echo", [ foo => 42, bar => 23 ] ) } 1 .. 3; + is( $Delta::counter, 3, "BUILD incremented counter" ); + @objs = (); + is( $Delta::counter, 0, "DEMOLISH decremented counter" ); + is( $Delta::exception, 0, "cleanup worked in correct order" ); +}; + +subtest "exceptions" => sub { + like( + exception { Echo->new( foo => 0, bar => 23 ) }, + qr/foo must be positive/, + "BUILD validation throws error", + ); + +}; + +done_testing; +# +# This file is part of Class-Tiny +# +# This software is Copyright (c) 2013 by David Golden. +# +# This is free software, licensed under: +# +# The Apache License, Version 2.0, January 2004 +# +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/foxtrot.t b/t/foxtrot.t new file mode 100644 index 0000000..a501da6 --- /dev/null +++ b/t/foxtrot.t @@ -0,0 +1,44 @@ +use 5.006; +use strict; +use warnings; +use lib 't/lib'; + +use Test::More 0.96; +use TestUtils; + +require_ok("Foxtrot"); + +subtest "attribute list" => sub { + is_deeply( + [ sort Class::Tiny->get_all_attributes_for("Foxtrot") ], + [ sort qw/foo bar baz/ ], + "attribute list correct", + ); +}; + +subtest "attribute defaults" => sub { + my $def = Class::Tiny->get_all_attribute_defaults_for("Foxtrot"); + is( keys %$def, 3, "defaults hashref size" ); + is( $def->{foo}, undef, "foo default is undef" ); + is( $def->{bar}, 42, "bar default is 42" ); + is( ref $def->{baz}, 'CODE', "baz default is a coderef" ); +}; + +subtest "attribute set as list" => sub { + my $obj = new_ok( "Foxtrot", [ foo => 42, bar => 23 ] ); + is( $obj->foo, 42, "foo is set" ); + is( $obj->bar, 23, "bar is set" ); + ok( $obj->baz, "baz is set" ); +}; + +done_testing; +# +# This file is part of Class-Tiny +# +# This software is Copyright (c) 2013 by David Golden. +# +# This is free software, licensed under: +# +# The Apache License, Version 2.0, January 2004 +# +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/golf.t b/t/golf.t new file mode 100644 index 0000000..43a186a --- /dev/null +++ b/t/golf.t @@ -0,0 +1,35 @@ +use 5.006; +use strict; +use warnings; +use lib 't/lib'; + +use Test::More 0.96; +use TestUtils; + +require_ok("Golf"); + +subtest "lazy defaults" => sub { + my $obj = new_ok("Golf"); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, undef, "bar is undef" ); + ok( !exists( $obj->{wibble} ), "lazy wibble doesn't exist" ); + ok( !exists( $obj->{wobble} ), "lazy wobble doesn't exist" ); + is( $obj->wibble, 42, "wibble access gives default" ); + is( ref $obj->wobble, 'ARRAY', "wobble access gives default" ); + ok( exists( $obj->{wibble} ), "lazy wibble does exist" ); + ok( exists( $obj->{wobble} ), "lazy wobble does exist" ); + my $obj2 = new_ok("Golf"); + isnt( $obj->wobble, $obj2->wobble, "coderefs run for each object" ); +}; + +done_testing; +# +# This file is part of Class-Tiny +# +# This software is Copyright (c) 2013 by David Golden. +# +# This is free software, licensed under: +# +# The Apache License, Version 2.0, January 2004 +# +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/hotel.t b/t/hotel.t new file mode 100644 index 0000000..e5b3ef0 --- /dev/null +++ b/t/hotel.t @@ -0,0 +1,46 @@ +use 5.006; +use strict; +use warnings; +use lib 't/lib'; + +use Test::More 0.96; +use TestUtils; + +require_ok("Hotel"); + +subtest "attribute list" => sub { + my $attributes = [ sort Class::Tiny->get_all_attributes_for("Hotel") ]; + is_deeply( + $attributes, + [ sort qw/foo bar wibble wobble zig zag/ ], + "attribute list correct", + ) or diag explain $attributes; +}; + +subtest "attribute defaults" => sub { + my $def = Class::Tiny->get_all_attribute_defaults_for("Hotel"); + is( keys %$def, 6, "defaults hashref size" ); + is( $def->{foo}, undef, "foo default is undef" ); + is( $def->{bar}, undef, "bar default is undef" ); + is( $def->{wibble}, 23, "wibble default overrides" ); +}; + +subtest "attribute set as list" => sub { + my $obj = new_ok( "Hotel", [ foo => 42, bar => 23 ] ); + is( $obj->foo, 42, "foo is set" ); + is( $obj->bar, 23, "bar is set" ); + is( $obj->wibble, 23, "wibble is set" ); + is( ref $obj->wobble, 'HASH', "wobble default overrides" ); +}; + +done_testing; +# +# This file is part of Class-Tiny +# +# This software is Copyright (c) 2013 by David Golden. +# +# This is free software, licensed under: +# +# The Apache License, Version 2.0, January 2004 +# +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/juliett.t b/t/juliett.t new file mode 100644 index 0000000..e6f85a5 --- /dev/null +++ b/t/juliett.t @@ -0,0 +1,87 @@ +use 5.006; +use strict; +use warnings; +use lib 't/lib'; + +use Test::More 0.96; +use TestUtils; + +require_ok("Juliett"); + +subtest "attribute list" => sub { + is_deeply( + [ sort Class::Tiny->get_all_attributes_for("Juliett") ], + [ sort qw/foo bar baz qux kit/ ], + "attribute list correct", + ); +}; + +subtest "empty list constructor" => sub { + my $obj = new_ok("Juliett"); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, undef, "bar is undef" ); + is( $obj->baz, undef, "baz is undef" ); + is( $obj->qux, undef, "qux is undef" ); + is( $obj->kit, undef, "kit is undef" ); +}; + +subtest "empty hash object constructor" => sub { + my $obj = new_ok( "Juliett", [ {} ] ); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, undef, "bar is undef" ); + is( $obj->baz, undef, "baz is undef" ); + is( $obj->qux, undef, "qux is undef" ); + is( $obj->kit, undef, "kit is undef" ); +}; + +subtest "subclass attribute set as list" => sub { + my $obj = new_ok( "Juliett", [ kit => 23 ] ); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, undef, "bar is undef" ); + is( $obj->qux, undef, "baz is undef" ); + is( $obj->qux, undef, "qux is undef" ); + is( $obj->kit, 23, "kit is set" ); +}; + +subtest "superclass attribute set as list" => sub { + my $obj = new_ok( "Juliett", [ bar => 42, baz => 23, qux => 13, kit => 31 ] ); + is( $obj->foo, undef, "foo is undef" ); + is( $obj->bar, 42, "bar is set" ); + is( $obj->baz, 23, "baz is set" ); + is( $obj->qux, 13, "qux is set" ); + is( $obj->kit, 31, "kit is set" ); +}; + +subtest "all attributes set as list" => sub { + my $obj = + new_ok( "Juliett", [ foo => 13, bar => 42, baz => 23, qux => 11, kit => 31 ] ); + is( $obj->foo, 13, "foo is set" ); + is( $obj->bar, 42, "bar is set" ); + is( $obj->baz, 23, "baz is set" ); + is( $obj->qux, 11, "qux is set" ); + is( $obj->kit, 31, "kit is set" ); +}; + +subtest "attributes are RW" => sub { + my $obj = new_ok( "Juliett", [ { foo => 23, bar => 42 } ] ); + is( $obj->foo(24), 24, "changing foo returns new value" ); + is( $obj->foo, 24, "accessing foo returns changed value" ); + is( $obj->baz(42), 42, "changing baz returns new value" ); + is( $obj->baz, 42, "accessing baz returns changed value" ); + is( $obj->qux(11), 11, "changing qux returns new value" ); + is( $obj->qux, 11, "accessing qux returns changed value" ); + is( $obj->kit(31), 31, "changing kit returns new value" ); + is( $obj->kit, 31, "accessing kit rerutns changed value" ); +}; + +done_testing; +# +# This file is part of Class-Tiny +# +# This software is Copyright (c) 2013 by David Golden. +# +# This is free software, licensed under: +# +# The Apache License, Version 2.0, January 2004 +# +# vim: ts=4 sts=4 sw=4 et: diff --git a/t/lib/Alfa.pm b/t/lib/Alfa.pm new file mode 100644 index 0000000..9d1326c --- /dev/null +++ b/t/lib/Alfa.pm @@ -0,0 +1,9 @@ +use 5.006; +use strict; +use warnings; + +package Alfa; + +use Class::Tiny qw/foo bar/; + +1; diff --git a/t/lib/Baker.pm b/t/lib/Baker.pm new file mode 100644 index 0000000..f9caf3e --- /dev/null +++ b/t/lib/Baker.pm @@ -0,0 +1,10 @@ +use 5.006; +use strict; +use warnings; + +package Baker; +use base 'Alfa'; + +use Class::Tiny qw/baz/; + +1; diff --git a/t/lib/Charlie.pm b/t/lib/Charlie.pm new file mode 100644 index 0000000..7d312bd --- /dev/null +++ b/t/lib/Charlie.pm @@ -0,0 +1,28 @@ +use 5.006; +use strict; +use warnings; + +package Charlie; + +use subs qw/bar baz/; + +use Class::Tiny qw/foo bar/, { baz => 23 }; + +sub bar { + my $self = shift; + if (@_) { + $self->{bar} = [@_]; + } + return $self->{bar}; +} + +sub baz { + my $self = shift; + if (@_) { + $self->{baz} = shift; + } + return $self->{baz} ||= + Class::Tiny->get_all_attribute_defaults_for( ref $self )->{baz}; +} + +1; diff --git a/t/lib/Delta.pm b/t/lib/Delta.pm new file mode 100644 index 0000000..119bb4f --- /dev/null +++ b/t/lib/Delta.pm @@ -0,0 +1,30 @@ +use 5.006; +use strict; +use warnings; + +package Delta; + +our $counter = 0; +our $exception = 0; + +use Carp (); + +use Class::Tiny qw/foo bar/; + +sub BUILD { + my $self = shift; + my $args = shift; + Carp::croak("foo must be positive") + unless defined $self->foo && $self->foo > 0; + + $self->bar(42) unless defined $self->bar; + $counter++; +} + +sub DEMOLISH { + my $self = shift; + $counter-- if $counter > 0; + $exception++ if keys %$self > 2; # Echo will delete first +} + +1; diff --git a/t/lib/Echo.pm b/t/lib/Echo.pm new file mode 100644 index 0000000..5bf2ae8 --- /dev/null +++ b/t/lib/Echo.pm @@ -0,0 +1,22 @@ +use 5.006; +use strict; +use warnings; + +package Echo; +use base 'Delta'; + +use Class::Tiny qw/baz/; + +sub BUILD { + my $self = shift; + $self->baz( $self->bar + 1 ); +} + +sub DEMOLISH { + my $self = shift; + delete $self->{baz}; # or else Delta::DEMOLISH dies +} + +sub a_method { 1 } + +1; diff --git a/t/lib/Foxtrot.pm b/t/lib/Foxtrot.pm new file mode 100644 index 0000000..b757d47 --- /dev/null +++ b/t/lib/Foxtrot.pm @@ -0,0 +1,10 @@ +use 5.006; +use strict; +use warnings; + +package Foxtrot; + +use Class::Tiny 'foo'; +use Class::Tiny { bar => 42, baz => sub { time } }; + +1; diff --git a/t/lib/Golf.pm b/t/lib/Golf.pm new file mode 100644 index 0000000..5e07438 --- /dev/null +++ b/t/lib/Golf.pm @@ -0,0 +1,12 @@ +use 5.006; +use strict; +use warnings; + +package Golf; + +use Class::Tiny qw/foo bar/, { + wibble => 42, + wobble => sub { [] }, +}, qw/zig zag/; + +1; diff --git a/t/lib/Hotel.pm b/t/lib/Hotel.pm new file mode 100644 index 0000000..eabe099 --- /dev/null +++ b/t/lib/Hotel.pm @@ -0,0 +1,14 @@ +use 5.006; +use strict; +use warnings; + +package Hotel; + +use base 'Golf'; + +use Class::Tiny { + wibble => 23, + wobble => sub { {} }, +}; + +1; diff --git a/t/lib/India.pm b/t/lib/India.pm new file mode 100644 index 0000000..ea39909 --- /dev/null +++ b/t/lib/India.pm @@ -0,0 +1,10 @@ +use 5.006; +use strict; +use warnings; + +package India; +use base 'Alfa'; + +use Class::Tiny qw/qux/; + +1; diff --git a/t/lib/Juliett.pm b/t/lib/Juliett.pm new file mode 100644 index 0000000..52857ff --- /dev/null +++ b/t/lib/Juliett.pm @@ -0,0 +1,10 @@ +use 5.006; +use strict; +use warnings; + +package Juliett; +use base 'Baker', 'India'; + +use Class::Tiny qw/kit/; + +1; diff --git a/t/lib/TestUtils.pm b/t/lib/TestUtils.pm new file mode 100644 index 0000000..c66b8b3 --- /dev/null +++ b/t/lib/TestUtils.pm @@ -0,0 +1,28 @@ +use 5.006; +use strict; +use warnings; +package TestUtils; + +use Carp; + +use Exporter; +our @ISA = qw/Exporter/; +our @EXPORT = qw( + exception +); + +# If we have Test::FailWarnings, use it +BEGIN { + eval { require Test::FailWarnings; 1 } and do { Test::FailWarnings->import }; +} + +sub exception(&) { + my $code = shift; + my $success = eval { $code->(); 1 }; + my $err = $@; + return '' if $success; + croak "Execution died, but the error was lost" unless $@; + return $@; +} + +1; diff --git a/tidyall.ini b/tidyall.ini new file mode 100644 index 0000000..91aa246 --- /dev/null +++ b/tidyall.ini @@ -0,0 +1,5 @@ +; Install Code::TidyAll +; run "tidyall -a" to tidy all files +; run "tidyall -g" to tidy only files modified from git +[PerlTidy] +select = {lib,t}/**/*.{pl,pm,t} diff --git a/xt/author/00-compile.t b/xt/author/00-compile.t new file mode 100644 index 0000000..735f0e3 --- /dev/null +++ b/xt/author/00-compile.t @@ -0,0 +1,54 @@ +use 5.006; +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.051 + +use Test::More; + +plan tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0); + +my @module_files = ( + 'Class/Tiny.pm' +); + + + +# fake home for cpan-testers +use File::Temp; +local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 ); + + +my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib'; + +use File::Spec; +use IPC::Open3; +use IO::Handle; + +open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; + +my @warnings; +for my $lib (@module_files) +{ + # see L<perlfaq8/How can I capture STDERR from an external command?> + my $stderr = IO::Handle->new; + + my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]"); + binmode $stderr, ':crlf' if $^O eq 'MSWin32'; + my @_warnings = <$stderr>; + waitpid($pid, 0); + is($?, 0, "$lib loaded ok"); + + if (@_warnings) + { + warn @_warnings; + push @warnings, @_warnings; + } +} + + + +is(scalar(@warnings), 0, 'no warnings found') + or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING}; + + diff --git a/xt/author/critic.t b/xt/author/critic.t new file mode 100644 index 0000000..d5b4c96 --- /dev/null +++ b/xt/author/critic.t @@ -0,0 +1,12 @@ +#!perl + +use strict; +use warnings; + +use Test::More; +use English qw(-no_match_vars); + +eval "use Test::Perl::Critic"; +plan skip_all => 'Test::Perl::Critic required to criticise code' if $@; +Test::Perl::Critic->import( -profile => "perlcritic.rc" ) if -e "perlcritic.rc"; +all_critic_ok(); diff --git a/xt/author/pod-spell.t b/xt/author/pod-spell.t new file mode 100644 index 0000000..02ba03d --- /dev/null +++ b/xt/author/pod-spell.t @@ -0,0 +1,41 @@ +use strict; +use warnings; +use Test::More; + +# generated by Dist::Zilla::Plugin::Test::PodSpelling 2.006008 +use Test::Spelling 0.12; +use Pod::Wordlist; + + +add_stopwords(<DATA>); +all_pod_files_spelling_ok( qw( bin lib ) ); +__DATA__ +destructor +fatpacking +interoperability +linearized +David +Golden +dagolden +Dagfinn +Ilmari +Mannsåker +ilmari +Gelu +Lupas +gelu +Karen +Etheridge +ether +Matt +Trout +mstrout +Olivier +Mengué +dolmen +Toby +Inkster +tobyink +lib +Class +Tiny diff --git a/xt/release/distmeta.t b/xt/release/distmeta.t new file mode 100644 index 0000000..c2280dc --- /dev/null +++ b/xt/release/distmeta.t @@ -0,0 +1,6 @@ +#!perl +# This file was automatically generated by Dist::Zilla::Plugin::MetaTests. + +use Test::CPAN::Meta; + +meta_yaml_ok(); diff --git a/xt/release/minimum-version.t b/xt/release/minimum-version.t new file mode 100644 index 0000000..708ba15 --- /dev/null +++ b/xt/release/minimum-version.t @@ -0,0 +1,8 @@ +#!perl + +use Test::More; + +eval "use Test::MinimumVersion"; +plan skip_all => "Test::MinimumVersion required for testing minimum versions" + if $@; +all_minimum_version_ok( qq{5.010} ); diff --git a/xt/release/pod-coverage.t b/xt/release/pod-coverage.t new file mode 100644 index 0000000..66b3b64 --- /dev/null +++ b/xt/release/pod-coverage.t @@ -0,0 +1,7 @@ +#!perl +# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. + +use Test::Pod::Coverage 1.08; +use Pod::Coverage::TrustPod; + +all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); diff --git a/xt/release/pod-syntax.t b/xt/release/pod-syntax.t new file mode 100644 index 0000000..f0468f1 --- /dev/null +++ b/xt/release/pod-syntax.t @@ -0,0 +1,6 @@ +#!perl +# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. +use Test::More; +use Test::Pod 1.41; + +all_pod_files_ok(); diff --git a/xt/release/portability.t b/xt/release/portability.t new file mode 100644 index 0000000..58dbc20 --- /dev/null +++ b/xt/release/portability.t @@ -0,0 +1,12 @@ +#!perl + +use strict; +use warnings; + +use Test::More; + +eval 'use Test::Portability::Files'; +plan skip_all => 'Test::Portability::Files required for testing portability' + if $@; +options(test_one_dot => 0); +run_tests(); diff --git a/xt/release/test-version.t b/xt/release/test-version.t new file mode 100644 index 0000000..9bccdf0 --- /dev/null +++ b/xt/release/test-version.t @@ -0,0 +1,22 @@ +use strict; +use warnings; +use Test::More; + +# generated by Dist::Zilla::Plugin::Test::Version 0.003001 +use Test::Version; + +my @imports = ( 'version_all_ok' ); + +my $params = { + is_strict => 0, + has_version => 1, +}; + +push @imports, $params + if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); + + +Test::Version->import(@imports); + +version_all_ok; +done_testing; |