Object-Declare-0.23000755000764000764 012657435762 14517 5ustar00shlomifshlomif000000000000README100644000764000764 45012657435762 15437 0ustar00shlomifshlomif000000000000Object-Declare-0.23 This archive contains the distribution Object-Declare, version 0.23: Declarative object constructor This software is Copyright (c) 2006 by Audrey Tang. This is free software, licensed under: The MIT (X11) License This README file was generated by Dist::Zilla::Plugin::Readme v5.043. Changes100644000764000764 721412657435762 16077 0ustar00shlomifshlomif000000000000Object-Declare-0.230.23 2016-02-12 * Convert the distribution from Module-Install to Dist-Zilla. * Start maintaining in a GitHub repository. * Add a LICENSE file. * Removed trailing whitespace - with a test. * Remove the SIGNATURE file - at least temporarily. 0.22 2007-02-09 * Allow declarations in copula callbacks as return value: copula => foo => sub { bar is 1, baz is 2 } * No longer raise bogus "overload method not found" errors when paritally-formed declarations objects is e.g. printed out for debugging purposes. 0.21 2007-01-26 * Helper functions for mapping keys are no longer present within dynamic scope of mapping construction callbacks; this allows you to have call a method that has the same name as a mapping key during ->new() and other callbacks. * Support for fully qualified fields: "Very::Happy is 42" and "is Very::Happy" are valid even when Very::Happy is not yet loaded. * Support for associating coderefs with copula for even more flexible rewriting of arguments: copula => { # list of words, or a map is => '', # from copula to label prefixes, are => '', # or to callback that e.g. turns has => sub { has => @_ }, # "has X" to "has is X" and # "X has 1" to "has is [X => 1]" }, 0.20 2007-01-16 * Sub::Override is no longer a dependency for this module. * Values in declarations can now contain nested sub-objects by calling the declarators again: column foo => field is column( field is 'foo' ); Contributed by: Jason Adams 0.13 2006-07-21 * Introduce the "synonyms" interface, a mapping for alternate spelling for field names. 0.12 2006-07-20 * The "isn't" keyword in 0.11 broke Test::More, and I can't find a way to reconcile them, so it's now sadly retracted. 0.11 2006-07-20 * Support the prefix ! operator on declarations, so negated ones such as "!is global" or "!global is $x" now work. Requested by: Jesse Vincent * Also introduce the "isn't" negated copula. Requested by: Jesse Vincent 0.10 2006-07-20 * The "copula" interface now accepts an arbitrary prefix for each copula (defaults to ''), which can be used to distinguish labels built by different copular words. 0.09 2006-07-18 * The "mapping" interface now accepts arbitrary code reference as the builder function, in addition to class names to call ->new to. 0.08 2006-07-18 * Added lots of documentation and comments. * Now works correctly even if at runtime the symbol table entries created at compile-time get deleted. 0.07 2006-07-18 * Chained "is foo, is bar, is baz" now works; previously only the first one is recognized. Reported by: Steven Little 0.06 2006-07-17 * Documentation cleanup; no functional changes. 0.05 2006-07-17 * Support for ordered declarations, via list-context return of "declare". In scalar context, it still returns a hash reference. 0.04 2006-07-17 * Support for plural values via "are": column x => field1 is 'xxx', field2 are 'XXX', 'XXX', # <-- Plural value is field3; 0.03 2006-07-17 * The declarator can now be exported to another package; this works because internally, each declarator remembers the class mappings and copula it was associated with. 0.02 2006-07-17 * Documentation cleanup; no functional changes. 0.01 2006-07-17 * Initial CPAN release. LICENSE100644000764000764 203712657435762 15607 0ustar00shlomifshlomif000000000000Object-Declare-0.23Copyright (c) 2006 Audrey Tang Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Changes~100644000764000764 712312657435762 16274 0ustar00shlomifshlomif000000000000Object-Declare-0.230.23 2016-02-12 * Convert the distribution from Module-Install to Dist-Zilla. * Start maintaining in a GitHub repository. * Add a LICENSE file. * Removed trailing whitespace - with a test. 0.22 2007-02-09 * Allow declarations in copula callbacks as return value: copula => foo => sub { bar is 1, baz is 2 } * No longer raise bogus "overload method not found" errors when paritally-formed declarations objects is e.g. printed out for debugging purposes. 0.21 2007-01-26 * Helper functions for mapping keys are no longer present within dynamic scope of mapping construction callbacks; this allows you to have call a method that has the same name as a mapping key during ->new() and other callbacks. * Support for fully qualified fields: "Very::Happy is 42" and "is Very::Happy" are valid even when Very::Happy is not yet loaded. * Support for associating coderefs with copula for even more flexible rewriting of arguments: copula => { # list of words, or a map is => '', # from copula to label prefixes, are => '', # or to callback that e.g. turns has => sub { has => @_ }, # "has X" to "has is X" and # "X has 1" to "has is [X => 1]" }, 0.20 2007-01-16 * Sub::Override is no longer a dependency for this module. * Values in declarations can now contain nested sub-objects by calling the declarators again: column foo => field is column( field is 'foo' ); Contributed by: Jason Adams 0.13 2006-07-21 * Introduce the "synonyms" interface, a mapping for alternate spelling for field names. 0.12 2006-07-20 * The "isn't" keyword in 0.11 broke Test::More, and I can't find a way to reconcile them, so it's now sadly retracted. 0.11 2006-07-20 * Support the prefix ! operator on declarations, so negated ones such as "!is global" or "!global is $x" now work. Requested by: Jesse Vincent * Also introduce the "isn't" negated copula. Requested by: Jesse Vincent 0.10 2006-07-20 * The "copula" interface now accepts an arbitrary prefix for each copula (defaults to ''), which can be used to distinguish labels built by different copular words. 0.09 2006-07-18 * The "mapping" interface now accepts arbitrary code reference as the builder function, in addition to class names to call ->new to. 0.08 2006-07-18 * Added lots of documentation and comments. * Now works correctly even if at runtime the symbol table entries created at compile-time get deleted. 0.07 2006-07-18 * Chained "is foo, is bar, is baz" now works; previously only the first one is recognized. Reported by: Steven Little 0.06 2006-07-17 * Documentation cleanup; no functional changes. 0.05 2006-07-17 * Support for ordered declarations, via list-context return of "declare". In scalar context, it still returns a hash reference. 0.04 2006-07-17 * Support for plural values via "are": column x => field1 is 'xxx', field2 are 'XXX', 'XXX', # <-- Plural value is field3; 0.03 2006-07-17 * The declarator can now be exported to another package; this works because internally, each declarator remembers the class mappings and copula it was associated with. 0.02 2006-07-17 * Documentation cleanup; no functional changes. 0.01 2006-07-17 * Initial CPAN release. LICENSE~100644000764000764 203712657435762 16005 0ustar00shlomifshlomif000000000000Object-Declare-0.23Copyright (c) 2005 Audrey Tang Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. dist.ini100644000764000764 125312657435762 16245 0ustar00shlomifshlomif000000000000Object-Declare-0.23name = Object-Declare author = Shlomi Fish license = MIT copyright_holder = Audrey Tang copyright_year = 2006 [@Filter] -bundle = @Basic -remove = License [AutoPrereqs] [ModuleBuild] [PodSyntaxTests] [PodCoverageTests] [MetaResources] bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Object-Declare bugtracker.mailto = bug-object-declare@rt.cpan.org repository.url = git://github.com/shlomif/perl-Object-Declare.git repository.web = https://github.com/shlomif/perl-Object-Declare repository.type = git [PodWeaver] [Test::Compile] fake_home = 1 skip = bump-ver [Test::CPAN::Changes] [Test::Kwalitee::Extra] [Test::TrailingSpace] [VersionFromModule] META.yml100644000764000764 140712657435762 16053 0ustar00shlomifshlomif000000000000Object-Declare-0.23--- abstract: 'Declarative object constructor' author: - 'Shlomi Fish ' build_requires: File::Spec: '0' File::Temp: '0' IO::Handle: '0' IPC::Open3: '0' Module::Build: '0.28' Test::More: '0' blib: '1.01' ok: '0' configure_requires: ExtUtils::MakeMaker: '0' Module::Build: '0.28' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.043, CPAN::Meta::Converter version 2.150005' license: mit meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Object-Declare requires: overload: '0' perl: '5.006' strict: '0' warnings: '0' resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Object-Declare repository: git://github.com/shlomif/perl-Object-Declare.git version: '0.23' MANIFEST100644000764000764 61512657435762 15713 0ustar00shlomifshlomif000000000000Object-Declare-0.23# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.043. Build.PL Changes Changes~ LICENSE LICENSE~ MANIFEST META.yml Makefile.PL README dist.ini dist.ini~ lib/Object/Declare.pm lib/Object/Declare.pm~ t/00-compile.t t/01-basic.t t/01-basic.t~ t/author-pod-coverage.t t/author-pod-syntax.t t/release-cpan-changes.t t/release-kwalitee.t t/release-trailing-space.t weaver.ini Build.PL100644000764000764 246412657435762 16102 0ustar00shlomifshlomif000000000000Object-Declare-0.23 # This file was automatically generated by Dist::Zilla::Plugin::ModuleBuild v5.043. use strict; use warnings; use Module::Build 0.28; my %module_build_args = ( "build_requires" => { "Module::Build" => "0.28" }, "configure_requires" => { "ExtUtils::MakeMaker" => 0, "Module::Build" => "0.28" }, "dist_abstract" => "Declarative object constructor", "dist_author" => [ "Shlomi Fish " ], "dist_name" => "Object-Declare", "dist_version" => "0.23", "license" => "mit", "module_name" => "Object::Declare", "recursive_test_files" => 1, "requires" => { "overload" => 0, "perl" => "5.006", "strict" => 0, "warnings" => 0 }, "test_requires" => { "File::Spec" => 0, "File::Temp" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Test::More" => 0, "blib" => "1.01", "ok" => 0 } ); my %fallback_build_requires = ( "File::Spec" => 0, "File::Temp" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Module::Build" => "0.28", "Test::More" => 0, "blib" => "1.01", "ok" => 0 ); unless ( eval { Module::Build->VERSION(0.4004) } ) { delete $module_build_args{test_requires}; $module_build_args{build_requires} = \%fallback_build_requires; } my $build = Module::Build->new(%module_build_args); $build->create_build_script; dist.ini~100644000764000764 127412657435762 16446 0ustar00shlomifshlomif000000000000Object-Declare-0.23name = Object-Declare author = Shlomi Fish license = MIT copyright_holder = Audrey Tang copyright_year = 2006 [@Filter] -bundle = @Basic -remove = License [AutoPrereqs] [ModuleBuild] [PodSyntaxTests] [PodCoverageTests] [MetaResources] bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Object-Declare bugtracker.mailto = bug-object-declare@rt.cpan.org repository.url = git://github.com/shlomif/perl-Object-Declare.git repository.web = https://github.com/shlomif/perl-Object-Declare repository.type = git [PodWeaver] [Test::Compile] fake_home = 1 skip = bump-ver [Test::CPAN::Changes] [Test::Kwalitee] [Test::Kwalitee::Extra] [Test::TrailingSpace] [VersionFromModule] weaver.ini100644000764000764 64212657435762 16554 0ustar00shlomifshlomif000000000000Object-Declare-0.23[@CorePrep] [Generic / NAME] [Version] [Region / prelude] [Generic / SYNOPSIS] [Generic / DESCRIPTION] [Generic / OVERVIEW] [Collect / ATTRIBUTES] command = attr [Collect / METHODS] command = method [Leftovers] [Region / postlude] [Authors] [Legal] ; [Generic / DESCRIPTION] ; required = 1 ; [Generic / BUGS] ; [Generic / Section::Bugs] ; [Generic / Section::License] ; [Bugs] [Support] all_modules = 1 Makefile.PL100644000764000764 267512657435762 16564 0ustar00shlomifshlomif000000000000Object-Declare-0.23# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.043. use strict; use warnings; use 5.006; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Declarative object constructor", "AUTHOR" => "Shlomi Fish ", "BUILD_REQUIRES" => { "Module::Build" => "0.28" }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "Module::Build" => "0.28" }, "DISTNAME" => "Object-Declare", "LICENSE" => "mit", "MIN_PERL_VERSION" => "5.006", "NAME" => "Object::Declare", "PREREQ_PM" => { "overload" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "File::Spec" => 0, "File::Temp" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Test::More" => 0, "blib" => "1.01", "ok" => 0 }, "VERSION" => "0.23", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "File::Spec" => 0, "File::Temp" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Module::Build" => "0.28", "Test::More" => 0, "blib" => "1.01", "ok" => 0, "overload" => 0, "strict" => 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) }; WriteMakefile(%WriteMakefileArgs); t000755000764000764 012657435762 14703 5ustar00shlomifshlomif000000000000Object-Declare-0.2301-basic.t100644000764000764 410512657435762 16527 0ustar00shlomifshlomif000000000000Object-Declare-0.23/tuse strict; use Test::More tests => 3, import => ['is_deeply']; use ok 'Object::Declare' => copula => { is => '', are => 'plural_', }, aliases => { field2 => 'fun', }, mapping => { column => 'MyApp::Column', alt_col => sub { return { alt => column(), @_ } } }; sub column { 1 } sub MyApp::Column::new { shift; return { @_ } } sub do_declare { declare { column x => is rw, is Very::Happy, field1 is 'xxx', field2 are 'XXX', 'XXX', is field3, parts are column( is happy ), column( !is happy ); alt_col y => !is Very::Happy, field1 is 'yyy', field2 is 'YYY', col is column( is happy ); } } my @objects = do_declare; is_deeply(\@objects => [ x => { 'name' => 'x', 'field1' => 'xxx', 'plural_field2' => ['XXX', 'XXX'], 'plural_parts' =>[ { happy => 1 },{ happy => '' },], 'field3' => 1, 'rw' => 1, 'Very::Happy' => 1, }, y => { 'name' => 'y', 'field1' => 'yyy', 'fun' => 'YYY', 'alt' => 1, col => { 'name' => 'col', 'happy' => 1, }, 'Very::Happy' => '', }, ], 'object declared correctly (list context)'); my $objects = do_declare; is_deeply($objects => { x => { 'name' => 'x', 'field1' => 'xxx', 'plural_field2' => ['XXX', 'XXX'], 'plural_parts' =>[ {happy => 1},{happy => ''},], 'field3' => 1, 'rw' => 1, 'Very::Happy' => 1, }, y => { 'name' => 'y', 'field1' => 'yyy', 'fun' => 'YYY', 'alt' => 1, col => { 'name' => 'col', 'happy' => 1, }, 'Very::Happy' => '', }, }, 'object declared correctly (scalar context)'); 01-basic.t~100644000764000764 410612657435762 16726 0ustar00shlomifshlomif000000000000Object-Declare-0.23/tuse strict; use Test::More tests => 3, import => ['is_deeply']; use ok 'Object::Declare' => copula => { is => '', are => 'plural_', }, aliases => { field2 => 'fun', }, mapping => { column => 'MyApp::Column', alt_col => sub { return { alt => column(), @_ } } }; sub column { 1 } sub MyApp::Column::new { shift; return { @_ } } sub do_declare { declare { column x => is rw, is Very::Happy, field1 is 'xxx', field2 are 'XXX', 'XXX', is field3, parts are column( is happy ), column( !is happy ); alt_col y => !is Very::Happy, field1 is 'yyy', field2 is 'YYY', col is column( is happy ); } } my @objects = do_declare; is_deeply(\@objects => [ x => { 'name' => 'x', 'field1' => 'xxx', 'plural_field2' => ['XXX', 'XXX'], 'plural_parts' =>[ { happy => 1 },{ happy => '' },], 'field3' => 1, 'rw' => 1, 'Very::Happy' => 1, }, y => { 'name' => 'y', 'field1' => 'yyy', 'fun' => 'YYY', 'alt' => 1, col => { 'name' => 'col', 'happy' => 1, }, 'Very::Happy' => '', }, ], 'object declared correctly (list context)'); my $objects = do_declare; is_deeply($objects => { x => { 'name' => 'x', 'field1' => 'xxx', 'plural_field2' => ['XXX', 'XXX'], 'plural_parts' =>[ {happy => 1},{happy => ''},], 'field3' => 1, 'rw' => 1, 'Very::Happy' => 1, }, y => { 'name' => 'y', 'field1' => 'yyy', 'fun' => 'YYY', 'alt' => 1, col => { 'name' => 'col', 'happy' => 1, }, 'Very::Happy' => '', }, }, 'object declared correctly (scalar context)'); 00-compile.t100644000764000764 245012657435762 17076 0ustar00shlomifshlomif000000000000Object-Declare-0.23/tuse 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.054 use Test::More; plan tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0); my @module_files = ( 'Object/Declare.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"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { require blib; blib->VERSION('1.01') }; 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}; release-kwalitee.t100644000764000764 72112657435762 20433 0ustar00shlomifshlomif000000000000Object-Declare-0.23/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } # This test is generated by Dist::Zilla::Plugin::Test::Kwalitee::Extra use strict; use warnings; use Test::More; # needed to provide plan. eval { require Test::Kwalitee::Extra }; plan skip_all => "Test::Kwalitee::Extra required for testing kwalitee: $@" if $@; eval "use Test::Kwalitee::Extra"; Object000755000764000764 012657435762 16414 5ustar00shlomifshlomif000000000000Object-Declare-0.23/libDeclare.pm100644000764000764 3441012657435762 20473 0ustar00shlomifshlomif000000000000Object-Declare-0.23/lib/Objectpackage Object::Declare; use 5.006; use strict; use warnings; $Object::Declare::VERSION = '0.23'; sub import { my $class = shift; my %args = ((@_ and ref($_[0])) ? (mapping => $_[0]) : @_) or return; my $from = caller; my $mapping = $args{mapping} or return; my $aliases = $args{aliases} || {}; my $declarator = $args{declarator} || ['declare']; my $copula = $args{copula} || ['is', 'are']; # Both declarator and copula can contain more than one entries; # normalize into an arrayref if we only have on entry. $mapping = [$mapping] unless ref($mapping); $declarator = [$declarator] unless ref($declarator); $copula = [$copula] unless ref($copula); if (ref($mapping) eq 'ARRAY') { # rewrite "MyApp::Foo" into simply "foo" $mapping = { map { my $helper = $_; $helper =~ s/.*:://; (lc($helper) => $_); } @$mapping }; } # Convert mapping targets into instantiation closures if (ref($mapping) eq 'HASH') { foreach my $key (keys %$mapping) { my $val = $mapping->{$key}; next if ref($val); # already a callback, don't bother $mapping->{$key} = sub { scalar($val->new(@_)) }; } } if (ref($copula) eq 'ARRAY') { # add an empty prefix to all copula $copula = { map { $_ => '' } @$copula } } # Install declarator functions into caller's package, remembering # the mapping and copula set for this declarator. foreach my $sym (@$declarator) { no strict 'refs'; *{"$from\::$sym"} = sub (&) { unshift @_, ($mapping, $copula, $aliases); goto &_declare; }; } # Establish prototypes (same as "use subs") so Sub::Override can work { no strict 'refs'; _predeclare( (map { "$from\::$_" } keys %$mapping), (map { ("UNIVERSAL::$_", "$_\::AUTOLOAD") } keys %$copula), ); } } # Same as "use sub". All is fair if you predeclare. sub _predeclare { no strict 'refs'; no warnings 'redefine'; foreach my $sym (@_) { *$sym = \&$sym; } } sub _declare { my ($mapping, $copula, $aliases, $code) = @_; my $from = caller; # Table of collected objects. my @objects; # Establish a lexical extent for overrided symbols; they will be # restored automagically upon scope exit. my %subs_replaced; my $replace = sub { no strict 'refs'; no warnings 'redefine'; my ($sym, $code) = @_; # Do the "use subs" predeclaration again before overriding, because # Sub::Override cannot handle empty symbol slots. This is normally # redundant (&import already did that), but we do it here anyway to # guard against runtime deletion of symbol table entries. _predeclare($sym); # Now replace the symbol for real. $subs_replaced{$sym} ||= *$sym{CODE}; *$sym = $code; }; # In DSL (domain-specific language) mode; install AUTOLOAD to handle all # unrecognized calls for "foo is 1" (which gets translated to "is->foo(1)", # and UNIVERSAL to collect "is foo" (which gets translated to "foo->is". # The arguments are rolled into a Katamari structure for later analysis. while (my ($sym, $prefix) = each %$copula) { $replace->( "UNIVERSAL::$sym" => sub { # Turn "is some_field" into "some_field is 1" my ($key, @vals) = ref($prefix) ? $prefix->(@_) : ($prefix.$_[0] => 1) or return; # If the copula returns a ready-to-use katamari object, # don't try to roll it by ourself. return $key if ref($key) && ref($key) eq 'Object::Declare::Katamari'; $key = $aliases->{$key} if $aliases and exists $aliases->{$key}; unshift @vals, $key; bless( \@vals => 'Object::Declare::Katamari' ); } ); $replace->( "$sym\::AUTOLOAD" => sub { # Handle "some_field is $some_value" shift; my $field = our $AUTOLOAD; return if $field =~ /DESTROY$/; $field =~ s/^\Q$sym\E:://; my ($key, @vals) = ref($prefix) ? $prefix->($field, @_) : ($prefix.$field => @_) or return; $key = $aliases->{$key} if $aliases and exists $aliases->{$key}; unshift @vals, $key; bless( \@vals, 'Object::Declare::Katamari' ); } ); } my @overridden = map { "$from\::$_" } keys %$mapping; # Now install the collector symbols from class mappings my $toggle_subs = sub { foreach my $sym (@overridden) { no strict 'refs'; no warnings 'redefine'; ($subs_replaced{$sym}, *$sym) = (*$sym{CODE}, $subs_replaced{$sym}); } }; while (my ($sym, $build) = each %$mapping) { $replace->("$from\::$sym" => _make_object($build => \@objects, $toggle_subs)); } # Let's play Katamari! &$code; # Restore overriden subs while (my ($sym, $code) = each %subs_replaced) { no strict 'refs'; no warnings 'redefine'; *$sym = $code; } # In scalar context, returns hashref; otherwise preserve ordering return(wantarray ? @objects : { @objects }); } # Make a star from the Katamari! sub _make_object { my ($build, $schema, $toggle_subs) = @_; return sub { # Restore overriden subs no strict 'refs'; no warnings 'redefine'; my $name = ( ref( $_[0] ) ? undef : shift ); my $args = \@_; my $damacy = bless(sub { $toggle_subs->(); my $rv = $build->( ( $_[0] ? ( name => $_[0] ) : () ), map { $_->unroll } @$args ); $toggle_subs->(); return $rv; } => 'Object::Declare::Damacy'); if (wantarray) { return ($damacy); } else { push @$schema, $name => $damacy->($name); } }; } package Object::Declare::Katamari; use overload "!" => \&negation, fallback => 1; sub negation { my @katamari = @{$_[0]} or return (); $katamari[1] = !$katamari[1]; return bless(\@katamari, ref($_[0])); } # Unroll a Katamari structure into constructor arguments. sub unroll { my @katamari = @{$_[0]} or return (); my $field = shift @katamari or return (); my @unrolled; unshift @unrolled, pop(@katamari)->unroll while ref($katamari[-1]) eq __PACKAGE__; if (@katamari == 1) { # single value: "is foo" if ( ref( $katamari[0] ) eq 'Object::Declare::Damacy' ) { $katamari[0] = $katamari[0]->($field); } return($field => @katamari, @unrolled); } else { # Multiple values: "are qw( foo bar baz )" foreach my $kata (@katamari) { $kata = $kata->() if ref($kata) eq 'Object::Declare::Damacy'; } return($field => \@katamari, @unrolled); } } 1; __END__ =pod =head1 NAME Object::Declare - Declarative object constructor =head1 VERSION version 0.23 =head1 SYNOPSIS use Object::Declare ['MyApp::Column', 'MyApp::Param']; my %objects = declare { param foo => !is global, is immutable, valid_values are qw( more values ); column bar => field1 is 'value', field2 is 'some_other_value', sub_params are param( is happy ), param ( is sad ); }; print $objects{foo}; # a MyApp::Param object print $objects{bar}; # a MyApp::Column object # Assuming that MyApp::Column::new simply blesses into a hash... print $objects{bar}{sub_params}[0]; # a MyApp::Param object print $objects{bar}{sub_params}[1]; # a MyApp::Param object =head1 DESCRIPTION This module exports one function, C, for building named objects with a declarative syntax, similar to how L defines its columns. In list context, C returns a list of name/object pairs in the order of declaration (allowing duplicates), suitable for putting into a hash. In scalar context, C returns a hash reference. Using a flexible C interface, one can change exported helper functions names (I), words to link labels and values together (I), and the table of named classes to declare (I): use Object::Declare declarator => ['declare'], # list of declarators copula => { # list of words, or a map is => '', # from copula to label prefixes, are => '', # or to callback that e.g. turns has => sub { has => @_ }, # "has X" to "has is X" and # "X has 1" to "has is [X => 1]" }, aliases => { # list of label aliases: more => 'less', # turns "is more" into "is less" # and "more is 1" into "less is 1" }, mapping => { column => 'MyApp::Column', # class name to call ->new to param => sub { # arbitrary coderef also works bless(\@_, 'MyApp::Param'); }, }; After the declarator block finishes execution, all helper functions are removed from the package. Same-named functions (such as C<&is> and C<&are>) that existed before the declarator's execution are restored correctly. =head1 NOTES If you export the declarator to another package via C<@EXPORT>, be sure to export all mapping keys as well. For example, this will work for the example above: our @EXPORT = qw( declare column param ); But this will not: our @EXPORT = qw( declare ); The copula are not turned into functions, so there is no need to export them. =head1 AUTHORS Audrey Tang Ecpan@audreyt.orgE =head1 COPYRIGHT Copyright 2006, 2007 by Audrey Tang . This software is released under the MIT license cited below. =head2 The "MIT" License Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 AUTHOR Shlomi Fish =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2006 by Audrey Tang. This is free software, licensed under: The MIT (X11) License =head1 BUGS Please report any bugs or feature requests on the bugtracker website http://rt.cpan.org/NoAuth/Bugs.html?Dist=Object-Declare or by email to bug-object-declare@rt.cpan.org. When submitting a bug or request, please include a test-file or a patch to an existing test-file that illustrates the bug or desired feature. =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Perldoc You can find documentation for this module with the perldoc command. perldoc Object::Declare =head2 Websites The following websites have more information about this module, and may be of help to you. As always, in addition to those websites please use your favorite search engine to discover more resources. =over 4 =item * MetaCPAN A modern, open-source CPAN search engine, useful to view POD in HTML format. L =item * Search CPAN The default CPAN search engine, useful to view POD in HTML format. L =item * RT: CPAN's Bug Tracker The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN. L =item * AnnoCPAN The AnnoCPAN is a website that allows community annotations of Perl module documentation. L =item * CPAN Ratings The CPAN Ratings is a website that allows community ratings and reviews of Perl modules. L =item * CPAN Forum The CPAN Forum is a web forum for discussing Perl modules. L =item * CPANTS The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution. L =item * CPAN Testers The CPAN Testers is a network of smokers who run automated tests on uploaded CPAN distributions. L =item * CPAN Testers Matrix The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms. L =item * CPAN Testers Dependencies The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution. L =back =head2 Bugs / Feature Requests Please report any bugs or feature requests by email to C, or through the web interface at L. You will be automatically notified of any progress on the request by the system. =head2 Source Code The code is open to the world, and available for you to hack on. Please feel free to browse it and play with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull from your repository :) L git clone git://github.com/shlomif/perl-Object-Declare.git =cut author-pod-syntax.t100644000764000764 50312657435762 20614 0ustar00shlomifshlomif000000000000Object-Declare-0.23/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Declare.pm~100644000764000764 2567712657435762 20710 0ustar00shlomifshlomif000000000000Object-Declare-0.23/lib/Objectpackage Object::Declare; use 5.006; use strict; use warnings; $Object::Declare::VERSION = '0.22'; sub import { my $class = shift; my %args = ((@_ and ref($_[0])) ? (mapping => $_[0]) : @_) or return; my $from = caller; my $mapping = $args{mapping} or return; my $aliases = $args{aliases} || {}; my $declarator = $args{declarator} || ['declare']; my $copula = $args{copula} || ['is', 'are']; # Both declarator and copula can contain more than one entries; # normalize into an arrayref if we only have on entry. $mapping = [$mapping] unless ref($mapping); $declarator = [$declarator] unless ref($declarator); $copula = [$copula] unless ref($copula); if (ref($mapping) eq 'ARRAY') { # rewrite "MyApp::Foo" into simply "foo" $mapping = { map { my $helper = $_; $helper =~ s/.*:://; (lc($helper) => $_); } @$mapping }; } # Convert mapping targets into instantiation closures if (ref($mapping) eq 'HASH') { foreach my $key (keys %$mapping) { my $val = $mapping->{$key}; next if ref($val); # already a callback, don't bother $mapping->{$key} = sub { scalar($val->new(@_)) }; } } if (ref($copula) eq 'ARRAY') { # add an empty prefix to all copula $copula = { map { $_ => '' } @$copula } } # Install declarator functions into caller's package, remembering # the mapping and copula set for this declarator. foreach my $sym (@$declarator) { no strict 'refs'; *{"$from\::$sym"} = sub (&) { unshift @_, ($mapping, $copula, $aliases); goto &_declare; }; } # Establish prototypes (same as "use subs") so Sub::Override can work { no strict 'refs'; _predeclare( (map { "$from\::$_" } keys %$mapping), (map { ("UNIVERSAL::$_", "$_\::AUTOLOAD") } keys %$copula), ); } } # Same as "use sub". All is fair if you predeclare. sub _predeclare { no strict 'refs'; no warnings 'redefine'; foreach my $sym (@_) { *$sym = \&$sym; } } sub _declare { my ($mapping, $copula, $aliases, $code) = @_; my $from = caller; # Table of collected objects. my @objects; # Establish a lexical extent for overrided symbols; they will be # restored automagically upon scope exit. my %subs_replaced; my $replace = sub { no strict 'refs'; no warnings 'redefine'; my ($sym, $code) = @_; # Do the "use subs" predeclaration again before overriding, because # Sub::Override cannot handle empty symbol slots. This is normally # redundant (&import already did that), but we do it here anyway to # guard against runtime deletion of symbol table entries. _predeclare($sym); # Now replace the symbol for real. $subs_replaced{$sym} ||= *$sym{CODE}; *$sym = $code; }; # In DSL (domain-specific language) mode; install AUTOLOAD to handle all # unrecognized calls for "foo is 1" (which gets translated to "is->foo(1)", # and UNIVERSAL to collect "is foo" (which gets translated to "foo->is". # The arguments are rolled into a Katamari structure for later analysis. while (my ($sym, $prefix) = each %$copula) { $replace->( "UNIVERSAL::$sym" => sub { # Turn "is some_field" into "some_field is 1" my ($key, @vals) = ref($prefix) ? $prefix->(@_) : ($prefix.$_[0] => 1) or return; # If the copula returns a ready-to-use katamari object, # don't try to roll it by ourself. return $key if ref($key) && ref($key) eq 'Object::Declare::Katamari'; $key = $aliases->{$key} if $aliases and exists $aliases->{$key}; unshift @vals, $key; bless( \@vals => 'Object::Declare::Katamari' ); } ); $replace->( "$sym\::AUTOLOAD" => sub { # Handle "some_field is $some_value" shift; my $field = our $AUTOLOAD; return if $field =~ /DESTROY$/; $field =~ s/^\Q$sym\E:://; my ($key, @vals) = ref($prefix) ? $prefix->($field, @_) : ($prefix.$field => @_) or return; $key = $aliases->{$key} if $aliases and exists $aliases->{$key}; unshift @vals, $key; bless( \@vals, 'Object::Declare::Katamari' ); } ); } my @overridden = map { "$from\::$_" } keys %$mapping; # Now install the collector symbols from class mappings my $toggle_subs = sub { foreach my $sym (@overridden) { no strict 'refs'; no warnings 'redefine'; ($subs_replaced{$sym}, *$sym) = (*$sym{CODE}, $subs_replaced{$sym}); } }; while (my ($sym, $build) = each %$mapping) { $replace->("$from\::$sym" => _make_object($build => \@objects, $toggle_subs)); } # Let's play Katamari! &$code; # Restore overriden subs while (my ($sym, $code) = each %subs_replaced) { no strict 'refs'; no warnings 'redefine'; *$sym = $code; } # In scalar context, returns hashref; otherwise preserve ordering return(wantarray ? @objects : { @objects }); } # Make a star from the Katamari! sub _make_object { my ($build, $schema, $toggle_subs) = @_; return sub { # Restore overriden subs no strict 'refs'; no warnings 'redefine'; my $name = ( ref( $_[0] ) ? undef : shift ); my $args = \@_; my $damacy = bless(sub { $toggle_subs->(); my $rv = $build->( ( $_[0] ? ( name => $_[0] ) : () ), map { $_->unroll } @$args ); $toggle_subs->(); return $rv; } => 'Object::Declare::Damacy'); if (wantarray) { return ($damacy); } else { push @$schema, $name => $damacy->($name); } }; } package Object::Declare::Katamari; use overload "!" => \&negation, fallback => 1; sub negation { my @katamari = @{$_[0]} or return (); $katamari[1] = !$katamari[1]; return bless(\@katamari, ref($_[0])); } # Unroll a Katamari structure into constructor arguments. sub unroll { my @katamari = @{$_[0]} or return (); my $field = shift @katamari or return (); my @unrolled; unshift @unrolled, pop(@katamari)->unroll while ref($katamari[-1]) eq __PACKAGE__; if (@katamari == 1) { # single value: "is foo" if ( ref( $katamari[0] ) eq 'Object::Declare::Damacy' ) { $katamari[0] = $katamari[0]->($field); } return($field => @katamari, @unrolled); } else { # Multiple values: "are qw( foo bar baz )" foreach my $kata (@katamari) { $kata = $kata->() if ref($kata) eq 'Object::Declare::Damacy'; } return($field => \@katamari, @unrolled); } } 1; __END__ =head1 NAME Object::Declare - Declarative object constructor =head1 SYNOPSIS use Object::Declare ['MyApp::Column', 'MyApp::Param']; my %objects = declare { param foo => !is global, is immutable, valid_values are qw( more values ); column bar => field1 is 'value', field2 is 'some_other_value', sub_params are param( is happy ), param ( is sad ); }; print $objects{foo}; # a MyApp::Param object print $objects{bar}; # a MyApp::Column object # Assuming that MyApp::Column::new simply blesses into a hash... print $objects{bar}{sub_params}[0]; # a MyApp::Param object print $objects{bar}{sub_params}[1]; # a MyApp::Param object =head1 DESCRIPTION This module exports one function, C, for building named objects with a declarative syntax, similar to how L defines its columns. In list context, C returns a list of name/object pairs in the order of declaration (allowing duplicates), suitable for putting into a hash. In scalar context, C returns a hash reference. Using a flexible C interface, one can change exported helper functions names (I), words to link labels and values together (I), and the table of named classes to declare (I): use Object::Declare declarator => ['declare'], # list of declarators copula => { # list of words, or a map is => '', # from copula to label prefixes, are => '', # or to callback that e.g. turns has => sub { has => @_ }, # "has X" to "has is X" and # "X has 1" to "has is [X => 1]" }, aliases => { # list of label aliases: more => 'less', # turns "is more" into "is less" # and "more is 1" into "less is 1" }, mapping => { column => 'MyApp::Column', # class name to call ->new to param => sub { # arbitrary coderef also works bless(\@_, 'MyApp::Param'); }, }; After the declarator block finishes execution, all helper functions are removed from the package. Same-named functions (such as C<&is> and C<&are>) that existed before the declarator's execution are restored correctly. =head1 NOTES If you export the declarator to another package via C<@EXPORT>, be sure to export all mapping keys as well. For example, this will work for the example above: our @EXPORT = qw( declare column param ); But this will not: our @EXPORT = qw( declare ); The copula are not turned into functions, so there is no need to export them. =head1 AUTHORS Audrey Tang Ecpan@audreyt.orgE =head1 COPYRIGHT Copyright 2006, 2007 by Audrey Tang . This software is released under the MIT license cited below. =head2 The "MIT" License Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =cut author-pod-coverage.t100644000764000764 56512657435762 21071 0ustar00shlomifshlomif000000000000Object-Declare-0.23/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } # 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' }); release-cpan-changes.t100644000764000764 52112657435762 21153 0ustar00shlomifshlomif000000000000Object-Declare-0.23/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More 0.96 tests => 2; use_ok('Test::CPAN::Changes'); subtest 'changes_ok' => sub { changes_file_ok('Changes'); }; done_testing(); release-trailing-space.t100644000764000764 127212657435762 21552 0ustar00shlomifshlomif000000000000Object-Declare-0.23/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; eval "use Test::TrailingSpace"; if ($@) { plan skip_all => "Test::TrailingSpace required for trailing space test."; } else { plan tests => 1; } # TODO: add .pod, .PL, the README/Changes/TODO/etc. documents and possibly # some other stuff. my $finder = Test::TrailingSpace->new( { root => '.', filename_regex => qr#(?:\.(?:t|pm|pl|xs|c|h|txt|pod|PL)|README|Changes|TODO|LICENSE)\z#, }, ); # TEST $finder->no_trailing_space( "No trailing space was found." );