From 7446bb2b9d24fa6b702fbb62d73084a32ade6f75 Mon Sep 17 00:00:00 2001 From: Lorry Tar Creator Date: Sat, 31 Jan 2015 02:13:12 +0000 Subject: Class-Tiny-1.001 --- CONTRIBUTING.mkdn | 87 +++++++ Changes | 168 ++++++++++++ LICENSE | 207 +++++++++++++++ MANIFEST | 45 ++++ META.json | 113 +++++++++ META.yml | 56 ++++ Makefile.PL | 84 ++++++ README | 359 ++++++++++++++++++++++++++ cpanfile | 45 ++++ dist.ini | 33 +++ lib/Class/Tiny.pm | 592 +++++++++++++++++++++++++++++++++++++++++++ perlcritic.rc | 23 ++ t/00-report-prereqs.dd | 55 ++++ t/00-report-prereqs.t | 183 +++++++++++++ t/alfa.t | 90 +++++++ t/baker.t | 72 ++++++ t/charlie.t | 37 +++ t/delta.t | 48 ++++ t/echo.t | 46 ++++ t/foxtrot.t | 44 ++++ t/golf.t | 35 +++ t/hotel.t | 46 ++++ t/juliett.t | 87 +++++++ t/lib/Alfa.pm | 9 + t/lib/Baker.pm | 10 + t/lib/Charlie.pm | 28 ++ t/lib/Delta.pm | 30 +++ t/lib/Echo.pm | 22 ++ t/lib/Foxtrot.pm | 10 + t/lib/Golf.pm | 12 + t/lib/Hotel.pm | 14 + t/lib/India.pm | 10 + t/lib/Juliett.pm | 10 + t/lib/TestUtils.pm | 28 ++ tidyall.ini | 5 + xt/author/00-compile.t | 54 ++++ xt/author/critic.t | 12 + xt/author/pod-spell.t | 41 +++ xt/release/distmeta.t | 6 + xt/release/minimum-version.t | 8 + xt/release/pod-coverage.t | 7 + xt/release/pod-syntax.t | 6 + xt/release/portability.t | 12 + xt/release/test-version.t | 22 ++ 44 files changed, 2911 insertions(+) create mode 100644 CONTRIBUTING.mkdn create mode 100644 Changes create mode 100644 LICENSE create mode 100644 MANIFEST create mode 100644 META.json create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100644 cpanfile create mode 100644 dist.ini create mode 100644 lib/Class/Tiny.pm create mode 100644 perlcritic.rc create mode 100644 t/00-report-prereqs.dd create mode 100644 t/00-report-prereqs.t create mode 100644 t/alfa.t create mode 100644 t/baker.t create mode 100644 t/charlie.t create mode 100644 t/delta.t create mode 100644 t/echo.t create mode 100644 t/foxtrot.t create mode 100644 t/golf.t create mode 100644 t/hotel.t create mode 100644 t/juliett.t create mode 100644 t/lib/Alfa.pm create mode 100644 t/lib/Baker.pm create mode 100644 t/lib/Charlie.pm create mode 100644 t/lib/Delta.pm create mode 100644 t/lib/Echo.pm create mode 100644 t/lib/Foxtrot.pm create mode 100644 t/lib/Golf.pm create mode 100644 t/lib/Hotel.pm create mode 100644 t/lib/India.pm create mode 100644 t/lib/Juliett.pm create mode 100644 t/lib/TestUtils.pm create mode 100644 tidyall.ini create mode 100644 xt/author/00-compile.t create mode 100644 xt/author/critic.t create mode 100644 xt/author/pod-spell.t create mode 100644 xt/release/distmeta.t create mode 100644 xt/release/minimum-version.t create mode 100644 xt/release/pod-coverage.t create mode 100644 xt/release/pod-syntax.t create mode 100644 xt/release/portability.t create mode 100644 xt/release/test-version.t 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/ + diff --git a/Changes b/Changes new file mode 100644 index 0000000..6ffa57c --- /dev/null +++ b/Changes @@ -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 + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..1306a66 --- /dev/null +++ b/LICENSE @@ -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 " + ], + "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 ", + "Gelu Lupas ", + "Karen Etheridge ", + "Matt S Trout ", + "Olivier Mengué ", + "Toby Inkster " + ] +} + 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 ' +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 ' + - 'Gelu Lupas ' + - 'Karen Etheridge ' + - 'Matt S Trout ' + - 'Olivier Mengué ' + - 'Toby Inkster ' 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 ", + "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); + + + diff --git a/README b/README new file mode 100644 index 0000000..e3692cb --- /dev/null +++ b/README @@ -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 + . 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. + + + + git clone https://github.com/dagolden/Class-Tiny.git + +AUTHOR + David Golden + +CONTRIBUTORS + * Dagfinn Ilmari Mannsåker + + * Gelu Lupas + + * Karen Etheridge + + * Matt S Trout + + * Olivier Mengué + + * Toby Inkster + +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 +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: + + package Person; + + use Class::Tiny qw( name ); + + 1; + +In F: + + package Employee; + use parent 'Person'; + + use Class::Tiny qw( ssn ), { + timestamp => sub { time } # attribute with default + }; + + 1; + +In F: + + 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 constructor + +=item * + +C takes a hash reference or list of key/value pairs + +=item * + +C supports providing C to customize constructor options + +=item * + +C calls C for each class from parent to child + +=item * + +superclass provides a C method + +=item * + +C calls C for each class from child to parent + +=back + +Multiple-inheritance is possible, with superclass order determined via +L. + +It uses no non-core modules for any recent Perl. On Perls older than v5.10 it +requires L. On Perls older than v5.14, it requires +L. + +=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 already inherit from some class, then +Class::Tiny::Object will be added to your C<@ISA> to provide C and +C. + +If your class B 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, L +or L 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 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 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 will be ignored. + +=head2 BUILD + +If your class or any superclass defines a C 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 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 method. If your class or any superclass +defines a C 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 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 class +method. Any attributes without a default will be C. + + my $def = Class::Tiny->get_all_attribute_defaults_for("Employee"); + # returns { + # name => undef, + # ssn => undef + # timestamp => $coderef + # } + +The C method uses two class methods, C and +C 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. + +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 or roll-their-own OO framework each time. + +L and L 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, 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 and L 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 non-core dependencies for +Perls in the L. 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 +and C 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. +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 + + git clone https://github.com/dagolden/Class-Tiny.git + +=head1 AUTHOR + +David Golden + +=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 + +=item * + +Gelu Lupas + +=item * + +Karen Etheridge + +=item * + +Matt S Trout + +=item * + +Olivier Mengué + +=item * + +Toby Inkster + +=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 + 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(); +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; -- cgit v1.2.1