Bread-Board-0.29000755001750000144 012243443340 12620 5ustar00doyusers000000000000README100644001750000144 50712243443340 13543 0ustar00doyusers000000000000Bread-Board-0.29 This archive contains the distribution Bread-Board, version 0.29: A solderless way to wire up your application components This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Changes100644001750000144 2741112243443340 14221 0ustar00doyusers000000000000Bread-Board-0.29Revision history for Bread-Board 0.29 2013-11-21 - Fix deprecated enum syntax 0.28 2013-08-30 - Allow overriding of services and containers. This is useful when using the common pattern of "sub BUILD { my $self = shift; container $self => as { ... } }" since the BUILD method in a subclass can modify existing services and containers that were defined in a superclass, rather than only being able to replace them (Florian Ragwitz, #26, #27). 0.27 2013-08-06 - allow the 'container $obj' sugar for parameterized containers (Florian Ragwitz, #25) 0.26 2013-08-01 - allow cloning containers with parameterized subcontainers (Florian Ragwitz, #22) - allow referencing parent services from parameterized subcontainers (Florian Ragwitz, #23) - deprecate special case in path traversal where a path component with the name of the current container was ignored (doy, #20) - fix setting the current container multiple times from outside of a container (doy) - make some error messages more helpful (Jason Galea, #14) - doc improvements (Sterling Hanenkamp, zdk, Philippe Bruhat, and Gabor Szabo; #15, #17, #19, #21) - remove the (unmaintained) Bread::Board::GraphViz 0.25 2011-10-20 * Bread::Board - the container sugar was misbehaving (since April 2010 apparently), so we have fixed it and clarified it 0.24 2011-10-15 * Bread::Board::Container - make sure to clone subcontainers, this is necessary for parameterized containers to retain their connections * Bread::Board::Traversable - add some errors, be a little more defensive 0.23 2011-10-14 * Bread::Board::Container::Parameterized - retain control of names of the generated containers, so if your the container being generated has a name, it keeps it. - this makes these containers more addressable when composed into higher level containers - this helps when subclassing parameterized containers - switch the generated containers to be created with builder instead of default - also helps when subclassing parameterized containers as well * t/046_custom_parameter_service.t - fixing the error about Moose deprecations 0.22 2011-10-03 - When inferring a service for a type, allow subclasses to fulfill discovered types. - Converted to Dist::Zilla 0.21 2011-09-06 * Bread::Board - Allow service() and alias() sugar functions to return the newly-created objects if the context container is not defined. (thanks to kip hampton) - added tests for this - this module is just an exporter, so it does not need to 'use Moose' (thanks to Tomas Doran) - fixed some spelling and grammar errors (thanks to ben hengst and Brad Bowman) * Bread::Board::Service::WithParameters - parameters attribute now has a builder instead of a default, so as to allow better tweaking in subclasses (thanks to Andre Walker) - added tests for this 0.20 2011-06-13 * Bread::Board::Lifecycle::Singleton - fix bug in singletons with circular refs (thanks to doy) - added tests for this (thanks to perigrin) 0.19 2011-06-01 * Bread::Board::GraphViz - added by jrockway, this allows you to visualise a Bread::Board system using GraphViz - note that this is optional and requires you to install optional dependencies * Bread::Board::Service::Alias - add the ability to alias services under another name (thanks to doy) - added tests for this * Bread::Board::Service::Inferred - improving edge cases (thanks to doy) * Bread::Board::Service::* - several code improvements (thanks to doy) * Bread::Board::Service - allow for custom Lifecycles by using the "+" prefix (thanks to jasonmay) - added tests for this 0.18 2011-04-13 * Bread::Board::Service::WithParameters - added has_parameter_defaults method to check if a parameter has default values * Bread::Board::Service::WithDependencies - added a check for has_parameter_defaults before we make a Thunk - added test for this (thanks to rafl) 0.17 2011-02-22 * Bread::Board::Service::Inferred - make recrusive inferrence work - add tests for this * Bread::Board::Manual::Concepts::Advanced - small doc update about subclassing and the name parameter, resolving RT#63124 (thanks to Evan Haas) !! POSSIBLE BACK COMPAT BREAKAGE !! * Bread::Board::Traversal - make relative parent path traversal more sane, there should be no more need for excessive ../../ stuff in dependency service paths (thanks doy) - adjust tests accordingly - this should fix RT#64478 as well 0.16 2011-01-10 * Bread::Board::service sugar - adding the 'service_class' param for the service sugar function which allows you to pass in a custom service subclass - added tests for this (062_service_class_w_sugar.t) * Bread::Board::Dependency - added the service_params attribute here so that it is possible to pass in parameters when you depend on a service which requires them - added tests for this (045_parameters_in_dependency.t) * Bread::Board::Service::Inferred - when a typemapped service is created it is now named with the special 'type:' prefix. This allows you to depend on a typemapped service in a non-typemapped service - added tests for this (079_depending_on_type.t) * Bread::Board::Traversable - improving the error messages when a container/service is not found 0.15 2010-09-30 * Bread::Board::Service - removed the MooseX::Param dependency and implemented it internally so that we have more control * Bread::Board::Types - the Bread::Board::Service::Dependencies type now can also coerce ArrayRef[Str] and HashRef[Str] types correctly (doy) * Bread::Board::Service::WithDependencies - we now only create a ::Deferred::Thunk object if we have non-optional params * Bread::Board::Service::WithParameters - added the has_required_parameters method, to see if there are any non-optional parameters - added tests for both the above !! NEW EXPERIMENTAL FEATURE !! * Bread::Board - added the typemap and infer keyword to help in the mapping of types and construction of inferred services - added tests for this * Bread::Board::Container - added the typemap feature and added the ->resolve( type => $type ) call - added tests for this * Bread::Board::Service::Inferred - added this and tests for it * Bread::Board::Manual::Concepts::Typemap - added this to help explain the typemap feature 0.14 2010-08-24 * Bread::Board::Container - added the ->resolve method to replace the ->fetch( $service )->get pattern that annoys mst so much. - adjusted all the tests to account for this change. - adjusted all the docs to now use this approach instead - now using Try::Tiny for all exception handling (except the Deferred service) * Bread::Board::Service::WithDependencies - if you want to depend on a parameterized service, now you can and it will return a Bread::Board::Service::Deferred::Thunk that you can call ->inflate on and pass in the parameters for it. - added tests for this * Bread::Board::Service::Deferred::Thunk - added this + tests for it 0.13 2010-04-23 * Bread::Board - making the include keyword handle compilation errors better (doy) - added test for this * Bread::Board::Container Bread::Board::Container::Parameterized - it is now possible to store parameterized containers within regular containers and have them behave properly - added tests for this * Bread::Board::Manual::Example::* - adding some examples of ways to use Bread::Board to the manual - added tests to confirm they work 0.12 2010-04-18 * Bread::Board - added the `include` keyword which will evaluate an external file within your Bread::Board configuration - added tests for this - added support for parameterized containers - added tests for this - the 'container' keyword will now accept an instance of Bread::Board::Container instead of the name, this makes subclassing easier - added tests for this + Bread::Board::Container::Parameterized - added this module and tests + Bread::Baord::Manual - moved, re-organizad and added too the docs that were previously in Bread::Board.pm 0.11 2010-03-25 * Much improved documentation. * Fixed inc/ to include all used Module-Install extensions. 0.10 2010-02-22 * Bread::Board - import strict and warnings into the caller upon import (Florian Ragwitz) - fixing the SYNOPSIS so that it will actually run (thanks to zby for spotting this) * Bread::Board::ConstructorInjection - Add a constructor_name parameter for classes using MooseX::Traits or other things which need an alternately named constructor. (Tomas Doran) 0.09 2009-07-29 Add cloning support for containers and services (thanks to jrockway for this) - adding tests for this * Bread::Board::ConstructorInjection - use meta->constructor_name instead of "new" if possible (jrockway) * Bread::Board::Service::WithParameters - fixing a leak where we would hold onto parameters that were passed into get() 0.08 2009-07-18 - updating dates on all files * Bread::Board::LifeCycle::Singleton::WithParameters - new module added to support the idea of a singleton lifecycle keyed on the parameters rather then just a per-instance item. * Bread::Board::Traversable - fixed the is_weak_ref mis-spelling 0.07 2009-02-18 - Work with new MooseX::Params::Validate - Specify MX::P::Validate version number in Makefile.PL 0.06 2008-11-03 - Forgot to update MANIFEST before uploading to CPAN. 0.05 2008-11-03 - Applied immutablity to classes where applicable, and vigorously unimport Moose keywords when they are no longer needed. This results in x 2 performance as far as defining a Bread::Board model (Daisuke Maki). * Bread::Board - Implemented unimport(), thus allowing you to remove keywords exported by Bread::Board (Daisuke Maki). * Bread::Board::Traversable - Unrolled recursive calls to loops, and removed Sub::Current dependency (Daisuke Maki) 0.04 2008-10-31 * Bread::Board Bread::Board::Traversable - fix root path handling (thanks to Daisuke Maki) - added tests for this * Bread::Board::Dumper - Simple utility for dumping containers (thanks to Daisuke Maki) * t/ - fixing the plans so that new versions of Test::More stop complaining 0.03 2008-01-08 * Bread::Board::Service::WithParameters - fixed the parameter validation to use a custom cache key, this is so that it plays nicely with the new MooseX::Params::Validate - added tests for this 0.02 2008-01-08 - forgot a dependency, whoops. 0.01 2008-01-07 - Out with the old (IOC) and in with the new (Bread::Board) LICENSE100644001750000144 4370312243443340 13735 0ustar00doyusers000000000000Bread-Board-0.29This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Infinity Interactive. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Infinity Interactive. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644001750000144 75412243443340 14333 0ustar00doyusers000000000000Bread-Board-0.29name = Bread-Board author = Stevan Little license = Perl_5 copyright_holder = Infinity Interactive [@DOY] :version = 0.14 dist = Bread-Board repository = github github_user = stevan github_name = BreadBoard authority = cpan:STEVAN [AutoPrereqs] skip = ^(?:Foo|Bar|Baz|My)\b skip = ^(?:Chair|Desk|Employee|Thing)\b skip = Logger::Role skip = MyCustomWithParametersService skip = WorkArea [ContributorsFromGit] [Prereqs / DevelopRequires] Form::Sensible = 0.11220 META.yml100644001750000144 2252212243443340 14175 0ustar00doyusers000000000000Bread-Board-0.29--- abstract: 'A solderless way to wire up your application components' author: - 'Stevan Little ' build_requires: File::Spec: 0 FindBin: 0 IO::Handle: 0 IPC::Open3: 0 Test::Fatal: 0 Test::Moose: 0 Test::More: 0.88 Test::Requires: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Bread-Board provides: Bread::Board: file: lib/Bread/Board.pm version: 0.29 Bread::Board::BlockInjection: file: lib/Bread/Board/BlockInjection.pm version: 0.29 Bread::Board::ConstructorInjection: file: lib/Bread/Board/ConstructorInjection.pm version: 0.29 Bread::Board::Container: file: lib/Bread/Board/Container.pm version: 0.29 Bread::Board::Container::FromParameterized: file: lib/Bread/Board/Container/FromParameterized.pm version: 0.29 Bread::Board::Container::Parameterized: file: lib/Bread/Board/Container/Parameterized.pm version: 0.29 Bread::Board::Dependency: file: lib/Bread/Board/Dependency.pm version: 0.29 Bread::Board::Dumper: file: lib/Bread/Board/Dumper.pm version: 0.29 Bread::Board::LifeCycle: file: lib/Bread/Board/LifeCycle.pm version: 0.29 Bread::Board::LifeCycle::Singleton: file: lib/Bread/Board/LifeCycle/Singleton.pm version: 0.29 Bread::Board::LifeCycle::Singleton::WithParameters: file: lib/Bread/Board/LifeCycle/Singleton/WithParameters.pm version: 0.29 Bread::Board::Literal: file: lib/Bread/Board/Literal.pm version: 0.29 Bread::Board::Service: file: lib/Bread/Board/Service.pm version: 0.29 Bread::Board::Service::Alias: file: lib/Bread/Board/Service/Alias.pm version: 0.29 Bread::Board::Service::Deferred: file: lib/Bread/Board/Service/Deferred.pm version: 0.29 Bread::Board::Service::Deferred::Thunk: file: lib/Bread/Board/Service/Deferred/Thunk.pm version: 0.29 Bread::Board::Service::Inferred: file: lib/Bread/Board/Service/Inferred.pm version: 0.29 Bread::Board::Service::WithClass: file: lib/Bread/Board/Service/WithClass.pm version: 0.29 Bread::Board::Service::WithDependencies: file: lib/Bread/Board/Service/WithDependencies.pm version: 0.29 Bread::Board::Service::WithParameters: file: lib/Bread/Board/Service/WithParameters.pm version: 0.29 Bread::Board::SetterInjection: file: lib/Bread/Board/SetterInjection.pm version: 0.29 Bread::Board::Traversable: file: lib/Bread/Board/Traversable.pm version: 0.29 Bread::Board::Types: file: lib/Bread/Board/Types.pm version: 0.29 requires: Carp: 0 Moose: 0 Moose::Exporter: 1.00 Moose::Role: 0 Moose::Util: 0 Moose::Util::TypeConstraints: 0 MooseX::Clone: 0.05 MooseX::Params::Validate: 0.14 Scalar::Util: 0 Try::Tiny: 0 overload: 0 strict: 0 warnings: 0 resources: bugtracker: https://github.com/stevan/BreadBoard/issues homepage: http://metacpan.org/release/Bread-Board repository: git://github.com/stevan/BreadBoard.git version: 0.29 x_Dist_Zilla: perl: version: 5.018001 plugins: - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: '@DOY/TestMoreDoneTesting' version: 5.006 - class: Dist::Zilla::Plugin::GatherDir name: '@DOY/GatherDir' version: 5.006 - class: Dist::Zilla::Plugin::PruneCruft name: '@DOY/PruneCruft' version: 5.006 - class: Dist::Zilla::Plugin::ManifestSkip name: '@DOY/ManifestSkip' version: 5.006 - class: Dist::Zilla::Plugin::MetaYAML name: '@DOY/MetaYAML' version: 5.006 - class: Dist::Zilla::Plugin::License name: '@DOY/License' version: 5.006 - class: Dist::Zilla::Plugin::Readme name: '@DOY/Readme' version: 5.006 - class: Dist::Zilla::Plugin::RunExtraTests name: '@DOY/RunExtraTests' version: 0.013 - class: Dist::Zilla::Plugin::ExecDir name: '@DOY/ExecDir' version: 5.006 - class: Dist::Zilla::Plugin::ShareDir name: '@DOY/ShareDir' version: 5.006 - class: Dist::Zilla::Plugin::MakeMaker name: '@DOY/MakeMaker' version: 5.006 - class: Dist::Zilla::Plugin::Manifest name: '@DOY/Manifest' version: 5.006 - class: Dist::Zilla::Plugin::TestRelease name: '@DOY/TestRelease' version: 5.006 - class: Dist::Zilla::Plugin::ConfirmRelease name: '@DOY/ConfirmRelease' version: 5.006 - class: Dist::Zilla::Plugin::MetaConfig name: '@DOY/MetaConfig' version: 5.006 - class: Dist::Zilla::Plugin::MetaJSON name: '@DOY/MetaJSON' version: 5.006 - class: Dist::Zilla::Plugin::NextRelease name: '@DOY/NextRelease' version: 5.006 - class: Dist::Zilla::Plugin::CheckChangesHasContent name: '@DOY/CheckChangesHasContent' version: 0.006 - class: Dist::Zilla::Plugin::PkgVersion name: '@DOY/PkgVersion' version: 5.006 - class: Dist::Zilla::Plugin::Authority name: '@DOY/Authority' version: 1.006 - class: Dist::Zilla::Plugin::PodCoverageTests name: '@DOY/PodCoverageTests' version: 5.006 - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@DOY/PodSyntaxTests' version: 5.006 - class: Dist::Zilla::Plugin::NoTabsTests config: Dist::Zilla::Plugin::Test::NoTabs: module_finder: - ':InstallModules' script_finder: - ':ExecFiles' name: '@DOY/NoTabsTests' version: 0.05 - class: Dist::Zilla::Plugin::EOLTests name: '@DOY/EOLTests' version: 0.02 - class: Dist::Zilla::Plugin::Test::Compile config: Dist::Zilla::Plugin::Test::Compile: filename: t/00-compile.t module_finder: - ':InstallModules' script_finder: - ':ExecFiles' name: '@DOY/Test::Compile' version: 2.037 - class: Dist::Zilla::Plugin::Metadata name: '@DOY/Metadata' version: 3.03 - class: Dist::Zilla::Plugin::MetaResources name: '@DOY/MetaResources' version: 5.006 - class: Dist::Zilla::Plugin::Git::Check name: '@DOY/Git::Check' version: 2.016 - class: Dist::Zilla::Plugin::Git::Commit name: '@DOY/Git::Commit' version: 2.016 - class: Dist::Zilla::Plugin::Git::Tag name: '@DOY/Git::Tag' version: 2.016 - class: Dist::Zilla::Plugin::Git::NextVersion name: '@DOY/Git::NextVersion' version: 2.016 - class: Dist::Zilla::Plugin::ContributorsFromGit name: '@DOY/ContributorsFromGit' version: 0.006 - class: Dist::Zilla::Plugin::FinderCode name: '@DOY/MetaProvides::Package/AUTOVIV/:InstallModulesPM' version: 5.006 - class: Dist::Zilla::Plugin::MetaProvides::Package config: Dist::Zilla::Plugin::MetaProvides::Package: {} Dist::Zilla::Role::MetaProvider::Provider: inherit_missing: 1 inherit_version: 1 meta_noindex: 1 name: '@DOY/MetaProvides::Package' version: 1.15000000 - class: Dist::Zilla::Plugin::PodWeaver name: '@DOY/PodWeaver' version: 3.101641 - class: Dist::Zilla::Plugin::UploadToCPAN name: '@DOY/UploadToCPAN' version: 5.006 - class: Dist::Zilla::Plugin::AutoPrereqs name: AutoPrereqs version: 5.006 - class: Dist::Zilla::Plugin::ContributorsFromGit name: ContributorsFromGit version: 0.006 - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: requires name: DevelopRequires version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: 5.006 - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: 5.006 zilla: class: Dist::Zilla::Dist::Builder config: is_trial: 0 version: 5.006 x_authority: cpan:STEVAN x_contributors: - 'André Walker ' - 'Brad Bowman ' - 'Daisuke Maki ' - 'Florian Ragwitz ' - 'Gabor Szabo ' - 'Jason Galea ' - 'Jason May ' - 'Jay Hannah ' - 'Jesse Luehrs ' - 'Jonathan Rockway ' - 'Kip Hampton ' - 'Neil Bowers ' - 'Philippe Bruhat (BooK) ' - 'Sterling Hanenkamp ' - 'Tomas Doran ' - 'ben hengst ' - 'zdk ' MANIFEST100644001750000144 577612243443340 14051 0ustar00doyusers000000000000Bread-Board-0.29Changes LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/Bread/Board.pm lib/Bread/Board/BlockInjection.pm lib/Bread/Board/ConstructorInjection.pm lib/Bread/Board/Container.pm lib/Bread/Board/Container/FromParameterized.pm lib/Bread/Board/Container/Parameterized.pm lib/Bread/Board/Dependency.pm lib/Bread/Board/Dumper.pm lib/Bread/Board/LifeCycle.pm lib/Bread/Board/LifeCycle/Singleton.pm lib/Bread/Board/LifeCycle/Singleton/WithParameters.pm lib/Bread/Board/Literal.pm lib/Bread/Board/Manual.pod lib/Bread/Board/Manual/Concepts.pod lib/Bread/Board/Manual/Concepts/Advanced.pod lib/Bread/Board/Manual/Concepts/Typemap.pod lib/Bread/Board/Manual/Example.pod lib/Bread/Board/Manual/Example/FormSensible.pod lib/Bread/Board/Manual/Example/LogDispatch.pod lib/Bread/Board/Service.pm lib/Bread/Board/Service/Alias.pm lib/Bread/Board/Service/Deferred.pm lib/Bread/Board/Service/Deferred/Thunk.pm lib/Bread/Board/Service/Inferred.pm lib/Bread/Board/Service/WithClass.pm lib/Bread/Board/Service/WithDependencies.pm lib/Bread/Board/Service/WithParameters.pm lib/Bread/Board/SetterInjection.pm lib/Bread/Board/Traversable.pm lib/Bread/Board/Types.pm t/00-compile.t t/001_constructor_injection.t t/002_setter_injection.t t/003_block_injection.t t/004_block_injection_w_out_class.t t/005_alias.t t/010_container.t t/011_container_path.t t/012_container_with_shared_deps.t t/020_sugar.t t/021_sugar.t t/022_sugar.t t/023_sugar.t t/024_sugar.t t/025_sugar_w_absolute_path.t t/026_sugar_remove.t t/027_sugar_w_include.t t/028_sugar_w_recursive_inc.t t/029_sugar_auto_wire_names.t t/030_lifecycle_singleton.t t/031_custom_lifecycles.t t/032_singleton_cycle.t t/040_circular_dependencies.t t/041_parameter_cache_handling.t t/042_parameter_cache_with_singleton.t t/043_parameter_leaks.t t/044_deferred_parameters.t t/045_parameters_in_dependency.t t/046_custom_parameter_service.t t/047_dependencies_override_parameters.t t/050_parameterized_containers.t t/051_more_parameterized_containers.t t/052_parameterized_in_hierarchy.t t/053_parameterized_clone.t t/054_parameterized_backref.t t/060_extend_w_sugar.t t/061_extends_w_sugar_and_inheritance.t t/062_service_class_w_sugar.t t/070_with_basic_typemap.t t/071_typemap_with_basic_infer.t t/072_typemap_with_more_infer.t t/073_typemap_with_role_infer.t t/074_typemap_w_recursive_infer.t t/075_complex_typemap_example.t t/076_more_complex_typemap.t t/077_more_complex_typemap_w_roles.t t/078_complex_typemap_w_error.t t/079_depending_on_type.t t/080_infer_subclasses.t t/100_clone_w_constructor_injection.t t/101_clone_w_setter_injection.t t/102_clone_w_block_injection.t t/110_clone_w_singleton.t t/150_deferred_parameters_fail.t t/151_sugar_no_container.t t/152_sugar_service_inheritance.t t/153_sugar_container_inheritance.t t/200_example_code.t t/201_log_dispatch_example.t t/202_form_sensible_example.t t/300_no_new.t t/301_sugar.t t/302_path_traversal_deprecation.t t/lib/bad.bb t/lib/false.bb t/lib/logger.bb t/lib/my_app.bb xt/release/eol.t xt/release/no-tabs.t xt/release/pod-coverage.t xt/release/pod-syntax.t META.json100644001750000144 3441712243443340 14353 0ustar00doyusers000000000000Bread-Board-0.29{ "abstract" : "A solderless way to wire up your application components", "author" : [ "Stevan Little " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.006, CPAN::Meta::Converter version 2.132830", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Bread-Board", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "Form::Sensible" : "0.11220", "Pod::Coverage::TrustPod" : "0", "Test::More" : "0", "Test::NoTabs" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08" } }, "runtime" : { "requires" : { "Carp" : "0", "Moose" : "0", "Moose::Exporter" : "1.00", "Moose::Role" : "0", "Moose::Util" : "0", "Moose::Util::TypeConstraints" : "0", "MooseX::Clone" : "0.05", "MooseX::Params::Validate" : "0.14", "Scalar::Util" : "0", "Try::Tiny" : "0", "overload" : "0", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "File::Spec" : "0", "FindBin" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Test::Fatal" : "0", "Test::Moose" : "0", "Test::More" : "0.88", "Test::Requires" : "0" } } }, "provides" : { "Bread::Board" : { "file" : "lib/Bread/Board.pm", "version" : "0.29" }, "Bread::Board::BlockInjection" : { "file" : "lib/Bread/Board/BlockInjection.pm", "version" : "0.29" }, "Bread::Board::ConstructorInjection" : { "file" : "lib/Bread/Board/ConstructorInjection.pm", "version" : "0.29" }, "Bread::Board::Container" : { "file" : "lib/Bread/Board/Container.pm", "version" : "0.29" }, "Bread::Board::Container::FromParameterized" : { "file" : "lib/Bread/Board/Container/FromParameterized.pm", "version" : "0.29" }, "Bread::Board::Container::Parameterized" : { "file" : "lib/Bread/Board/Container/Parameterized.pm", "version" : "0.29" }, "Bread::Board::Dependency" : { "file" : "lib/Bread/Board/Dependency.pm", "version" : "0.29" }, "Bread::Board::Dumper" : { "file" : "lib/Bread/Board/Dumper.pm", "version" : "0.29" }, "Bread::Board::LifeCycle" : { "file" : "lib/Bread/Board/LifeCycle.pm", "version" : "0.29" }, "Bread::Board::LifeCycle::Singleton" : { "file" : "lib/Bread/Board/LifeCycle/Singleton.pm", "version" : "0.29" }, "Bread::Board::LifeCycle::Singleton::WithParameters" : { "file" : "lib/Bread/Board/LifeCycle/Singleton/WithParameters.pm", "version" : "0.29" }, "Bread::Board::Literal" : { "file" : "lib/Bread/Board/Literal.pm", "version" : "0.29" }, "Bread::Board::Service" : { "file" : "lib/Bread/Board/Service.pm", "version" : "0.29" }, "Bread::Board::Service::Alias" : { "file" : "lib/Bread/Board/Service/Alias.pm", "version" : "0.29" }, "Bread::Board::Service::Deferred" : { "file" : "lib/Bread/Board/Service/Deferred.pm", "version" : "0.29" }, "Bread::Board::Service::Deferred::Thunk" : { "file" : "lib/Bread/Board/Service/Deferred/Thunk.pm", "version" : "0.29" }, "Bread::Board::Service::Inferred" : { "file" : "lib/Bread/Board/Service/Inferred.pm", "version" : "0.29" }, "Bread::Board::Service::WithClass" : { "file" : "lib/Bread/Board/Service/WithClass.pm", "version" : "0.29" }, "Bread::Board::Service::WithDependencies" : { "file" : "lib/Bread/Board/Service/WithDependencies.pm", "version" : "0.29" }, "Bread::Board::Service::WithParameters" : { "file" : "lib/Bread/Board/Service/WithParameters.pm", "version" : "0.29" }, "Bread::Board::SetterInjection" : { "file" : "lib/Bread/Board/SetterInjection.pm", "version" : "0.29" }, "Bread::Board::Traversable" : { "file" : "lib/Bread/Board/Traversable.pm", "version" : "0.29" }, "Bread::Board::Types" : { "file" : "lib/Bread/Board/Types.pm", "version" : "0.29" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/stevan/BreadBoard/issues" }, "homepage" : "http://metacpan.org/release/Bread-Board", "repository" : { "type" : "git", "url" : "git://github.com/stevan/BreadBoard.git", "web" : "https://github.com/stevan/BreadBoard" } }, "version" : "0.29", "x_Dist_Zilla" : { "perl" : { "version" : "5.018001" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "@DOY/TestMoreDoneTesting", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::GatherDir", "name" : "@DOY/GatherDir", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::PruneCruft", "name" : "@DOY/PruneCruft", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "@DOY/ManifestSkip", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@DOY/MetaYAML", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@DOY/License", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Readme", "name" : "@DOY/Readme", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::RunExtraTests", "name" : "@DOY/RunExtraTests", "version" : "0.013" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@DOY/ExecDir", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@DOY/ShareDir", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "name" : "@DOY/MakeMaker", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@DOY/Manifest", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@DOY/TestRelease", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@DOY/ConfirmRelease", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@DOY/MetaConfig", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@DOY/MetaJSON", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@DOY/NextRelease", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::CheckChangesHasContent", "name" : "@DOY/CheckChangesHasContent", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::PkgVersion", "name" : "@DOY/PkgVersion", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Authority", "name" : "@DOY/Authority", "version" : "1.006" }, { "class" : "Dist::Zilla::Plugin::PodCoverageTests", "name" : "@DOY/PodCoverageTests", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@DOY/PodSyntaxTests", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::NoTabsTests", "config" : { "Dist::Zilla::Plugin::Test::NoTabs" : { "module_finder" : [ ":InstallModules" ], "script_finder" : [ ":ExecFiles" ] } }, "name" : "@DOY/NoTabsTests", "version" : "0.05" }, { "class" : "Dist::Zilla::Plugin::EOLTests", "name" : "@DOY/EOLTests", "version" : "0.02" }, { "class" : "Dist::Zilla::Plugin::Test::Compile", "config" : { "Dist::Zilla::Plugin::Test::Compile" : { "filename" : "t/00-compile.t", "module_finder" : [ ":InstallModules" ], "script_finder" : [ ":ExecFiles" ] } }, "name" : "@DOY/Test::Compile", "version" : "2.037" }, { "class" : "Dist::Zilla::Plugin::Metadata", "name" : "@DOY/Metadata", "version" : "3.03" }, { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "@DOY/MetaResources", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "name" : "@DOY/Git::Check", "version" : "2.016" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "name" : "@DOY/Git::Commit", "version" : "2.016" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "name" : "@DOY/Git::Tag", "version" : "2.016" }, { "class" : "Dist::Zilla::Plugin::Git::NextVersion", "name" : "@DOY/Git::NextVersion", "version" : "2.016" }, { "class" : "Dist::Zilla::Plugin::ContributorsFromGit", "name" : "@DOY/ContributorsFromGit", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "@DOY/MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Package", "config" : { "Dist::Zilla::Plugin::MetaProvides::Package" : {}, "Dist::Zilla::Role::MetaProvider::Provider" : { "inherit_missing" : "1", "inherit_version" : "1", "meta_noindex" : "1" } }, "name" : "@DOY/MetaProvides::Package", "version" : "1.15000000" }, { "class" : "Dist::Zilla::Plugin::PodWeaver", "name" : "@DOY/PodWeaver", "version" : "3.101641" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@DOY/UploadToCPAN", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "AutoPrereqs", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::ContributorsFromGit", "name" : "ContributorsFromGit", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "requires" } }, "name" : "DevelopRequires", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "5.006" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "5.006" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : "0" }, "version" : "5.006" } }, "x_authority" : "cpan:STEVAN", "x_contributors" : [ "Andr\u00e9 Walker ", "Brad Bowman ", "Daisuke Maki ", "Florian Ragwitz ", "Gabor Szabo ", "Jason Galea ", "Jason May ", "Jay Hannah ", "Jesse Luehrs ", "Jonathan Rockway ", "Kip Hampton ", "Neil Bowers ", "Philippe Bruhat (BooK) ", "Sterling Hanenkamp ", "Tomas Doran ", "ben hengst ", "zdk " ] } Makefile.PL100644001750000144 361112243443340 14654 0ustar00doyusers000000000000Bread-Board-0.29 use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "A solderless way to wire up your application components", "AUTHOR" => "Stevan Little ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "Bread-Board", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "Bread::Board", "PREREQ_PM" => { "Carp" => 0, "Moose" => 0, "Moose::Exporter" => "1.00", "Moose::Role" => 0, "Moose::Util" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Clone" => "0.05", "MooseX::Params::Validate" => "0.14", "Scalar::Util" => 0, "Try::Tiny" => 0, "overload" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "File::Spec" => 0, "FindBin" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Test::Fatal" => 0, "Test::Moose" => 0, "Test::More" => "0.88", "Test::Requires" => 0 }, "VERSION" => "0.29", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "File::Spec" => 0, "FindBin" => 0, "IO::Handle" => 0, "IPC::Open3" => 0, "Moose" => 0, "Moose::Exporter" => "1.00", "Moose::Role" => 0, "Moose::Util" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Clone" => "0.05", "MooseX::Params::Validate" => "0.14", "Scalar::Util" => 0, "Test::Fatal" => 0, "Test::Moose" => 0, "Test::More" => "0.88", "Test::Requires" => 0, "Try::Tiny" => 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); lib000755001750000144 012243443340 13552 5ustar00doyusers000000000000Bread-Board-0.29/tbad.bb100644001750000144 3512243443340 14703 0ustar00doyusers000000000000Bread-Board-0.29/t/libfunction_doesnt_exist 'foo'; t000755001750000144 012243443340 13004 5ustar00doyusers000000000000Bread-Board-0.29022_sugar.t100644001750000144 343312243443340 15040 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); } sub loggers { service 'log_file' => "logfile.log"; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => { log_file => depends_on('log_file'), } ); } my $c = container 'MyApp'; Bread::Board::set_root_container($c); is exception { Bread::Board::set_root_container($c) }, undef, "setting the root container multiple times works"; is exception { Bread::Board::set_root_container(undef) }, undef, "setting the root container to undef works"; container $c => as { like exception { Bread::Board::set_root_container(undef) }, qr/Can't set the root container when we're already in a container/, "can't set the root container from inside a container"; }; Bread::Board::set_root_container($c); loggers(); # reuse baby !!! service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), } ); my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); done_testing; 021_sugar.t100644001750000144 242412243443340 15036 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); } sub loggers { service 'log_file' => "logfile.log"; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => { log_file => depends_on('log_file'), } ); } my $c = container 'MyApp' => as { loggers(); # reuse baby !!! service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), } ); }; my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); done_testing; 020_sugar.t100644001750000144 234312243443340 15035 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); } my $c = container 'MyApp' => as { service 'log_file' => "logfile.log"; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => { log_file => depends_on('log_file'), } ); service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), } ); }; my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); done_testing; 005_alias.t100644001750000144 1601512243443340 15031 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; { package Some::Class; use Moose; has foo => ( is => 'ro', isa => 'Str', ); } { my $c = container 'MyApp' => as { service 'foo' => 'FOO'; service 'bar' => ( block => sub { 'BAR' }, ); service 'baz' => ( class => 'Some::Class', ); alias 'foo_alias' => 'foo'; alias 'bar_alias' => 'bar'; alias 'baz_alias' => 'baz'; }; is($c->resolve(service => 'foo_alias'), 'FOO', "literal aliases work"); is($c->resolve(service => 'bar_alias'), 'BAR', "block aliases work"); isa_ok($c->resolve(service => 'baz_alias'), 'Some::Class'); is($c->fetch('foo_alias')->name, 'foo', "fetch on aliases returns the underlying service"); } { my $c = container 'MyApp' => as { service 'foo' => 'FOO'; service 'bar' => ( block => sub { my $s = shift; return $s->param('foo') . 'BAR'; }, dependencies => ['foo'], ); service 'baz' => ( class => 'Some::Class', dependencies => ['foo'], ); alias 'bar_alias' => 'bar'; alias 'baz_alias' => 'baz'; }; is($c->resolve(service => 'bar_alias'), 'FOOBAR', "block aliases with deps work"); is($c->resolve(service => 'baz_alias')->foo, 'FOO', "constructor aliases with deps work"); } { my $c = container 'MyApp' => as { service 'real_foo' => 'FOO'; service 'bar' => ( block => sub { my $s = shift; return $s->param('foo') . 'BAR'; }, dependencies => ['foo'], ); service 'baz' => ( class => 'Some::Class', dependencies => ['foo'], ); alias 'foo' => 'real_foo'; }; is($c->resolve(service => 'bar'), 'FOOBAR', "blocks can dep on aliases"); is($c->resolve(service => 'baz')->foo, 'FOO', "constructor injections can dep on aliases"); } { my $c = container 'MyApp' => as { service 'foo' => ( block => sub { my $s = shift; return 'FOO' . $s->param('sub_bar'); }, dependencies => ['sub_bar'], ); alias 'sub_bar' => 'SubApp/bar1'; container 'SubApp' => as { service 'bar1' => 'BAR'; service 'bar2' => ( block => sub { my $s = shift; return 'BAR' . $s->param('parent_foo') . $s->param('root_foo') . $s->param('sub_baz'); }, dependencies => ['parent_foo', 'root_foo', 'sub_baz'], ); alias 'parent_foo' => '../foo'; alias 'root_foo' => '/foo'; alias 'sub_baz' => 'SubSubApp/baz1'; container 'SubSubApp' => as { service 'baz1' => 'BAZ'; service 'baz2' => ( block => sub { my $s = shift; return 'BAZ' . $s->param('parent_bar') . $s->param('parent_foo') . $s->param('root_foo'); }, dependencies => ['parent_bar', 'parent_foo', 'root_foo'], ); alias 'parent_bar' => '../bar1'; alias 'parent_foo' => '../../foo'; alias 'root_foo' => '/foo'; }; }; }; is($c->resolve(service => 'foo'), 'FOOBAR', "aliases to nested containers work"); is($c->resolve(service => 'sub_bar'), 'BAR', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/bar1'), 'BAR', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/bar2'), 'BARFOOBARFOOBARBAZ', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/parent_foo'), 'FOOBAR', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/root_foo'), 'FOOBAR', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/sub_baz'), 'BAZ', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/SubSubApp/baz1'), 'BAZ', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/SubSubApp/baz2'), 'BAZBARFOOBARFOOBAR', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/SubSubApp/parent_bar'), 'BAR', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/SubSubApp/parent_foo'), 'FOOBAR', "aliases to nested containers work"); is($c->resolve(service => 'SubApp/SubSubApp/root_foo'), 'FOOBAR', "aliases to nested containers work"); } { my $c = container 'MyApp' => as { service 'foo' => 'FOO'; alias 'foo1' => 'foo'; alias 'foo2' => 'foo1'; }; is($c->resolve(service => 'foo2'), 'FOO', "multi-level aliases work"); is($c->fetch('foo2')->name, 'foo', "multi-level fetching works"); } { my $c; is(exception { $c = container 'MyApp' => as { alias 'foo' => 'doesnt_exist'; alias 'a' => 'a'; alias 'b' => 'c'; alias 'c' => 'b'; alias 'd' => 'e'; alias 'e' => 'f'; alias 'f' => 'd'; }; }, undef, "bad aliases don't die on creation"); like(exception { $c->resolve(service => 'foo'); }, qr/^While resolving alias foo: Could not find container or service for doesnt_exist in MyApp/, "error when aliasing to something that doesn't exist"); like(exception { $c->resolve(service => 'a'); }, qr/^Cycle detected in aliases/, "error with self-referencing aliases"); like(exception { $c->resolve(service => 'b'); }, qr/^Cycle detected in aliases/, "error with circular aliases"); like(exception { $c->resolve(service => 'd'); }, qr/^Cycle detected in aliases/, "error with circular aliases with larger cycles"); like(exception { $c->fetch('a'); }, qr/^Cycle detected in aliases/, "error with self-referencing aliases"); like(exception { $c->fetch('b'); }, qr/^Cycle detected in aliases/, "error with circular aliases"); like(exception { $c->fetch('d'); }, qr/^Cycle detected in aliases/, "error with circular aliases with larger cycles"); } { my $c = container 'MyApp' => as { service 'foo' => ( class => 'Some::Class', lifecycle => 'Singleton', ); alias 'foo_alias' => 'foo'; }; is($c->resolve(service => 'foo'), $c->resolve(service => 'foo'), "same object, since it's a singleton"); is($c->resolve(service => 'foo_alias'), $c->resolve(service => 'foo_alias'), "same object, since it's a singleton"); } done_testing; 301_sugar.t100644001750000144 504412243443340 15040 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; my $exception = exception { container (bless {}, 'NameObject') }; like( $exception, qr/^an object used as a container/, "exception begins with: an object used as a container" ); ok ( (container 'MyApp' => as { service 'service_name', 'service_type' => 'Block', 'block' => sub{} } ), 'set service with service type name' ); my $c = container 'Application'; isa_ok($c, 'Bread::Board::Container'); ok ( (container $c), 'set container with object' ); $exception = exception{ container $c, 'thing1', 'thing2' }; like( $exception, qr/^container\(\$object, \.\.\.\) is not supported/, 'exception begins with: container($object, ...) is not supported' ); $exception = exception{ container 'MyApp' => as { service 'service_name', 'thing1', 'thing2', 'trouble' } }; like( $exception, qr/^A service is defined by/, 'exception begins with: A service is defined by' ); { package MyNonService; use Moose; } $exception = exception{ container 'MyApp' => as { service 'service_name', 'service_class' => 'MyNonService', } }; like( $exception, qr/^The service class must do the Bread::Board::Service role/, 'exception begins with: The service class must do the Bread::Board::Service role' ); $exception = exception{ typemap ('Type') }; like( $exception, qr/^typemap takes a single argument/, "exception begins with: typemap takes a single argument" ); $exception = exception{ typemap ('Type', MyNonService->new) }; like( $exception, qr/isn't a service/, "exception contains: isn't a service" ); { my $parameterized_container = container 'Foo' => ['Bar'] => as { service foo => ( block => sub { shift->param('bar') }, dependencies => { bar => 'Bar/bar' }, ); }; is exception { container $parameterized_container => as { service moo => ( block => sub { shift->param('foo') }, dependencies => [depends_on('foo')], ); }; }, undef, 'contaner $parameterized_container => as {} succeeds'; is $parameterized_container->create(Bar => (container Bar => as { service bar => 42; }))->resolve(service => 'moo'), 42, 'container $parameterized_container => as {} modifies underlying container'; } { my $c = container Foo => as { container 'Bar'; }; isa_ok $c->fetch('Bar'), 'Bread::Board::Container'; } done_testing; 023_sugar.t100644001750000144 231512243443340 15037 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); } my $c = container 'MyApp' => as { service 'log_file' => "logfile.log"; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => [ depends_on('log_file'), ] ); service 'application' => ( class => 'MyApplication', dependencies => [ depends_on('logger'), ] ); }; my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); done_testing; 024_sugar.t100644001750000144 503612243443340 15043 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package DBI; use Moose; has 'dsn' => (is => 'ro', isa => 'Str'); has 'username' => (is => 'ro', isa => 'Str'); has 'password' => (is => 'ro', isa => 'Str'); sub connect { my ($class, $dsn, $username, $password) = @_; $class->new(dsn => $dsn, username => $username, password => $password); } package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); has 'dbh' => (is => 'ro', isa => 'DBI', required => 1); } my $c = container 'MyApp' => as { service 'log_file' => "logfile.log"; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => [ depends_on('log_file'), ] ); container 'Database' => as { service 'dsn' => "dbi:sqlite:dbname=my-app.db"; service 'username' => "user"; service 'password' => "pass"; service 'dbh' => ( block => sub { my $s = shift; DBI->connect( $s->param('dsn'), $s->param('username'), $s->param('password'), ) || die "Could not connect"; }, dependencies => wire_names(qw[dsn username password]) ); }; service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), dbh => depends_on('Database/dbh'), } ); }; my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $dbh = $c->resolve( service => 'Database/dbh' ); isa_ok($dbh, 'DBI'); is($dbh->dsn, "dbi:sqlite:dbname=my-app.db", '... got the right dsn'); is($dbh->username, "user", '... got the right username'); is($dbh->password, "pass", '... got the right password'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); isa_ok($app->dbh, 'DBI'); isnt($app->dbh, $dbh, '... got a different dbh'); done_testing; 300_no_new.t100644001750000144 15712243443340 15163 0ustar00doyusers000000000000Bread-Board-0.29/tuse strict; use warnings; use Test::More; use Bread::Board (); ok !Bread::Board->can("new"); done_testing; false.bb100644001750000144 312243443340 15222 0ustar00doyusers000000000000Bread-Board-0.29/t/lib0; 00-compile.t100644001750000144 343512243443340 15203 0ustar00doyusers000000000000Bread-Board-0.29/tuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.037 use Test::More tests => 23 + ($ENV{AUTHOR_TESTING} ? 1 : 0); my @module_files = ( 'Bread/Board.pm', 'Bread/Board/BlockInjection.pm', 'Bread/Board/ConstructorInjection.pm', 'Bread/Board/Container.pm', 'Bread/Board/Container/FromParameterized.pm', 'Bread/Board/Container/Parameterized.pm', 'Bread/Board/Dependency.pm', 'Bread/Board/Dumper.pm', 'Bread/Board/LifeCycle.pm', 'Bread/Board/LifeCycle/Singleton.pm', 'Bread/Board/LifeCycle/Singleton/WithParameters.pm', 'Bread/Board/Literal.pm', 'Bread/Board/Service.pm', 'Bread/Board/Service/Alias.pm', 'Bread/Board/Service/Deferred.pm', 'Bread/Board/Service/Deferred/Thunk.pm', 'Bread/Board/Service/Inferred.pm', 'Bread/Board/Service/WithClass.pm', 'Bread/Board/Service/WithDependencies.pm', 'Bread/Board/Service/WithParameters.pm', 'Bread/Board/SetterInjection.pm', 'Bread/Board/Traversable.pm', 'Bread/Board/Types.pm' ); # no fake home requested my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib'; use File::Spec; use IPC::Open3; use IO::Handle; my @warnings; for my $lib (@module_files) { # see L open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; 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') if $ENV{AUTHOR_TESTING}; logger.bb100644001750000144 34112243443340 15454 0ustar00doyusers000000000000Bread-Board-0.29/t/lib#!/usr/bin/perl use strict; use warnings; use Bread::Board; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => { log_file => depends_on('log_file'), } );my_app.bb100644001750000144 53512243443340 15467 0ustar00doyusers000000000000Bread-Board-0.29/t/lib#!/usr/bin/perl use strict; use warnings; use FindBin; use Bread::Board; container 'MyApp' => as { service 'log_file' => "logfile.log"; include "$FindBin::Bin/lib/logger.bb"; service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), } ); };release000755001750000144 012243443340 14614 5ustar00doyusers000000000000Bread-Board-0.29/xteol.t100644001750000144 24012243443340 15674 0ustar00doyusers000000000000Bread-Board-0.29/xt/releaseuse strict; use warnings; use Test::More; eval 'use Test::EOL'; plan skip_all => 'Test::EOL required' if $@; all_perl_files_ok({ trailing_whitespace => 1 }); 010_container.t100644001750000144 613012243443340 15673 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board::Container; use Bread::Board::ConstructorInjection; use Bread::Board::Literal; my $c = Bread::Board::Container->new(name => '/'); isa_ok($c, 'Bread::Board::Container'); $c->add_sub_container( Bread::Board::Container->new( name => 'Application', sub_containers => [ Bread::Board::Container->new( name => 'Model', services => [ Bread::Board::Literal->new(name => 'dsn', value => ''), Bread::Board::ConstructorInjection->new( name => 'schema', class => 'My::App::Schema', dependencies => { dsn => Bread::Board::Dependency->new(service_path => '../dsn'), user => Bread::Board::Literal->new(name => 'user', value => ''), pass => Bread::Board::Literal->new(name => 'pass', value => ''), }, ) ] ), Bread::Board::Container->new( name => 'View', services => [ Bread::Board::ConstructorInjection->new( name => 'TT', class => 'My::App::View::TT', dependencies => { tt_include_path => Bread::Board::Literal->new(name => 'include_path', value => []), }, ) ] ), Bread::Board::Container->new(name => 'Controller'), ] ) ); my $app = $c->get_sub_container('Application'); isa_ok($app, 'Bread::Board::Container'); is($app->name, 'Application', '... got the right container'); { my $controller = $app->get_sub_container('Controller'); isa_ok($controller, 'Bread::Board::Container'); is($controller->name, 'Controller', '... got the right container'); is($controller->parent, $app, '... app is the parent of the controller'); ok(!$controller->has_services, '... the controller has no services'); } { my $view = $app->get_sub_container('View'); isa_ok($view, 'Bread::Board::Container'); is($view->name, 'View', '... got the right container'); is($view->parent, $app, '... app is the parent of the view'); ok($view->has_services, '... the veiw has services'); my $service = $view->get_service('TT'); does_ok($service, 'Bread::Board::Service'); is($service->parent, $view, '... the parent of the service is the view'); } { my $model = $app->get_sub_container('Model'); isa_ok($model, 'Bread::Board::Container'); is($model->name, 'Model', '... got the right container'); is($model->parent, $app, '... app is the parent of the model'); ok($model->has_services, '... the model has services'); my $service = $model->get_service('schema'); does_ok($service, 'Bread::Board::Service'); is($service->parent, $model, '... the parent of the service is the model'); } done_testing; Bread000755001750000144 012243443340 14324 5ustar00doyusers000000000000Bread-Board-0.29/libBoard.pm100644001750000144 4440212243443340 16075 0ustar00doyusers000000000000Bread-Board-0.29/lib/Breadpackage Bread::Board; BEGIN { $Bread::Board::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::VERSION = '0.29'; } use strict; use warnings; use Carp qw(confess); use Scalar::Util qw(blessed); # ABSTRACT: A solderless way to wire up your application components use Bread::Board::Types; use Bread::Board::ConstructorInjection; use Bread::Board::SetterInjection; use Bread::Board::BlockInjection; use Bread::Board::Literal; use Bread::Board::Container; use Bread::Board::Container::Parameterized; use Bread::Board::Dependency; use Bread::Board::LifeCycle::Singleton; use Bread::Board::Service::Inferred; use Bread::Board::Service::Alias; use Moose::Exporter 1.00; Moose::Exporter->setup_import_methods( as_is => [qw[ as container depends_on service alias wire_names include typemap infer ]], ); sub as (&) { $_[0] } our $CC; our $in_container; sub set_root_container { confess "Can't set the root container when we're already in a container" if $in_container; $CC = shift; } sub container ($;$$) { my $name = shift; my $c; if (blessed $name) { confess 'an object used as a container must inherit from Bread::Board::Container or Bread::Board::Container::Parameterized' unless $name->isa('Bread::Board::Container') || $name->isa('Bread::Board::Container::Parameterized'); confess 'container($object, ...) is not supported for parameterized containers' if scalar @_ > 1; # this is basically: # container( A::Bread::Board::Container->new, ... ) # or someone using &container as a constructor $c = $name; # if we're in the context of another container # then we're a subcontainer of it $CC->add_sub_container($c) if defined $CC; } else { my $is_inheriting = $name =~ s/^\+//; confess "Inheriting containers isn't possible outside of the context of a container" if $is_inheriting && !defined $CC; # if we have more than 1 argument, then we are a parameterized # container, so we need to act accordingly if (scalar @_ > 1) { confess 'Declaring container parameters when inheriting is not supported' if $is_inheriting; my $param_names = shift; $c = Bread::Board::Container::Parameterized->new({ name => $name, allowed_parameter_names => $param_names, }); } else { $c = $is_inheriting ? $CC->fetch($name) : Bread::Board::Container->new({ name => $name }); } # if we're in the context of another container # then we're a subcontainer of it, unless we're inheriting, # in which case we already got a parent $CC->add_sub_container($c) if !$is_inheriting && defined $CC; } my $body = shift; # if we have more arguments # then they are likely a body # and so we should execute it if (defined $body) { local $_ = $c; local $CC = $c; local $in_container = 1; $body->($c); } return $c; } sub include ($) { my $file = shift; if (my $ret = do $file) { return $ret; } else { confess "Couldn't compile $file: $@" if $@; confess "Couldn't open $file for reading: $!" if $!; confess "Unknown error when compiling $file " . "(or $file doesn't return a true value)"; } } sub service ($@) { my $name = shift; my $s; my $is_inheriting = ($name =~ s/^\+//); if (scalar @_ == 1) { confess "Service inheritance doesn't make sense for literal services" if $is_inheriting; $s = Bread::Board::Literal->new(name => $name, value => $_[0]); } elsif (scalar(@_) % 2 == 0) { my %params = @_; my $class = $params{service_class}; $class ||= defined $params{service_type} ? "Bread::Board::$params{service_type}Injection" : exists $params{block} ? 'Bread::Board::BlockInjection' : 'Bread::Board::ConstructorInjection'; $class->does('Bread::Board::Service') or confess "The service class must do the Bread::Board::Service role"; if ($is_inheriting) { confess "Inheriting services isn't possible outside of the context of a container" unless defined $CC; my $container = ($CC->isa('Bread::Board::Container::Parameterized') ? $CC->container : $CC); my $prototype_service = $container->fetch($name); confess sprintf( "Trying to inherit from service '%s', but found a %s", $name, blessed $prototype_service, ) unless $prototype_service->does('Bread::Board::Service'); $s = $prototype_service->clone_and_inherit_params( service_class => $class, %params, ); } else { $s = $class->new(name => $name, %params); } } else { confess "A service is defined by a name and either a single value or hash of parameters; you have supplied neither"; } return $s unless defined $CC; $CC->add_service($s); } sub alias ($$@) { my $name = shift; my $path = shift; my %params = @_; my $s = Bread::Board::Service::Alias->new( name => $name, aliased_from_path => $path, %params, ); return $s unless defined $CC; $CC->add_service($s); } sub typemap ($@) { my $type = shift; (scalar @_ == 1) || confess "typemap takes a single argument"; my $service; if (blessed $_[0]) { if ($_[0]->does('Bread::Board::Service')) { $service = $_[0]; } elsif ($_[0]->isa('Bread::Board::Service::Inferred')) { $service = $_[0]->infer_service( $type ); } else { confess $_[0] . " isn't a service"; } } else { $service = $CC->fetch( $_[0] ); } $CC->add_type_mapping_for( $type, $service ); } sub infer { if (@_ == 1) { return Bread::Board::Service::Inferred->new( current_container => $CC, service => $_[0], infer_params => 1, ); } else { my %params = @_; return Bread::Board::Service::Inferred->new( current_container => $CC, service_args => \%params, infer_params => 1, ); } } sub wire_names { +{ map { $_ => depends_on($_) } @_ }; } sub depends_on ($) { my $path = shift; Bread::Board::Dependency->new(service_path => $path); } 1; __END__ =pod =head1 NAME Bread::Board - A solderless way to wire up your application components =head1 VERSION version 0.29 =head1 SYNOPSIS use Bread::Board; my $c = container 'MyApp' => as { service 'log_file_name' => "logfile.log"; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => [ depends_on('log_file_name'), ] ); container 'Database' => as { service 'dsn' => "dbi:SQLite:dbname=my-app.db"; service 'username' => "user234"; service 'password' => "****"; service 'dbh' => ( block => sub { my $s = shift; require DBI; DBI->connect( $s->param('dsn'), $s->param('username'), $s->param('password'), ) || die "Could not connect"; }, dependencies => wire_names(qw[dsn username password]) ); }; service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), dbh => depends_on('Database/dbh'), } ); }; no Bread::Board; # removes keywords # get an instance of MyApplication # from the container my $app = $c->resolve( service => 'application' ); # now user your MyApplication # as you normally would ... $app->run; =head1 DESCRIPTION Bread::Board is an inversion of control framework with a focus on dependency injection and lifecycle management. It's goal is to help you write more decoupled objects and components by removing the need for you to manually wire those objects/components together. Want to know more? See the L. +-----------------------------------------+ | A B C D E F G H I J | |-----------------------------------------| | o o | 1 o-o-o-o-o v o-o-o-o-o 1 | o o | | o o | 2 o-o-o-o-o o-o-o-o-o 2 | o o | | o o | 3 o-o-o-o-o o-o-o-o-o 3 | o o | | o o | 4 o-o-o-o-o o-o-o-o-o 4 | o o | | o o | 5 o-o-o-o-o o-o-o-o-o 5 | o o | | | 6 o-o-o-o-o o-o-o-o-o 6 | | | o o | 7 o-o-o-o-o o-o-o-o-o 7 | o o | | o o | 8 o-o-o-o-o o-o-o-o-o 8 | o o | | o o | 9 o-o-o-o-o o-o-o-o-o 9 | o o | | o o | 10 o-o-o-o-o o-o-o-o-o 10 | o o | | o o | 11 o-o-o-o-o o-o-o-o-o 11 | o o | | | 12 o-o-o-o-o o-o-o-o-o 12 | | | o o | 13 o-o-o-o-o o-o-o-o-o 13 | o o | | o o | 14 o-o-o-o-o o-o-o-o-o 14 | o o | | o o | 15 o-o-o-o-o o-o-o-o-o 15 | o o | | o o | 16 o-o-o-o-o o-o-o-o-o 16 | o o | | o o | 17 o-o-o-o-o o-o-o-o-o 17 | o o | | | 18 o-o-o-o-o o-o-o-o-o 18 | | | o o | 19 o-o-o-o-o o-o-o-o-o 19 | o o | | o o | 20 o-o-o-o-o o-o-o-o-o 20 | o o | | o o | 21 o-o-o-o-o o-o-o-o-o 21 | o o | | o o | 22 o-o-o-o-o o-o-o-o-o 22 | o o | | o o | 22 o-o-o-o-o o-o-o-o-o 22 | o o | | | 23 o-o-o-o-o o-o-o-o-o 23 | | | o o | 24 o-o-o-o-o o-o-o-o-o 24 | o o | | o o | 25 o-o-o-o-o o-o-o-o-o 25 | o o | | o o | 26 o-o-o-o-o o-o-o-o-o 26 | o o | | o o | 27 o-o-o-o-o o-o-o-o-o 27 | o o | | o o | 28 o-o-o-o-o ^ o-o-o-o-o 28 | o o | +-----------------------------------------+ Loading this package will automatically load the rest of the packages needed by your Bread::Board configuration. =head1 EXPORTED FUNCTIONS The functions of this package provide syntactic sugar to help you build your Bread::Board configuration. You can build such a configuration by constructing the objects manually instead, but your code may be more difficult to understand. =over 4 =item I This function constructs and returns an instance of L. The (optional) C<&body> block may be used to add services or sub-containers within the newly constructed container. Usually, the block is not passed directly, but passed using the C function. For example, container 'MyWebApp' => as { service my_dispatcher => ( class => 'MyWebApp::Dispatcher', ); }; If C<$name> starts with C<'+'>, and the container is being declared inside another container, then this declaration will instead extend an existing container with the name C<$name> (without the C<'+'>). =item I In many cases, subclassing L is the easiest route to getting access to this framework. You can do this and still get all the benefits of the syntactic sugar for configuring that class by passing an instance of your container subclass to C. You could, for example, configure your container inside the C method of your class: package MyWebApp; use Moose; extends 'Bread::Board::Container'; sub BUILD { my $self = shift; container $self => as { service dbh => ( ... ); }; } =item I A third way of using the C function is to build a parameterized container. These are useful as a way of providing a placeholder for parts of the configuration that may be provided later. You may not use an instance object in place of the C<$name> in this case. For more detail on how you might use parameterized containers, see L. =item I This is just a replacement for the C keyword that is easier to read when defining containers. =item I Within the C blocks for your containers, you may construct services using the C function. This can construct several different kinds of services based upon how it is called. To build a literal service (a L object), just specify a scalar value or reference you want to use as the literal value: # In case you need to adjust the gravitational constant of the Universe service gravitational_constant => 6.673E-11; To build a service using one of the injection services, just fill in all the details required to use that sort of injection: service search_service => ( class => 'MyApp::Search', block => sub { my $s = shift; MyApp::Search->new($s->param('url'), $s->param('type')); }, dependencies => { url => 'search_url', }, parameters => { type => { isa => 'Str', default => 'text' }, }, ); The type of injection performed depends on the parameters used. You may use the C parameter to pick a specific injector class. For instance, this is useful if you need to use L or have defined a custom injection service. If you specify a C, block injection will be performed using L. If neither of these is present, constructor injection will be used with L (and you must provide the C option). If the C<$name> starts with a C<'+'>, the service definition will instead extend an existing service with the given C<$name> (without the C<'+'>). This works similarly to the C syntax in Moose. It is most useful when defining a container class where the container is built up in C methods, as each class in the inheritance hierarchy can modify services defined in superclasses. The C and C options will be merged with the existing values, rather than overridden. Note that literal services can't be extended, because there's nothing to extend. You can still override them entirely by declaring the service name without a leading C<'+'>. =item I The C function creates a L object for the named C<$service_path> and returns it. =item I This function is just a shortcut for passing a hash reference of dependencies into the service. service foo => ( class => "Pity::TheFoo', dependencies => wire_names(qw( foo bar baz )), ); The above is identical to: service foo => ( class => 'Pity::TheFoo', dependencies => { foo => depends_on('foo'), bar => depends_on('bar'), baz => depends_on('baz'), }, ); =item I This creates a type mapping for the named type. Typically, it is paired with the C call like so: typemap 'MyApp::Model::UserAccount' => infer; For more details on what type mapping is and how it works, see L. =item I This is used with C to help create the typemap inference. It can be used with no arguments to do everything automatically. However, in some cases, you may want to pass a service instance as the argument or a hash of service arguments to change how the type map works. For example, if your type needs to be constructed using a setter injection, you can use an inference similar to this: typemap 'MyApp::Model::UserPassword' => infer( service_class => 'Bread::Board::SetterInjection', ); For more details on what type mapping is and how it works, see L. =item I This is a shortcut for loading a Bread::Board configuration from another file. include "filename.pl"; The above is pretty much identical to running: do "filename.pl"; However, you might find it more readable to use C. =item I This helper allows for the creation of service aliases, which allows you to define a service in one place and then reuse that service with a different name somewhere else. This is sort of like a symbolic link for services. Aliases will be resolved recursively, so an alias can alias an alias. For example, service file_logger => ( class => 'MyApp::Logger::File', ); alias my_logger => 'file_logger'; =back =head1 OTHER FUNCTIONS These are not exported, but might be helpful to you. =over 4 =item I You may use this to set a top-level root container for all container definitions. For example, my $app = container MyApp => as { ... }; Bread::Board::set_root_container($app); my $config = container Config => as { ... }; Here the C<$config> container would be created as a sub-container of C<$app>. =back =head1 ACKNOWLEDGEMENTS Thanks to Daisuke Maki for his contributions and for really pushing the development of this module along. Chuck "sprongie" Adams, for testing/using early (pre-release) versions of this module, and some good suggestions for naming it. Matt "mst" Trout, for finally coming up with the best name for this module. =head1 ARTICLES L Thomas Klausner showing a use-case for Bread::Board. =head1 SEE ALSO =over 4 =item L This provides more powerful syntax for writing Bread::Board container classes. =item L Bread::Board is basically my re-write of IOC. =item L =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to Github Issues. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 026_sugar_remove.t100644001750000144 235112243443340 16417 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; is(exception { container 'MyApp' => sub { "dummy" } }, undef); is(exception { as { "Dummy" } }, undef); is(exception { container 'MyApp' => as { service 'service1' => 'foo' }; }, undef); is(exception { container 'MyApp' => as { service 'service1' => 'foo'; service 'service2' => ( block => sub { "dummy" }, dependencies => wire_names 'service1' ); } }, undef); is(exception { container 'MyApp' => as { service 'service1' => 'foo'; service 'service2' => ( block => sub { "dummy" }, dependencies => { service1 => depends_on 'service1' } ); } }, undef); no Bread::Board; like(exception { container() }, qr/^Undefined subroutine &main::container called/); like(exception { as() }, qr/^Undefined subroutine &main::as called/); like(exception { service() }, qr/^Undefined subroutine &main::service called/); like(exception { depends_on() }, qr/^Undefined subroutine &main::depends_on called/); like(exception { wire_names() }, qr/^Undefined subroutine &main::wire_names called/); done_testing; 200_example_code.t100644001750000144 471312243443340 16344 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; use Bread::Board::Types; # roles use Bread::Board::Service; use Bread::Board::Service::WithClass; use Bread::Board::Service::WithDependencies; use Bread::Board::Service::WithParameters; # services use Bread::Board::ConstructorInjection; use Bread::Board::SetterInjection; use Bread::Board::BlockInjection; use Bread::Board::Literal; use Bread::Board::Container; use Bread::Board::Dependency; use Bread::Board::Traversable; use Bread::Board::LifeCycle::Singleton; { package MyLogger; use Moose; package MyDBI; use Moose; has 'dsn' => (is => 'ro', isa => 'Str'); has 'username' => (is => 'ro', isa => 'Str'); has 'password' => (is => 'ro', isa => 'Str'); sub connect { my ($class, $dsn, $username, $password) = @_; $class->new(dsn => $dsn, username => $username, password => $password); } package MyAuthenticator; use Moose; has 'dbh' => (is => 'ro', isa => 'MyDBI', required => 1); has 'logger' => (is => 'ro', isa => 'MyLogger', required => 1); } my $c; is(exception { $c = Bread::Board::Container->new( name => 'Application' ); $c->add_service( Bread::Board::BlockInjection->new( name => 'logger', block => sub { MyLogger->new() } ) ); $c->add_service( Bread::Board::BlockInjection->new( name => 'db_conn', block => sub { MyDBI->connect('dbi:mysql:test', '', '') } ) ); $c->add_service( Bread::Board::BlockInjection->new( name => 'authenticator', block => sub { my $service = shift; MyAuthenticator->new( dbh => $service->param('db_conn'), logger => $service->param('logger') ); }, dependencies => { db_conn => Bread::Board::Dependency->new(service_path => 'db_conn'), logger => Bread::Board::Dependency->new(service_path => 'logger'), } ) ); }, undef, '... container compiled successfully'); my $authenticator; is(exception { $authenticator = $c->resolve( service => 'authenticator' ) }, undef, '... and the container compiled correctly'); isa_ok($authenticator, 'MyAuthenticator'); isa_ok($authenticator->dbh, 'MyDBI'); isa_ok($authenticator->logger, 'MyLogger'); done_testing; no-tabs.t100644001750000144 272712243443340 16514 0ustar00doyusers000000000000Bread-Board-0.29/xt/releaseuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::NoTabsTests 0.05 use Test::More 0.88; use Test::NoTabs; my @files = ( 'lib/Bread/Board.pm', 'lib/Bread/Board/BlockInjection.pm', 'lib/Bread/Board/ConstructorInjection.pm', 'lib/Bread/Board/Container.pm', 'lib/Bread/Board/Container/FromParameterized.pm', 'lib/Bread/Board/Container/Parameterized.pm', 'lib/Bread/Board/Dependency.pm', 'lib/Bread/Board/Dumper.pm', 'lib/Bread/Board/LifeCycle.pm', 'lib/Bread/Board/LifeCycle/Singleton.pm', 'lib/Bread/Board/LifeCycle/Singleton/WithParameters.pm', 'lib/Bread/Board/Literal.pm', 'lib/Bread/Board/Manual.pod', 'lib/Bread/Board/Manual/Concepts.pod', 'lib/Bread/Board/Manual/Concepts/Advanced.pod', 'lib/Bread/Board/Manual/Concepts/Typemap.pod', 'lib/Bread/Board/Manual/Example.pod', 'lib/Bread/Board/Manual/Example/FormSensible.pod', 'lib/Bread/Board/Manual/Example/LogDispatch.pod', 'lib/Bread/Board/Service.pm', 'lib/Bread/Board/Service/Alias.pm', 'lib/Bread/Board/Service/Deferred.pm', 'lib/Bread/Board/Service/Deferred/Thunk.pm', 'lib/Bread/Board/Service/Inferred.pm', 'lib/Bread/Board/Service/WithClass.pm', 'lib/Bread/Board/Service/WithDependencies.pm', 'lib/Bread/Board/Service/WithParameters.pm', 'lib/Bread/Board/SetterInjection.pm', 'lib/Bread/Board/Traversable.pm', 'lib/Bread/Board/Types.pm' ); notabs_ok($_) foreach @files; done_testing; 011_container_path.t100644001750000144 465212243443340 16717 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board::Container; use Bread::Board::ConstructorInjection; use Bread::Board::Literal; my $c = Bread::Board::Container->new( name => 'Application', sub_containers => [ Bread::Board::Container->new( name => 'Model', services => [ Bread::Board::Literal->new(name => 'dsn', value => ''), Bread::Board::ConstructorInjection->new( name => 'schema', class => 'My::App::Schema', dependencies => { dsn => Bread::Board::Dependency->new(service_path => 'dsn'), user => Bread::Board::Literal->new(name => 'user', value => ''), pass => Bread::Board::Literal->new(name => 'pass', value => ''), }, ) ] ), Bread::Board::Container->new( name => 'View', services => [ Bread::Board::ConstructorInjection->new( name => 'TT', class => 'My::App::View::TT', dependencies => { tt_include_path => Bread::Board::Literal->new(name => 'include_path', value => []), }, ) ] ), Bread::Board::Container->new(name => 'Controller'), ] ); #use Bread::Board::Dumper; #diag(Bread::Board::Dumper->new->dump($c)); my $model = $c->fetch('Model'); isa_ok($model, 'Bread::Board::Container'); is($model->name, 'Model', '... got the right model'); { my $model2 = $c->fetch('/Model'); isa_ok($model2, 'Bread::Board::Container'); is($model, $model2, '... they are the same thing'); } my $dsn = $model->fetch('schema/dsn'); isa_ok($dsn, 'Bread::Board::Dependency'); is($dsn->service_path, 'dsn', '... got the right name'); { my $dsn2 = $c->fetch('/Model/schema/dsn'); isa_ok($dsn2, 'Bread::Board::Dependency'); is($dsn, $dsn2, '... they are the same thing'); } my $root = $model->fetch('../'); isa_ok($root, 'Bread::Board::Container'); is($root, $c, '... got the same container'); is($model, $model->fetch('../Model'), '... navigated back to myself'); is($dsn, $model->fetch('../Model/schema/dsn'), '... navigated to dsn'); is($model, $dsn->fetch('../Model'), '... got the model from the dsn'); done_testing; 060_extend_w_sugar.t100644001750000144 515412243443340 16741 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); } { package My::App; use Moose; use Bread::Board; extends 'Bread::Board::Container'; has 'log_file_name' => ( is => 'ro', isa => 'Str', default => 'logfile.log', ); sub BUILD { my $self = shift; container $self => as { service 'log_file' => $self->log_file_name; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => { log_file => depends_on('log_file'), } ); service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), } ); }; } } my $c1 = My::App->new( name => 'MyApp1' ); isa_ok($c1, 'My::App'); isa_ok($c1, 'Bread::Board::Container'); my $c2 = My::App->new( name => 'MyApp2', log_file_name => 'another_logfile.log' ); isa_ok($c2, 'My::App'); isa_ok($c2, 'Bread::Board::Container'); # test the first one my $logger1 = $c1->resolve( service => 'logger' ); isa_ok($logger1, 'FileLogger'); is($logger1->log_file, 'logfile.log', '... got the right logfile dep'); is($c1->fetch('logger/log_file')->service, $c1->fetch('log_file'), '... got the right value'); is($c1->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $app1 = $c1->resolve( service => 'application' ); isa_ok($app1, 'MyApplication'); isa_ok($app1->logger, 'FileLogger'); is($app1->logger, $logger1, '... got the right logger (singleton)'); # test the second one my $logger2 = $c2->resolve( service => 'logger' ); isa_ok($logger2, 'FileLogger'); is($logger2->log_file, 'another_logfile.log', '... got the right logfile dep'); is($c2->fetch('logger/log_file')->service, $c2->fetch('log_file'), '... got the right value'); is($c2->fetch('logger/log_file')->get, 'another_logfile.log', '... got the right value'); my $app2 = $c2->resolve( service => 'application' ); isa_ok($app2, 'MyApplication'); isa_ok($app2->logger, 'FileLogger'); is($app2->logger, $logger2, '... got the right logger (singleton)'); # make sure they share nothing isnt( $logger1, $logger2, '... these are not the same' ); isnt( $app1, $app2, '... these are not the same' ); done_testing; 027_sugar_w_include.t100644001750000144 324712243443340 17101 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use FindBin; use Test::More; use Test::Fatal; use Bread::Board; like(exception { local $SIG{__WARN__} = sub { }; include "$FindBin::Bin/lib/bad.bb" }, qr/Couldn't compile.*bad\.bb.*syntax error.*function_doesnt_exist/, "we get appropriate errors for invalid files"); like(exception { include "$FindBin::Bin/lib/doesnt_exist.bb" }, qr/Couldn't open.*doesnt_exist\.bb.*for reading/, "we get appropriate errors for files that don't exist"); like(exception { include "$FindBin::Bin/lib/false.bb" }, qr/false\.bb.*doesn't return a true value/, "we get appropriate errors for files that evaluate to false"); { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); } my $c = container 'MyApp' => as { service 'log_file' => "logfile.log"; include "$FindBin::Bin/lib/logger.bb"; service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), } ); }; my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); done_testing; 003_block_injection.t100644001750000144 540712243443340 17055 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Test::Fatal; use Bread::Board::BlockInjection; use Bread::Board::SetterInjection; use Bread::Board::Literal; { package Needle; use Moose; package Mexican::Black::Tar; use Moose; package Addict; use Moose; has 'needle' => (is => 'rw'); has 'spoon' => (is => 'rw'); has 'stash' => (is => 'rw'); } my $s = Bread::Board::BlockInjection->new( name => 'William', class => 'Addict', block => sub { my $s = shift; $s->class->new(%{ $s->params }); }, dependencies => { needle => Bread::Board::SetterInjection->new(name => 'spike', class => 'Needle'), spoon => Bread::Board::Literal->new(name => 'works', value => 'Spoon!'), }, parameters => { stash => { isa => 'Mexican::Black::Tar' } } ); isa_ok($s, 'Bread::Board::BlockInjection'); does_ok($s, 'Bread::Board::Service::WithDependencies'); does_ok($s, 'Bread::Board::Service::WithParameters'); does_ok($s, 'Bread::Board::Service'); { my $i = $s->get(stash => Mexican::Black::Tar->new); isa_ok($i, 'Addict'); isa_ok($i->needle, 'Needle'); is($i->spoon, 'Spoon!', '... got our literal service'); isa_ok($i->stash, 'Mexican::Black::Tar'); { my $i2 = $s->get(stash => Mexican::Black::Tar->new); isnt($i, $i2, '... calling it again returns an new object'); } } is($s->name, 'William', '... got the right name'); is($s->class, 'Addict', '... got the right class'); my $deps = $s->dependencies; is_deeply([ sort keys %$deps ], [qw/needle spoon/], '... got the right dependency keys'); my $needle = $s->get_dependency('needle'); isa_ok($needle, 'Bread::Board::Dependency'); isa_ok($needle->service, 'Bread::Board::SetterInjection'); is($needle->service->name, 'spike', '... got the right name'); is($needle->service->class, 'Needle', '... got the right class'); my $spoon = $s->get_dependency('spoon'); isa_ok($spoon, 'Bread::Board::Dependency'); isa_ok($spoon->service, 'Bread::Board::Literal'); is($spoon->service->name, 'works', '... got the right name'); is($spoon->service->value, 'Spoon!', '... got the right literal value'); my $params = $s->parameters; is_deeply([ sort keys %$params ], [qw/stash/], '... got the right paramter keys'); is_deeply($params->{stash}, { isa => 'Mexican::Black::Tar' }, '... got the right parameter spec'); ## check some errors isnt(exception { $s->get; }, undef, '... you must supply the required parameters'); isnt(exception { $s->get(stash => []); }, undef, '... you must supply the required parameters as correct types'); isnt(exception { $s->get(stash => Mexican::Black::Tar->new, foo => 10); }, undef, '... you must supply the required parameters (and no more)'); done_testing; 043_parameter_leaks.t100644001750000144 171512243443340 17062 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; { package Foo; use Moose; has 'bar' => (is => 'ro', isa => 'Bar', required => 1); package Bar; use Moose; our $BAR_DEMOLISH_COUNT = 0; sub DESTROY { $BAR_DEMOLISH_COUNT++; } } my $c = container 'MyApp' => as { service 'foo' => ( class => 'Foo', parameters => { bar => { isa => 'Bar' } } ); }; { my $bar = Bar->new; { my $foo; is(exception { $foo = $c->resolve( service => 'foo', parameters => { bar => $bar } ); }, undef, '... got the service correctly'); isa_ok($foo, 'Foo'); is($foo->bar, $bar, '... got the right parameter value'); } is($Bar::BAR_DEMOLISH_COUNT, 0, '... it should be one'); # $bar should be demolished here ... } is($Bar::BAR_DEMOLISH_COUNT, 1, '... it should be one'); done_testing; 032_singleton_cycle.t100644001750000144 162312243443340 17100 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/env perl use strict; use Test::More; use Bread::Board; my $seen; { package Bot; use Moose; has plugin => ( isa => 'Plugin', is => 'ro', required => 1 ); } { package Plugin; use Moose; has bot => ( isa => 'Bot', is => 'ro', weak_ref => 1, required => 1 ); } my $c = container 'Config' => as { service plugin => ( class => 'Plugin', lifecycle => 'Singleton', dependencies => ['bot'], ); service bot => ( class => 'Bot', block => sub { my ($s) = @_; $seen++; Bot->new(plugin => $s->param('plugin')); }, lifecycle => 'Singleton', dependencies => ['plugin'], ); }; ok($c->resolve(service => 'bot')); is($seen, 1, 'seen only once'); done_testing; pod-syntax.t100644001750000144 21212243443340 17222 0ustar00doyusers000000000000Bread-Board-0.29/xt/release#!perl use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); Board000755001750000144 012243443340 15353 5ustar00doyusers000000000000Bread-Board-0.29/lib/BreadTypes.pm100644001750000144 1011412243443340 17172 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::Types; BEGIN { $Bread::Board::Types::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Types::VERSION = '0.29'; } use Moose::Util::TypeConstraints; use Scalar::Util qw(blessed); use Bread::Board::Service; use Bread::Board::Dependency; ## for Bread::Board::Container class_type 'Bread::Board::Container'; class_type 'Bread::Board::Container::Parameterized'; subtype 'Bread::Board::Container::SubContainerList' => as 'HashRef[Bread::Board::Container|Bread::Board::Container::Parameterized]'; coerce 'Bread::Board::Container::SubContainerList' => from 'ArrayRef[Bread::Board::Container]' => via { +{ map { $_->name => $_ } @$_ } }; subtype 'Bread::Board::Container::ServiceList' => as 'HashRef[Bread::Board::Service]'; coerce 'Bread::Board::Container::ServiceList' => from 'ArrayRef[Bread::Board::Service]' => via { +{ map { $_->name => $_ } @$_ } }; ## for Bread::Board::Service::WithDependencies ... subtype 'Bread::Board::Service::Dependencies' => as 'HashRef[Bread::Board::Dependency]'; coerce 'Bread::Board::Service::Dependencies' => from 'HashRef[Bread::Board::Service | Bread::Board::Dependency | Str | HashRef]' => via { +{ map { my $dep = $_[0]->{$_}; if (!blessed($dep)) { if (ref $dep) { my ($service_path) = keys %$dep; my ($service_params) = values %$dep; $dep = Bread::Board::Dependency->new( service_path => $service_path, service_params => $service_params ); } else { $dep = Bread::Board::Dependency->new(service_path => $dep); } } ($_ => ($dep->isa('Bread::Board::Dependency') ? $dep : Bread::Board::Dependency->new(service => $dep))) } keys %{$_[0]} } } => from 'ArrayRef[Bread::Board::Service | Bread::Board::Dependency | Str | HashRef]' => via { # auto-wire the dependencies with # the service name if we get them # as an array +{ map { my $dep = $_; if (!blessed($dep)) { if (ref $dep) { my ($service_path) = keys %$dep; my ($service_params) = values %$dep; $dep = Bread::Board::Dependency->new( service_path => $service_path, service_params => $service_params ); } else { $dep = Bread::Board::Dependency->new(service_path => $dep); } } ($dep->isa('Bread::Board::Dependency') ? ($dep->service_name => $dep) : ($dep->name => Bread::Board::Dependency->new(service => $dep))) } @{$_[0]} } }; ## for Bread::Board::Service::WithParameters ... subtype 'Bread::Board::Service::Parameters' => as 'HashRef'; coerce 'Bread::Board::Service::Parameters' => from 'ArrayRef' => via { +{ map { $_ => { optional => 0 } } @$_ } }; no Moose::Util::TypeConstraints; 1; __END__ =pod =head1 NAME Bread::Board::Types =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 080_infer_subclasses.t100644001750000144 235512243443340 17257 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/env perl use strict; use warnings; use Test::More; use Bread::Board; { package NonMoose; sub new { bless { data => $_[0] }, shift } } { package Foo; use Moose; has non_moose => ( is => 'ro', isa => 'NonMoose', required => 1, ); } { package Bar; use Moose; has foo => ( is => 'ro', isa => 'Foo', required => 1, ); } { my $c = container Stuff => as { service non_moose => NonMoose->new("foo"); service foo => ( class => 'Foo', dependencies => ['non_moose'], ); typemap 'Foo' => 'foo'; typemap 'Bar' => infer; }; my $bar = $c->resolve(type => 'Bar'); isa_ok($bar->foo->non_moose, 'NonMoose'); } { package Foo::Sub; use Moose; extends 'Foo'; } { my $c = container Stuff => as { service non_moose => NonMoose->new("foo"); service foo => ( class => 'Foo::Sub', dependencies => ['non_moose'], ); typemap 'Foo::Sub' => 'foo'; typemap 'Bar' => infer; }; my $bar = $c->resolve(type => 'Bar'); isa_ok($bar->foo->non_moose, 'NonMoose'); } done_testing; 002_setter_injection.t100644001750000144 527112243443340 17267 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Test::Fatal; use Bread::Board::SetterInjection; use Bread::Board::Literal; { package Needle; use Moose; package Mexican::Black::Tar; use Moose; package Addict; use Moose; has 'needle' => (is => 'rw'); has 'spoon' => (is => 'rw'); has 'stash' => (is => 'rw'); } my $s = Bread::Board::SetterInjection->new( name => 'William', class => 'Addict', dependencies => { needle => Bread::Board::SetterInjection->new(name => 'spike', class => 'Needle'), spoon => Bread::Board::Literal->new(name => 'works', value => 'Spoon!'), }, parameters => { stash => { isa => 'Mexican::Black::Tar' } } ); isa_ok($s, 'Bread::Board::SetterInjection'); does_ok($s, 'Bread::Board::Service::WithClass'); does_ok($s, 'Bread::Board::Service::WithDependencies'); does_ok($s, 'Bread::Board::Service::WithParameters'); does_ok($s, 'Bread::Board::Service'); { my $i = $s->get(stash => Mexican::Black::Tar->new); isa_ok($i, 'Addict'); isa_ok($i->needle, 'Needle'); is($i->spoon, 'Spoon!', '... got our literal service'); isa_ok($i->stash, 'Mexican::Black::Tar'); { my $i2 = $s->get(stash => Mexican::Black::Tar->new); isnt($i, $i2, '... calling it again returns an new object'); } } is($s->name, 'William', '... got the right name'); is($s->class, 'Addict', '... got the right class'); my $deps = $s->dependencies; is_deeply([ sort keys %$deps ], [qw/needle spoon/], '... got the right dependency keys'); my $needle = $s->get_dependency('needle'); isa_ok($needle, 'Bread::Board::Dependency'); isa_ok($needle->service, 'Bread::Board::SetterInjection'); is($needle->service->name, 'spike', '... got the right name'); is($needle->service->class, 'Needle', '... got the right class'); my $spoon = $s->get_dependency('spoon'); isa_ok($spoon, 'Bread::Board::Dependency'); isa_ok($spoon->service, 'Bread::Board::Literal'); is($spoon->service->name, 'works', '... got the right name'); is($spoon->service->value, 'Spoon!', '... got the right literal value'); my $params = $s->parameters; is_deeply([ sort keys %$params ], [qw/stash/], '... got the right paramter keys'); is_deeply($params->{stash}, { isa => 'Mexican::Black::Tar' }, '... got the right parameter spec'); ## some errors isnt(exception { $s->get }, undef, '... you must supply the required parameters'); isnt(exception { $s->get(stash => []) }, undef, '... you must supply the required parameters as correct types'); isnt(exception { $s->get(stash => Mexican::Black::Tar->new, foo => 10) }, undef, '... you must supply the required parameters (and no more)'); done_testing; Dumper.pm100644001750000144 444412243443340 17313 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::Dumper; BEGIN { $Bread::Board::Dumper::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Dumper::VERSION = '0.29'; } use Moose; sub dump { my ($self, $thing, $indent) = @_; $indent = defined $indent ? $indent . ' ' : ''; my $output = ''; if ($thing->isa('Bread::Board::Dependency')) { $output .= join('', $indent, "depends_on: ", $thing->service_path || $thing->service->name, "\n"); } elsif ($thing->does('Bread::Board::Service')) { $output .= join('', $indent, "service: ", $thing->name, "\n" ); if ($thing->does('Bread::Board::Service::WithDependencies')) { while (my($key, $value) = each %{ $thing->dependencies }) { $output .= $self->dump($value, $indent); } } } elsif ($thing->isa('Bread::Board::Container')) { $output = join('', $indent, "container: ", $thing->name, "\n" ); my ($key, $value); while (($key, $value) = each %{ $thing->sub_containers }) { $output .= $self->dump($value, $indent); } while (($key, $value) = each %{ $thing->services }) { $output .= $self->dump($value, $indent); } } return $output; } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::Dumper =head1 VERSION version 0.29 =head1 SYNOPSIS use Bread::Board::Dumper; print Bread::Board::Dumper->new->dump($container); # container: Application # container: Controller # container: View # service: TT # depends_on: include_path # container: Model # service: dsn # service: schema # depends_on: pass # depends_on: ../dsn # depends_on: user =head1 DESCRIPTION This is a useful utility for dumping a clean view of a Bread::Board container. =head1 AUTHOR (actual) Daisuke Maki =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 110_clone_w_singleton.t100644001750000144 357512243443340 17434 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr); use Bread::Board; { package Test::Class; use Moose; has 'dep' => ( is => 'ro', isa => 'Int' ); } my $board = Bread::Board::Container->new( name => 'app' ); isa_ok($board, 'Bread::Board::Container'); $board->add_service( Bread::Board::ConstructorInjection->new( lifecycle => 'Singleton', name => 'test', class => 'Test::Class', dependencies => { dep => Bread::Board::Dependency->new(service_path => '/dep'), }, ) ); ok($board->has_service('test'), '... got the test service'); isa_ok($board->get_service('test'), 'Bread::Board::ConstructorInjection'); $board->add_service( Bread::Board::Literal->new(name => 'dep', value => 1) ); ok($board->has_service('dep'), '... got the dep service'); isa_ok($board->get_service('dep'), 'Bread::Board::Literal'); ## check the singleton-ness is($board->fetch('/test')->get, $board->fetch('/test')->get, '... got the singleton'); # clone ... my $board2 = $board->clone; isa_ok($board2, 'Bread::Board::Container'); isnt($board, $board2, '... they are not the same instance'); ok($board2->has_service('test'), '... got the test service'); isa_ok($board2->get_service('test'), 'Bread::Board::ConstructorInjection'); ok($board2->has_service('dep'), '... got the dep service'); isa_ok($board2->get_service('dep'), 'Bread::Board::Literal'); isnt($board->get_service('test'), $board2->get_service('test'), '... not the same test services'); isnt($board->get_service('dep'), $board2->get_service('dep'), '... not the same dep services'); ## check the singleton-ness is($board2->fetch('/test')->get, $board2->fetch('/test')->get, '... got the singleton'); ## check the singleton-less-ness isnt($board->fetch('/test')->get, $board2->fetch('/test')->get, '... singleton are not shared'); done_testing; 079_depending_on_type.t100644001750000144 144312243443340 17424 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Bread::Board; { package Stapler; use Moose; package Desk; use Moose; has 'stapler' => ( is => 'ro', isa => 'Stapler', required => 1 ); package Employee; use Moose; has 'desk' => ( is => 'ro', isa => 'Desk' ); } my $c = container 'TypeDependencyTest' => as { typemap 'Desk' => infer; service 'Employee' => ( class => 'Employee', dependencies => { desk => 'type:Desk' } ); }; my $desk = $c->resolve( type => 'Desk' ); isa_ok($desk, 'Desk'); isa_ok($desk->stapler, 'Stapler'); my $employee = $c->resolve( service => 'Employee' ); isa_ok($employee, 'Employee'); isa_ok($employee->desk, 'Desk'); isa_ok($employee->desk->stapler, 'Stapler'); done_testing; 031_custom_lifecycles.t100644001750000144 67212243443340 17415 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/env perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board::ConstructorInjection; { package MyLifeCycle; use Moose::Role; with 'Bread::Board::LifeCycle::Singleton'; } { package MyClass; use Moose; } my $s = Bread::Board::ConstructorInjection->new( lifecycle => '+MyLifeCycle', name => 'foo', class => 'MyClass', ); does_ok($s, 'MyLifeCycle'); done_testing; pod-coverage.t100644001750000144 52712243443340 17500 0ustar00doyusers000000000000Bread-Board-0.29/xt/release#!perl use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; eval "use Pod::Coverage::TrustPod"; plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage" if $@; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); Manual.pod100644001750000144 637712243443340 17451 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board# PODNAME: Bread::Board::Manual # ABSTRACT: A manual for Bread::Board __END__ =pod =head1 NAME Bread::Board::Manual - A manual for Bread::Board =head1 VERSION version 0.29 =head1 INTRODUCTION As we have said, Bread::Board is an inversion of control framework with a focus on dependency injection and lifecycle management. The goal that Bread::Board strives towards is to promote more decoupled designs. It does this by removing the need for your objects to be concerned with resolving and/or creating their dependencies as well as knowing (or caring) what their lifecycle is. =head2 Why should I use Bread::Board First, it should be noted that Bread::Board and IoC are not universally useful. Smaller applications and one-off scripts would be overburdened by the abstractions of Bread::Board. But the larger your application becomes, the more something like Bread::Board can help. As applications grow so the management of resources and their dependencies becomes more of a burden. Making sure all your components are properly initialized, in the right order and at all times that you need them, can become a twisty maze. Bread::Board is intended to help you manage this twisty maze and remove the need for you to manage this manually. Take your typical Catalyst application, the Catalyst framework itself contains its own mini IoC framework through the component subsystem. Catalyst will manage your models and views making sure that they will be available when you need them in the controllers. Catalyst makes all this easy to manage through its configuration system. This is great inside your Catalyst application, but what about outside of it? Any sufficiently complex web application will have a set of scripts and/or command-line applications to help support it. At this point you are left to your own devices and must manage these components and their dependency chains on your own. By decoupling IoC into its own stand-alone subsystem it becomes possible to get that same ease-of-use you get inside something like a Catalyst application, outside of it. This, in a nutshell, is what Bread::Board aims to provide. =head1 SECTIONS =over 4 =item L This is perhaps the best place to start, it will introduce you to the basic concepts that make up Bread::Board. =item L With Bread::Board you provide names for your service so that you can find them later. This document explores the new (read: experimental) typemap feature which allows you to map services to types as well. =item L Bread::Board is an extensible and open system, this document will explore how you can extend Bread::Board and get greater re-use of your components. =item L This is a set of examples meant to show how Bread::Board can be used in real-world scenarios. It is recommended that you read the above documentation first as many of these examples use the concepts discussed in them. =back =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Service.pm100644001750000144 755112243443340 17461 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::Service; BEGIN { $Bread::Board::Service::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Service::VERSION = '0.29'; } use Moose::Role; use Moose::Util::TypeConstraints 'find_type_constraint'; with 'Bread::Board::Traversable'; has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); has 'params' => ( traits => [ 'Hash' ], is => 'rw', isa => 'HashRef', lazy => 1, builder => 'init_params', clearer => 'clear_params', handles => { get_param => 'get', get_param_keys => 'keys', _clear_param => 'delete', _set_param => 'set', } ); has 'is_locked' => ( is => 'rw', isa => 'Bool', default => sub { 0 } ); has 'lifecycle' => ( is => 'rw', isa => 'Str', trigger => sub { my ($self, $lifecycle) = @_; if ($self->does('Bread::Board::LifeCycle')) { my $base = (Class::MOP::class_of($self)->superclasses)[0]; Class::MOP::class_of($base)->rebless_instance_back($self); return if $lifecycle eq 'Null'; } my $lifecycle_role = $lifecycle =~ /^\+/ ? substr($lifecycle, 1) : "Bread::Board::LifeCycle::${lifecycle}"; Class::MOP::load_class($lifecycle_role); Class::MOP::class_of($lifecycle_role)->apply($self); } ); sub init_params { +{} } sub param { my $self = shift; return $self->get_param_keys if scalar @_ == 0; return $self->get_param( $_[0] ) if scalar @_ == 1; ((scalar @_ % 2) == 0) || confess "parameter assignment must be an even numbered list"; my %new = @_; while (my ($key, $value) = each %new) { $self->set_param( $key => $value ); } return; } { my %mergeable_params = ( dependencies => { interface => 'Bread::Board::Service::WithDependencies', constraint => 'Bread::Board::Service::Dependencies', }, parameters => { interface => 'Bread::Board::Service::WithParameters', constraint => 'Bread::Board::Service::Parameters', }, ); sub clone_and_inherit_params { my ($self, %params) = @_; confess "Changing a service's class is not possible when inheriting" unless $params{service_class} eq blessed $self; for my $p (keys %mergeable_params) { if (exists $params{$p}) { if ($self->does($mergeable_params{$p}->{interface})) { my $type = find_type_constraint $mergeable_params{$p}->{constraint}; my $val = $type->assert_coerce($params{$p}); $params{$p} = { %{ $self->$p }, %{ $val }, }; } else { confess "Trying to add $p to a service not supporting them"; } } } $self->clone(%params); } } requires 'get'; sub lock { (shift)->is_locked(1) } sub unlock { (shift)->is_locked(0) } no Moose::Util::TypeConstraints; no Moose::Role; 1; __END__ =pod =head1 NAME Bread::Board::Service =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Literal.pm100644001750000144 210212243443340 17440 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::Literal; BEGIN { $Bread::Board::Literal::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Literal::VERSION = '0.29'; } use Moose; with 'Bread::Board::Service'; has 'value' => ( is => 'rw', isa => 'Defined', required => 1, ); sub get { (shift)->value } sub clone_and_inherit_params { confess 'Trying to inherit from a literal service'; } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::Literal =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 151_sugar_no_container.t100644001750000144 347512243443340 17607 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); } my $file_service = service 'log_file' => "logfile.log"; does_ok($file_service, 'Bread::Board::Service'); my $logger_service = service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => { log_file => depends_on('log_file'), } ); does_ok($logger_service, 'Bread::Board::Service'); my $app_service = service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), } ); does_ok($app_service, 'Bread::Board::Service'); my $bunyan_service = alias 'paul_bunyan' => 'logger'; does_ok($bunyan_service, 'Bread::Board::Service'); isa_ok($bunyan_service, 'Bread::Board::Service::Alias'); my $c = container 'MyApp'; isa_ok($c, 'Bread::Board::Container'); foreach ( $file_service, $logger_service, $app_service, $bunyan_service) { $c->add_service($_); } my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); my $bunyan = $c->resolve( service => 'paul_bunyan' ); isa_ok($bunyan, 'FileLogger'); is($bunyan, $logger, 'standalone alias works.'); done_testing; 070_with_basic_typemap.t100644001750000144 424412243443340 17576 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Bread::Board; { package My::Foo; use Moose; } { # typemap directly getting a service object ... my $c = container 'MyTestContainer' => as { typemap 'My::Foo' => (service 'my_foo' => (class => 'My::Foo')); }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); is( $c->get_type_mapping_for('My::Foo'), $c->fetch('my_foo'), '... the type mapping for My::Foo is the my_foo service' ); { my $foo = $c->resolve( service => 'my_foo' ); isa_ok($foo, 'My::Foo'); } { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); } } { # typemap mapping to a service object name ... my $c = container 'MyTestContainer' => as { service 'my_foo' => (class => 'My::Foo'); typemap 'My::Foo' => 'my_foo'; }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); is( $c->get_type_mapping_for('My::Foo'), $c->fetch('my_foo'), '... the type mapping for My::Foo is the my_foo service' ); { my $foo = $c->resolve( service => 'my_foo' ); isa_ok($foo, 'My::Foo'); } { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); } } { # typemap mapping to a service object name # that is a path to a sub-container service my $c = container 'MyTestContainer' => as { container 'MyTestSubContainer' => as { service 'my_foo' => (class => 'My::Foo'); }; typemap 'My::Foo' => 'MyTestSubContainer/my_foo'; }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); is( $c->get_type_mapping_for('My::Foo'), $c->fetch('MyTestSubContainer/my_foo'), '... the type mapping for My::Foo is the MyTestSubContainer/my_foo service' ); { my $foo = $c->resolve( service => 'MyTestSubContainer/my_foo' ); isa_ok($foo, 'My::Foo'); } { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); } } done_testing; 053_parameterized_clone.t100644001750000144 132112243443340 17731 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; my $c = container Foo => as { container Bar => ['Baz'] => as { service moo => ( block => sub { my ($s) = @_; $s->param('kooh'); }, dependencies => { kooh => depends_on('Baz/boo'), }, ); }; container Bif => as { service boo => 42; }; }; is $c->fetch('Bar')->create(Baz => $c->fetch('Bif'))->resolve(service => 'moo'), 42; my $clone; is exception { $clone = $c->clone }, undef; is $clone->fetch('Bar')->create(Baz => $clone->fetch('Bif'))->resolve(service => 'moo'), 42; done_testing; 030_lifecycle_singleton.t100644001750000144 625612243443340 17745 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board::ConstructorInjection; use Bread::Board::LifeCycle::Singleton; use Bread::Board::Literal; { package Needle; use Moose; package Mexican::Black::Tar; use Moose; package Addict; use Moose; has 'needle' => (is => 'ro'); has 'spoon' => (is => 'ro'); has 'stash' => (is => 'ro'); } my $s = Bread::Board::ConstructorInjection->new( lifecycle => 'Singleton', name => 'William', class => 'Addict', dependencies => { needle => Bread::Board::ConstructorInjection->new(name => 'spike', class => 'Needle'), spoon => Bread::Board::Literal->new(name => 'works', value => 'Spoon!'), }, parameters => { stash => { isa => 'Mexican::Black::Tar' } } ); isa_ok($s, 'Bread::Board::ConstructorInjection'); does_ok($s, 'Bread::Board::Service::WithClass'); does_ok($s, 'Bread::Board::Service::WithDependencies'); does_ok($s, 'Bread::Board::Service::WithParameters'); does_ok($s, 'Bread::Board::Service'); does_ok($s, 'Bread::Board::LifeCycle::Singleton'); is($s->lifecycle, 'Singleton', '... got the right lifecycle'); ok(!$s->has_instance, '... we dont have an instance yet'); my $i = $s->get(stash => Mexican::Black::Tar->new); ok($s->has_instance, '... we do have an instance now'); isa_ok($i, 'Addict'); isa_ok($i->needle, 'Needle'); is($i->spoon, 'Spoon!', '... got our literal service'); isa_ok($i->stash, 'Mexican::Black::Tar'); { my $i2 = $s->get(stash => Mexican::Black::Tar->new); is($i, $i2, '... calling it again returns the same object'); } $s->flush_instance; { my $i2 = $s->get(stash => Mexican::Black::Tar->new); isnt($i, $i2, '... calling it again returns an new object'); { my $i2a = $s->get(stash => Mexican::Black::Tar->new); is($i2, $i2a, '... calling it again returns the same object'); } $s->lifecycle('Null'); ok(!$s->can('flush_instance'), '... we can no longer call flush_instance'); ok(!$s->can('instance'), '... we can no longer call instance'); ok(!$s->can('has_instance'), '... we can no longer call has_instance'); is($s->lifecycle, 'Null', '... got the right lifecycle'); { my $i2a = $s->get(stash => Mexican::Black::Tar->new); isnt($i2, $i2a, '... calling it again returns a new object'); { my $i2a1 = $s->get(stash => Mexican::Black::Tar->new); isnt($i2, $i2a1, '... calling it again returns a new object as before'); isnt($i2a, $i2a1, '... calling it again returns a new object'); } } } $s->lifecycle('Singleton'); ok($s->can('flush_instance'), '... we can no longer call flush_instance'); ok($s->can('instance'), '... we can no longer call instance'); ok($s->can('has_instance'), '... we can no longer call has_instance'); is($s->lifecycle, 'Singleton', '... got the right lifecycle'); { my $i2 = $s->get(stash => Mexican::Black::Tar->new); isnt($i, $i2, '... calling it again returns the same object'); { my $i2a = $s->get(stash => Mexican::Black::Tar->new); is($i2, $i2a, '... calling it again returns the same object'); } } done_testing; 044_deferred_parameters.t100644001750000144 230412243443340 17722 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package User; use Moose; has 'name' => ( is => 'ro', isa => 'Str' ); package Page; use Moose; has 'user' => ( is => 'ro', isa => 'User' ); } my $c = container 'Views' => as { service 'User' => ( block => sub { my $s = shift; '

' . $s->param('user')->name . '

'; }, parameters => { user => { isa => 'User' } } ); service 'Page' => ( block => sub { my $s = shift; '' . '' . $s->param('user_view')->inflate( user => $s->param('page')->user ) . '' . ''; }, dependencies => { user_view => depends_on('User') }, parameters => { page => { isa => 'Page' } } ); }; my $view = $c->fetch('Page')->get( page => Page->new( user => User->new( name => 'Stevan' ) ) ); is( $view, '

Stevan

', '... got the correct result' ); done_testing; LifeCycle.pm100644001750000144 141112243443340 17705 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::LifeCycle; BEGIN { $Bread::Board::LifeCycle::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::LifeCycle::VERSION = '0.29'; } use Moose::Role; no Moose::Role; 1; __END__ =pod =head1 NAME Bread::Board::LifeCycle =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 NAME Bread::Board::LifeCycle =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Container.pm100644001750000144 1435412243443340 20022 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::Container; BEGIN { $Bread::Board::Container::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Container::VERSION = '0.29'; } use Moose; use Moose::Util::TypeConstraints 'find_type_constraint'; use MooseX::Params::Validate 0.14; use Bread::Board::Types; with 'Bread::Board::Traversable'; has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); has 'services' => ( traits => [ 'Hash', 'Clone' ], is => 'rw', isa => 'Bread::Board::Container::ServiceList', coerce => 1, lazy => 1, default => sub{ +{} }, trigger => sub { my $self = shift; $_->parent($self) foreach values %{$self->services}; }, handles => { 'get_service' => 'get', 'has_service' => 'exists', 'get_service_list' => 'keys', 'has_services' => 'count', } ); has 'sub_containers' => ( traits => [ 'Hash', 'Clone' ], is => 'rw', isa => 'Bread::Board::Container::SubContainerList', coerce => 1, lazy => 1, default => sub{ +{} }, trigger => sub { my $self = shift; $_->parent($self) foreach values %{$self->sub_containers}; }, handles => { 'get_sub_container' => 'get', 'has_sub_container' => 'exists', 'get_sub_container_list' => 'keys', 'has_sub_containers' => 'count', } ); has 'type_mappings' => ( traits => [ 'Hash' ], is => 'rw', isa => 'Bread::Board::Container::ServiceList', lazy => 1, default => sub{ +{} }, handles => { '_get_type_mapping_for' => 'get', '_has_type_mapping_for' => 'exists', '_mapped_types' => 'keys', } ); sub get_type_mapping_for { my $self = shift; my ($type) = @_; return $self->_get_type_mapping_for($type) if $self->_has_type_mapping_for($type); for my $possible ($self->_mapped_types) { return $self->_get_type_mapping_for($possible) if $possible->isa($type); } return; } sub has_type_mapping_for { my $self = shift; my ($type) = @_; return 1 if $self->_has_type_mapping_for($type); for my $possible ($self->_mapped_types) { return 1 if $possible->isa($type); } return; } sub add_service { my ($self, $service) = @_; (blessed $service && $service->does('Bread::Board::Service')) || confess "You must pass in a Bread::Board::Service instance, not $service"; $service->parent($self); $self->services->{$service->name} = $service; } sub add_sub_container { my ($self, $container) = @_; ( blessed $container && ( $container->isa('Bread::Board::Container') || $container->isa('Bread::Board::Container::Parameterized') ) ) || confess "You must pass in a Bread::Board::Container instance, not $container"; $container->parent($self); $self->sub_containers->{$container->name} = $container; } sub add_type_mapping_for { my ($self, $type, $service) = @_; my $type_constraint = find_type_constraint( $type ); (defined $type_constraint) || confess "You must pass a valid Moose type, and it must exist already"; (blessed $service && $service->does('Bread::Board::Service')) || confess "You must pass in a Bread::Board::Service instance, not $service"; $self->type_mappings->{ $type_constraint->name } = $service; } sub resolve { my ($self, %params) = validated_hash(\@_, service => { isa => 'Str', optional => 1 }, type => { isa => 'Str', optional => 1 }, parameters => { isa => 'HashRef', optional => 1 }, ); my %parameters = exists $params{'parameters'} ? %{ $params{'parameters'} } : (); if (my $service_path = $params{'service'}) { my $service = $self->fetch( $service_path ); # NOTE: # we might want to allow Bread::Board::Service::Deferred::Thunk # objects as well, but I am not sure that is a valid use case # for this, so for now we just don't go there. # - SL (blessed $service && $service->does('Bread::Board::Service')) || confess "You can only resolve services, " . (defined $service ? $service : 'undef') . " is not a Bread::Board::Service"; return $service->get( %parameters ); } elsif (my $type = $params{'type'}) { ($self->has_type_mapping_for( $type )) || confess "Could not find a mapped service for type ($type)"; my $service = $self->get_type_mapping_for( $type ); my $result = $service->get( %parameters ); (find_type_constraint( $type )->check( $result )) || confess "The result of the service for type ($type) did not" . " pass the type constraint with $result"; return $result; } else { confess "Cannot call resolve without telling it what to resolve."; } } __PACKAGE__->meta->make_immutable; no Moose::Util::TypeConstraints; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::Container =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B $service_name, ?type => $type, ?parameters => { ... } )> =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 076_more_complex_typemap.t100644001750000144 762612243443340 20170 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package Stapler; use Moose; package Desk; use Moose; package Chair; use Moose; package Cubicle; use Moose; has 'desk' => ( is => 'ro', isa => 'Desk', required => 1, ); has 'chair' => ( is => 'ro', isa => 'Chair', required => 1, ); package KeyCard; use Moose; use Moose::Util::TypeConstraints; subtype 'KeyCardUUID' => as 'Str'; has 'uuid' => ( is => 'ro', isa => 'KeyCardUUID', required => 1, ); package Employee; use Moose; has [ 'first_name', 'last_name' ] => ( is => 'ro', isa => 'Str', required => 1, ); has 'stapler' => ( is => 'ro', isa => 'Stapler', predicate => 'has_stapler' ); has 'keycard' => ( is => 'ro', isa => 'KeyCard', required => 1, ); has 'work_area' => ( is => 'ro', isa => 'Cubicle', required => 1, ); } my $UUID = 0; my $c = container 'Initech' => as { service 'keycard_uuid_generator' => ( block => sub { ++$UUID } ); typemap 'KeyCardUUID' => 'keycard_uuid_generator'; typemap 'Employee' => infer; }; my $micheal = $c->resolve( type => 'Employee', parameters => { first_name => 'Micheal', last_name => 'Bolton' } ); my $samir = $c->resolve( type => 'Employee', parameters => { first_name => 'Samir', last_name => 'Nagheenanajar' } ); isa_ok($micheal, 'Employee'); is($micheal->first_name, 'Micheal', '... got the right first name'); is($micheal->last_name, 'Bolton', '... got the right last name'); isa_ok($micheal->work_area, 'Cubicle'); isa_ok($micheal->work_area->desk, 'Desk'); isa_ok($micheal->work_area->chair, 'Chair'); ok(!$micheal->has_stapler, '... Micheal doesnt have a stapler'); isa_ok($samir, 'Employee'); is($samir->first_name, 'Samir', '... got the right first name'); is($samir->last_name, 'Nagheenanajar', '... got the right last name'); isa_ok($samir->work_area, 'Cubicle'); isa_ok($samir->work_area->desk, 'Desk'); isa_ok($samir->work_area->chair, 'Chair'); ok(!$samir->has_stapler, '... Samir doesnt have a stapler'); isnt($micheal, $samir, '... two different employees'); isnt($micheal->work_area, $samir->work_area, '... two different work_areas'); isnt($micheal->work_area->chair, $samir->work_area->chair, '... two different work_area chairs'); isnt($micheal->work_area->desk, $samir->work_area->desk, '... two different work_area desks'); isnt($micheal->keycard, $samir->keycard, '... two different keycards'); isnt($micheal->keycard->uuid, $samir->keycard->uuid, '... two different keycard uuids'); my $milton = $c->resolve( type => 'Employee', parameters => { first_name => 'Milton', last_name => 'Waddams', stapler => Stapler->new } ); isa_ok($milton, 'Employee'); is($milton->first_name, 'Milton', '... got the right first name'); is($milton->last_name, 'Waddams', '... got the right last name'); isa_ok($milton->work_area, 'Cubicle'); isa_ok($milton->work_area->desk, 'Desk'); isa_ok($milton->work_area->chair, 'Chair'); ok($milton->has_stapler, '... Milton does have a stapler'); foreach ( $micheal, $samir ) { isnt($milton, $_, '... two different employees'); isnt($milton->work_area, $_->work_area, '... two different work_areas'); isnt($milton->work_area->chair, $_->work_area->chair, '... two different work_area chairs'); isnt($milton->work_area->desk, $_->work_area->desk, '... two different work_area desks'); isnt($milton->keycard, $_->keycard, '... two different keycards'); isnt($milton->keycard->uuid, $_->keycard->uuid, '... two different keycard uuids'); } done_testing; 201_log_dispatch_example.t100644001750000144 271512243443340 20073 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Test::Requires 'Log::Dispatch', 'Log::Dispatch::File', 'Log::Dispatch::Screen'; use Bread::Board; my $c = container 'Logging' => as { service 'Logger' => ( block => sub { my $s = shift; my $c = $s->parent; my $outputs = $c->get_sub_container('Outputs'); my $log = Log::Dispatch->new; foreach my $name ( $outputs->get_service_list ) { $log->add( $outputs->get_service( $name )->get ); } $log; } ); container 'Outputs' => as { service 'File' => ( block => sub { Log::Dispatch::File->new( name => 'file', min_level => 'debug', filename => 'logfile' ) } ); service 'Screen' => ( block => sub { Log::Dispatch::Screen->new( name => 'screen', min_level => 'warning', ) } ); }; }; my $logger = $c->resolve( service => 'Logger' ); isa_ok($logger, 'Log::Dispatch'); my $screen = $logger->output('screen'); isa_ok($screen, 'Log::Dispatch::Screen'); my $file = $logger->output('file'); isa_ok($file, 'Log::Dispatch::File'); unlink 'logfile'; done_testing; Dependency.pm100644001750000144 363112243443340 20132 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::Dependency; BEGIN { $Bread::Board::Dependency::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Dependency::VERSION = '0.29'; } use Moose; use Bread::Board::Service; with 'Bread::Board::Traversable'; has 'service_path' => ( is => 'ro', isa => 'Str', predicate => 'has_service_path' ); has 'service_name' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; ($self->has_service_path) || confess "Could not determine service name without service path"; (split '/' => $self->service_path)[-1]; } ); has 'service_params' => ( is => 'ro', isa => 'HashRef', predicate => 'has_service_params' ); has 'service' => ( is => 'ro', does => 'Bread::Board::Service | Bread::Board::Dependency', lazy => 1, default => sub { my $self = shift; ($self->has_service_path) || confess "Could not fetch service without service path"; $self->fetch($self->service_path); }, handles => [ 'get', 'is_locked', 'lock', 'unlock' ] ); __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::Dependency =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 025_sugar_w_absolute_path.t100644001750000144 314012243443340 20276 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; my $c = container 'Application' => as { container 'Model' => as { service 'dsn' => ''; service 'schema' => ( class => 'My::App::Schema', dependencies => { dsn => depends_on('dsn'), user => depends_on('user'), pass => depends_on('pass') } ); }; container 'View' => as { service 'TT' => ( class => 'My::App::View::TT', dependencies => { tt_include_path => depends_on('include_path') } ) }; container 'Controller'; }; my $model = $c->fetch('Model'); isa_ok($model, 'Bread::Board::Container'); is($model->name, 'Model', '... got the right model'); { my $model2 = $c->fetch('/Model'); isa_ok($model2, 'Bread::Board::Container'); is($model, $model2, '... they are the same thing'); } my $dsn = $model->fetch('schema/dsn'); isa_ok($dsn, 'Bread::Board::Dependency'); is($dsn->service_path, 'dsn', '... got the right name'); { my $dsn2 = $c->fetch('/Model/schema/dsn'); isa_ok($dsn2, 'Bread::Board::Dependency'); is($dsn, $dsn2, '... they are the same thing'); } my $root = $model->fetch('..'); isa_ok($root, 'Bread::Board::Container'); is($root, $c, '... got the same container'); is($model, $model->fetch('../Model'), '... navigated back to myself'); is($dsn, $model->fetch('../Model/schema/dsn'), '... navigated to dsn'); is($model, $dsn->fetch('../Model'), '... got the model from the dsn'); done_testing; 202_form_sensible_example.t100644001750000144 715312243443340 20264 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Test::Requires { 'Form::Sensible' => '0.11220' }; use Bread::Board; { package My::Model; use Moose; sub get_all_access_levels { return ( { id => 'standard', name => 'Standard User' }, { id => 'admin', name => 'Administrator' }, { id => 'super', name => 'Super User' }, ) } } my $FormBuilder = container 'FormBuilder' => [ 'Fields' ] => as { service 'Form' => ( class => 'Form::Sensible', block => sub { my $s = shift; my $c = $s->parent; my $fields = $c->get_sub_container('Fields'); my $form = Form::Sensible::Form->new( name => $s->param('name') ); foreach my $name ( $fields->get_service_list ) { $form->add_field( $fields->get_service( $name )->get ); } if ( my $state = $s->param('state') ) { $form->set_values( $state ); } $form; }, parameters => { name => { isa => 'Str' }, state => { isa => 'HashRef', optional => 1 }, } ); }; my $Fields = container 'Fields' => [ 'Model' ] => as { service 'Username' => ( class => 'Form::Sensible::Field::Text', block => sub { Form::Sensible::Field::Text->new( name => 'username', validation => { regex => qr/^[0-9a-z]*$/ } ); } ); service 'Password' => ( class => 'Form::Sensible::Field::Text', block => sub { Form::Sensible::Field::Text->new( name => 'password', render_hints => { 'HTML' => { field_type => 'password' } } ); } ); service 'Submit' => ( class => 'Form::Sensible::Field::Trigger', block => sub { Form::Sensible::Field::Trigger->new( name => 'submit' ); } ); service 'AccessLevel' => ( class => 'Form::Sensible::Field::Select', block => sub { my $s = shift; my $select = Form::Sensible::Field::Select->new( name => 'access_level', ); foreach my $access_level ( $s->param('schema')->get_all_access_levels ) { $select->add_option( $access_level->{id}, $access_level->{name} ); } $select; }, dependencies => { schema => depends_on('Model/schema') , }, ); }; # this would actually wrap the # $c->model('DBIC') or something # in order to get the DBIC schema # object my $Model = container 'Model' => as { service 'schema' => My::Model->new }; # perhaps create this in a early part # of a catalyst dispatch chain my $Form = $FormBuilder->create( Fields => $Fields->create( Model => $Model ) ); # then in the actual action code # you would create the form instance # and pass the state (which is # basically $c->req->parameters) my $f = $Form->resolve( service => 'Form', parameters => { name => 'test', state => { username => 'stevan', password => '****', access_level => [ 'admin' ] } } ); isa_ok($f, 'Form::Sensible::Form'); my $result = $f->validate; ok( $result->is_valid, '... our form validated' ); done_testing; 029_sugar_auto_wire_names.t100644001750000144 464112243443340 20312 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package DBI; use Moose; has 'dsn' => (is => 'ro', isa => 'Str'); has 'username' => (is => 'ro', isa => 'Str'); has 'password' => (is => 'ro', isa => 'Str'); sub connect { my ($class, $dsn, $username, $password) = @_; $class->new(dsn => $dsn, username => $username, password => $password); } package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); has 'dbh' => (is => 'ro', isa => 'DBI', required => 1); } my $c = container 'MyApp' => as { service 'log_file' => "logfile.log"; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => ['log_file'] ); container 'Database' => as { service 'dsn' => "dbi:sqlite:dbname=my-app.db"; service 'username' => "user"; service 'password' => "pass"; service 'dbh' => ( block => sub { my $s = shift; DBI->connect( $s->param('dsn'), $s->param('username'), $s->param('password'), ) || die "Could not connect"; }, dependencies => [qw[dsn username password]] ); }; service 'application' => ( class => 'MyApplication', dependencies => ['logger', 'Database/dbh'] ); }; my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $dbh = $c->resolve( service => 'Database/dbh' ); isa_ok($dbh, 'DBI'); is($dbh->dsn, "dbi:sqlite:dbname=my-app.db", '... got the right dsn'); is($dbh->username, "user", '... got the right username'); is($dbh->password, "pass", '... got the right password'); my $app = $c->resolve( service => 'application'); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); isa_ok($app->dbh, 'DBI'); isnt($app->dbh, $dbh, '... got a different dbh'); done_testing; 054_parameterized_backref.t100644001750000144 145512243443340 20237 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; my $c = container Foo => as { service fez => 123; container Bar => ['Baz'] => as { service moo => ( block => sub { my ($s) = @_; $s->param('kooh') + $s->param('fez'); }, dependencies => { kooh => depends_on('Baz/boo'), fez => depends_on('../fez'), }, ); }; container Bif => as { service boo => 42; }; }; is $c->fetch('Bar')->create(Baz => $c->fetch('Bif'))->resolve(service => 'moo'), 165; my $clone; is exception { $clone = $c->clone }, undef; is $clone->fetch('Bar')->create(Baz => $clone->fetch('Bif'))->resolve(service => 'moo'), 165; done_testing; 001_constructor_injection.t100644001750000144 606112243443340 20343 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Test::Fatal; use Bread::Board::ConstructorInjection; use Bread::Board::Literal; { package Needle; use Moose; package Mexican::Black::Tar; use Moose; package Addict; use Moose; sub shoot_up_good { shift->new(@_, overdose => 1) } has 'needle' => (is => 'ro'); has 'spoon' => (is => 'ro'); has 'stash' => (is => 'ro'); has 'overdose' => (is => 'ro', isa => 'Bool', default => 0); } my $s = Bread::Board::ConstructorInjection->new( name => 'William', class => 'Addict', dependencies => { needle => Bread::Board::ConstructorInjection->new(name => 'spike', class => 'Needle'), spoon => Bread::Board::Literal->new(name => 'works', value => 'Spoon!'), }, parameters => { stash => { isa => 'Mexican::Black::Tar' } } ); isa_ok($s, 'Bread::Board::ConstructorInjection'); does_ok($s, 'Bread::Board::Service::WithClass'); does_ok($s, 'Bread::Board::Service::WithDependencies'); does_ok($s, 'Bread::Board::Service::WithParameters'); does_ok($s, 'Bread::Board::Service'); { my $i = $s->get(stash => Mexican::Black::Tar->new); isa_ok($i, 'Addict'); isa_ok($i->needle, 'Needle'); is($i->spoon, 'Spoon!', '... got our literal service'); isa_ok($i->stash, 'Mexican::Black::Tar'); ok ! $i->overdose, 'Normal constructor'; { my $i2 = $s->get(stash => Mexican::Black::Tar->new); isnt($i, $i2, '... calling it again returns an new object'); } } $s->constructor_name('shoot_up_good'); { my $i = $s->get(stash => Mexican::Black::Tar->new); isa_ok($i, 'Addict'); ok $i->overdose, 'Alternate constructor called'; } is($s->name, 'William', '... got the right name'); is($s->class, 'Addict', '... got the right class'); my $deps = $s->dependencies; is_deeply([ sort keys %$deps ], [qw/needle spoon/], '... got the right dependency keys'); my $needle = $s->get_dependency('needle'); isa_ok($needle, 'Bread::Board::Dependency'); isa_ok($needle->service, 'Bread::Board::ConstructorInjection'); is($needle->service->name, 'spike', '... got the right name'); is($needle->service->class, 'Needle', '... got the right class'); my $spoon = $s->get_dependency('spoon'); isa_ok($spoon, 'Bread::Board::Dependency'); isa_ok($spoon->service, 'Bread::Board::Literal'); is($spoon->service->name, 'works', '... got the right name'); is($spoon->service->value, 'Spoon!', '... got the right literal value'); my $params = $s->parameters; is_deeply([ sort keys %$params ], [qw/stash/], '... got the right paramter keys'); is_deeply($params->{stash}, { isa => 'Mexican::Black::Tar' }, '... got the right parameter spec'); # test some errors isnt(exception { $s->get; }, undef, '... you must supply the required parameters'); isnt(exception { $s->get(stash => []); }, undef, '... you must supply the required parameters as correct types'); isnt(exception { $s->get(stash => Mexican::Black::Tar->new, foo => 10); }, undef, '... you must supply the required parameters (and no more)'); done_testing; 062_service_class_w_sugar.t100644001750000144 261212243443340 20275 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Bread::Board; { package My::LoggerService; use Moose; extends 'Bread::Board::ConstructorInjection'; with 'Bread::Board::LifeCycle::Singleton'; has '+class' => (default => 'FileLogger'); package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); } my $c = container 'MyApp' => as { service 'log_file' => "logfile.log"; service 'logger' => ( service_class => 'My::LoggerService', dependencies => { log_file => depends_on('log_file'), } ); service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), } ); }; my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); done_testing; 028_sugar_w_recursive_inc.t100644001750000144 155612243443340 20320 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use FindBin; use Test::More; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); } my $c = include "$FindBin::Bin/lib/my_app.bb"; my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); done_testing; 040_circular_dependencies.t100644001750000144 634712243443340 20240 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; =pod This test checks the basic cyclical dependency handling. It is not quite as sophisticated as the IOC one, but it is good enough. Honestly, in all the years of using IOC, I never needed to use cyclical deps. =cut { package Class::A; use Moose; has 'B' => (is => 'ro', isa => 'Class::B'); package Class::B; use Moose; has 'A' => (is => 'ro', isa => 'Class::A'); package Class::C; use Moose; has 'D' => (is => 'ro', isa => 'Class::D'); package Class::D; use Moose; has 'E' => (is => 'ro', isa => 'Class::E'); package Class::E; use Moose; has 'F' => (is => 'ro', isa => 'Class::F'); package Class::F; use Moose; has 'C' => (is => 'ro', isa => 'Class::C'); } # +---+ # +--| A |<-+ # | +---+ | # | +---+ | # +->| B |--+ # +---+ { my $c = container 'Test' => as { service 'A' => ( class => 'Class::A', lifecycle => 'Singleton', dependencies => [ depends_on('B') ] ); service 'B' => ( class => 'Class::B', lifecycle => 'Singleton', dependencies => [ depends_on('A') ] ); }; isa_ok($c, 'Bread::Board::Container'); ok($c->has_service('A'), '... got the A service'); ok($c->has_service('B'), '... got the B service'); my $b = $c->resolve( service => 'B' ); isa_ok($b, 'Class::B'); my $a = $c->resolve( service => 'A'); isa_ok($a, 'Class::A'); isa_ok($b->A, 'Class::A'); isa_ok($a->B, 'Class::B'); is($a->B, $b, '... our Bs match'); is($b->A, "$a", '... our As match'); } # +---+ # +--| C |<-+ # | +---+ | # +-V-+ +---+ # | D | | F | # +---+ +-^-+ # | +---+ | # +->| E |--+ # +---+ { my $container = container 'Test' => as { service 'C' => ( class => 'Class::C', lifecycle => 'Singleton', dependencies => [ depends_on('D') ] ); service 'D' => ( class => 'Class::D', lifecycle => 'Singleton', dependencies => [ depends_on('E') ] ); service 'E' => ( class => 'Class::E', lifecycle => 'Singleton', dependencies => [ depends_on('F') ] ); service 'F' => ( class => 'Class::F', lifecycle => 'Singleton', dependencies => [ depends_on('C') ] ); }; isa_ok($container, 'Bread::Board::Container'); ok($container->has_service($_), '... got the ' . $_ . ' service') for qw/C D E F/; my $c = $container->resolve( service => 'C' ); isa_ok($c, 'Class::C'); my $d = $container->resolve( service => 'D' ); isa_ok($d, 'Class::D'); my $e = $container->resolve( service => 'E' ); isa_ok($e, 'Class::E'); my $f = $container->resolve( service => 'F' ); isa_ok($f, 'Class::F'); isa_ok($c->D, 'Class::D'); isa_ok($d->E, 'Class::E'); isa_ok($e->F, 'Class::F'); isa_ok($f->C, 'Class::C'); is($f->C, $c, '... our Cs match'); is($c->D->E->F, $f, '... our Fs match'); } done_testing; Traversable.pm100644001750000144 727012243443340 20331 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::Traversable; BEGIN { $Bread::Board::Traversable::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Traversable::VERSION = '0.29'; } use Moose::Role; with 'MooseX::Clone' => { -version => 0.05 }; has 'parent' => ( is => 'rw', isa => 'Bread::Board::Traversable', weak_ref => 1, clearer => 'detach_from_parent', predicate => 'has_parent', ); sub get_root_container { my $c = shift; while ($c->has_parent) { $c = $c->parent; } return $c; } sub fetch { my ($self, $path) = @_; my $root; if ($path =~ /^\//) { $root = $self->get_root_container; } else { $root = $self; while (!$root->isa('Bread::Board::Container')) { $root = $root->parent; } } my @path = grep { $_ } split /\// => $path; if ($path[0] eq '..') { my $c = $root; do { shift @path; $c = $c->parent || confess "Expected parent for " . $c->name . " but found none"; } while (defined $path[0] && $path[0] eq '..' && $c->has_parent); $root = $c; } return $root unless @path; my $c = $root; while (my $h = shift @path) { $c = _get_container_or_service($c, $h); } if (!$self->isa('Bread::Board::Service::Alias')) { my %seen; while ($c->isa('Bread::Board::Service::Alias')) { $c = $c->aliased_from; confess "Cycle detected in aliases" if exists $seen{$c}; $seen{$c}++; } } return $c; } sub _get_container_or_service { my ($c, $name) = @_; (blessed $c) || confess "Expected object, got $c"; if ($c->isa('Bread::Board::Dependency')) { # make sure to evaluate this from the parent return _get_container_or_service($c->parent->parent, $name); } if ($c->does('Bread::Board::Service::WithDependencies')) { return $c->get_dependency($name) if $c->has_dependency($name); confess "Could not find dependency ($name) from service " . $c->name; } # name() is implemented in Service and Container # get_sub_container and get_service is implemented in Container # there must be a better way to do this if ($c->does('Bread::Board::Service')) { if ($c->name eq $name) { warn "Traversing into the current service ($name) is deprecated." . " You should remove the $name component from the path."; return $c; } } elsif ($c->isa('Bread::Board::Container')) { if ($c->name eq $name) { warn "Traversing into the current container ($name) is deprecated;" . " you should remove the $name component from the path"; return $c; } return $c->get_sub_container($name) if $c->has_sub_container($name); return $c->get_service($name) if $c->has_service($name); } confess "Could not find container or service for $name in " . $c->name; } no Moose::Role; 1; __END__ =pod =head1 NAME Bread::Board::Traversable =head1 VERSION version 0.29 =head1 SYNOPSIS =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 102_clone_w_block_injection.t100644001750000144 426512243443340 20564 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr); use Bread::Board; { package Test::Class; use Moose; has 'dep' => ( is => 'rw', isa => 'Int' ); } my $board = Bread::Board::Container->new( name => 'app' ); isa_ok($board, 'Bread::Board::Container'); $board->add_service( Bread::Board::BlockInjection->new( name => 'test', class => 'Test::Class', block => sub { my $s = shift; Test::Class->new(%{ $s->params }); }, dependencies => { dep => Bread::Board::Dependency->new(service_path => '/dep'), }, ) ); ok($board->has_service('test'), '... got the test service'); isa_ok($board->get_service('test'), 'Bread::Board::BlockInjection'); # clone ... my $board2 = $board->clone; isa_ok($board2, 'Bread::Board::Container'); isnt($board, $board2, '... they are not the same instance'); ok($board2->has_service('test'), '... got the test service'); isa_ok($board2->get_service('test'), 'Bread::Board::BlockInjection'); isnt($board->get_service('test'), $board2->get_service('test'), '... not the same test services'); # add dep services ... $board->add_service( Bread::Board::Literal->new(name => 'dep', value => 1) ); ok($board->has_service('dep'), '... got the dep service'); isa_ok($board->get_service('dep'), 'Bread::Board::Literal'); ok(!$board2->has_service('dep'), '... board2 does not have the dep service'); $board2->add_service( Bread::Board::Literal->new(name => 'dep', value => 2) ); ok($board2->has_service('dep'), '... got the dep service'); isa_ok($board2->get_service('dep'), 'Bread::Board::Literal'); isnt($board->get_service('dep'), $board2->get_service('dep'), '... not the same dep services'); # test them ... is($board->fetch('/dep')->get(), 1, '... got correct dep'); is($board->fetch('/test')->get()->dep, 1, '... test uses dep'); is(refaddr $board->fetch('/test')->parent, refaddr $board, '... got the right board'); is($board2->fetch('/dep')->get(), 2, '... got correct dep'); is($board2->fetch('/test')->get()->dep, 2, '... test uses dep'); is(refaddr $board2->fetch('/test')->parent, refaddr $board2, '... got the right board'); done_testing; 075_complex_typemap_example.t100644001750000144 401012243443340 20640 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package Logger::Role; use Moose::Role; requires 'log'; package My::Logger; use Moose; with 'Logger::Role'; has 'level' => ( is => 'ro', isa => 'Str', default => 'warn' ); sub log {} package My::DBI; use Moose; has 'dsn' => (is => 'ro', isa => 'Str'); sub connect { my ($class, $dsn) = @_; $class->new( dsn => $dsn ); } package My::Application; use Moose; has 'logger' => (is => 'ro', does => 'Logger::Role', required => 1); has 'dbh' => (is => 'ro', isa => 'My::DBI', required => 1); } my $c = container 'Automat' => as { service 'dsn' => 'dbi:sqlite:test'; service 'dbh' => ( block => sub { my $s = shift; My::DBI->connect( $s->param( 'dsn' ) ); }, dependencies => [ depends_on('dsn') ] ); # map a type to a service implementation ... typemap 'My::DBI' => 'dbh'; # ask the container to infer a service, # but give it some hints .... typemap 'Logger::Role' => infer( class => 'My::Logger' ); # ask the container to infer the # entire service ... typemap 'My::Application' => infer; }; # check the inference from the top level Application ... { my $app = $c->resolve( type => 'My::Application' ); isa_ok($app, 'My::Application'); isa_ok($app->logger, 'My::Logger'); does_ok($app->logger, 'Logger::Role'); is($app->logger->level, 'warn', '... got the default level'); isa_ok($app->dbh, 'My::DBI'); is($app->dbh->dsn, 'dbi:sqlite:test', '... got the right DSN too'); } # check the inference from the logger object # and its optional 'level' parameter { my $logger = $c->resolve( type => 'Logger::Role', parameters => { level => 'debug' } ); isa_ok($logger, 'My::Logger'); does_ok($logger, 'Logger::Role'); is($logger->level, 'debug', '... got the custom level'); } done_testing; 078_complex_typemap_w_error.t100644001750000144 225712243443340 20702 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Test::Moose; use Bread::Board; { package Desk; use Moose; # this cannot be handled # so this will cause the # inference to die has 'stapler' => ( is => 'ro', isa => 'Any', required => 1, ); package Chair; use Moose; package Cubicle; use Moose; has 'desk' => ( is => 'ro', isa => 'Desk', required => 1, ); has 'chair' => ( is => 'ro', isa => 'Chair', required => 1, ); package Employee; use Moose; has [ 'first_name', 'last_name' ] => ( is => 'ro', isa => 'Str', required => 1, ); has 'work_area' => ( is => 'ro', isa => 'Cubicle', required => 1, ); } like(exception { container 'Initech' => as { typemap 'Employee' => infer; }; }, qr/Only class types\, role types\, or subtypes of Object can be inferred\. I don\'t know what to do with type \(Any\)/, '... cannot infer a non typemapped item below the first level'); done_testing; 072_typemap_with_more_infer.t100644001750000144 336612243443340 20650 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package My::Bar; use Moose; package My::Foo; use Moose; has 'bar' => ( is => 'ro', isa => 'My::Bar', required => 1, ); } { my $c = container 'MyTestContainer' => as { typemap 'My::Bar' => infer; typemap 'My::Foo' => infer; }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); does_ok( $c->get_type_mapping_for('My::Foo'), 'Bread::Board::Service' ); ok($c->has_type_mapping_for('My::Bar'), '... we do not have a type mapping for My::Bar'); does_ok( $c->get_type_mapping_for('My::Bar'), 'Bread::Board::Service' ); is( $c->get_type_mapping_for('My::Foo')->get_dependency('bar')->service, $c->get_type_mapping_for('My::Bar'), '... the My::Bar dependency for My::Foo is the same as in the type map' ); { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); isa_ok($foo->bar, 'My::Bar'); } } # don't give infer enough information # and make it figure it out for itself # including inferring the embedded object { my $c = container 'MyTestContainer' => as { typemap 'My::Foo' => infer; }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); does_ok( $c->get_type_mapping_for('My::Foo'), 'Bread::Board::Service' ); ok(!$c->has_type_mapping_for('My::Bar'), '... we do not have a type mapping for My::Bar'); { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); isa_ok($foo->bar, 'My::Bar'); } } done_testing; 073_typemap_with_role_infer.t100644001750000144 277012243443340 20646 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package Bar::Role; use Moose::Role; package My::Bar; use Moose; with 'Bar::Role'; package My::Foo; use Moose; has 'bar' => ( is => 'ro', does => 'Bar::Role', required => 1, ); } { my $c = container 'MyTestContainer' => as { typemap 'Bar::Role' => infer( class => 'My::Bar' ); typemap 'My::Foo' => infer; }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); does_ok( $c->get_type_mapping_for('My::Foo'), 'Bread::Board::Service' ); ok($c->has_type_mapping_for('Bar::Role'), '... we do have a type mapping for Bar::Role'); does_ok( $c->get_type_mapping_for('Bar::Role'), 'Bread::Board::Service' ); is( $c->get_type_mapping_for('My::Foo')->get_dependency('bar')->service, $c->get_type_mapping_for('Bar::Role'), '... the Bar::Role dependency for My::Foo is the same as in the type map' ); { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); isa_ok($foo->bar, 'My::Bar'); does_ok($foo->bar, 'Bar::Role'); } } { eval { container 'MyTestContainer' => as { typemap 'My::Foo' => infer; } }; my $e = $@; like($e, qr/We can only infer Moose classes\, Bar\:\:Role is a role/, '... needs the param'); } done_testing; Service000755001750000144 012243443340 16753 5ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/BoardAlias.pm100644001750000144 301212243443340 20476 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Servicepackage Bread::Board::Service::Alias; BEGIN { $Bread::Board::Service::Alias::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Service::Alias::VERSION = '0.29'; } use Moose; use Try::Tiny; has aliased_from_path => ( is => 'ro', isa => 'Str', ); has aliased_from => ( is => 'ro', does => 'Bread::Board::Service', lazy => 1, builder => '_build_aliased_from', handles => ['get'], # is this sufficient? ); with 'Bread::Board::Service'; sub _build_aliased_from { my $self = shift; my $path = $self->aliased_from_path; confess "Can't create an alias service without a service to alias from" unless $path; return try { $self->fetch($path); } catch { die "While resolving alias " . $self->name . ": $_"; }; } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::Service::Alias =head1 VERSION version 0.29 =head1 DESCRIPTION No user servicable parts. Read the source if you are interested. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =for Pod::Coverage aliased_from_path aliased_from _build_aliased_from =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 101_clone_w_setter_injection.t100644001750000144 411412243443340 20770 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr); use Bread::Board; { package Test::Class; use Moose; has 'dep' => ( is => 'rw', isa => 'Int' ); } my $board = Bread::Board::Container->new( name => 'app' ); isa_ok($board, 'Bread::Board::Container'); $board->add_service( Bread::Board::SetterInjection->new( name => 'test', class => 'Test::Class', dependencies => { dep => Bread::Board::Dependency->new(service_path => '/dep'), }, ) ); ok($board->has_service('test'), '... got the test service'); isa_ok($board->get_service('test'), 'Bread::Board::SetterInjection'); # clone ... my $board2 = $board->clone; isa_ok($board2, 'Bread::Board::Container'); isnt($board, $board2, '... they are not the same instance'); ok($board2->has_service('test'), '... got the test service'); isa_ok($board2->get_service('test'), 'Bread::Board::SetterInjection'); isnt($board->get_service('test'), $board2->get_service('test'), '... not the same test services'); # add dep services ... $board->add_service( Bread::Board::Literal->new(name => 'dep', value => 1) ); ok($board->has_service('dep'), '... got the dep service'); isa_ok($board->get_service('dep'), 'Bread::Board::Literal'); ok(!$board2->has_service('dep'), '... board2 does not have the dep service'); $board2->add_service( Bread::Board::Literal->new(name => 'dep', value => 2) ); ok($board2->has_service('dep'), '... got the dep service'); isa_ok($board2->get_service('dep'), 'Bread::Board::Literal'); isnt($board->get_service('dep'), $board2->get_service('dep'), '... not the same dep services'); # test them ... is($board->fetch('/dep')->get(), 1, '... got correct dep'); is($board->fetch('/test')->get()->dep, 1, '... test uses dep'); is(refaddr $board->fetch('/test')->parent, refaddr $board, '... got the right board'); is($board2->fetch('/dep')->get(), 2, '... got correct dep'); is($board2->fetch('/test')->get()->dep, 2, '... test uses dep'); is(refaddr $board2->fetch('/test')->parent, refaddr $board2, '... got the right board'); done_testing; 050_parameterized_containers.t100644001750000144 435712243443340 21007 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; { package My::Simple::Logger; use Moose; package My::Database::Logger; use Moose; has ['dsn', 'username', 'password'] => ( is => 'ro', isa => 'Str', required => 1 ); package My::Application; use Moose; has 'log_handle' => ( is => 'ro', isa => 'Object', required => 1 ); } my $simple_logger = container 'SimpleLogger' => as { service 'handle' => ( class => 'My::Simple::Logger' ); }; isa_ok($simple_logger, 'Bread::Board::Container'); my $db_conn_info = container 'DatabaseConnection' => as { service 'dsn' => 'dbi:mysql:foo'; service 'username' => 'bar'; service 'password' => '***'; }; isa_ok($db_conn_info, 'Bread::Board::Container'); my $db_logger = container 'DatabaseLogger' => [ 'DBConnInfo' ] => as { service 'handle' => ( class => 'My::Database::Logger', dependencies => { dsn => depends_on('DBConnInfo/dsn'), username => depends_on('DBConnInfo/username'), password => depends_on('DBConnInfo/password'), } ); }; isa_ok($db_logger, 'Bread::Board::Container::Parameterized'); isnt(exception { $db_logger->fetch('handle') }, undef, '... cannot call fetch on a parameterized container'); my $app = container 'Application' => [ 'Logger' ] => as { service 'app' => ( class => 'My::Application', dependencies => { log_handle => depends_on('Logger/handle') } ); }; isa_ok($app, 'Bread::Board::Container::Parameterized'); isnt(exception { $app->fetch('handle') }, undef, '... cannot call fetch on a parameterized container'); isnt(exception { $app->resolve( service => 'handle') }, undef, '... cannot call resolve on a parameterized container'); my $simple_app = $app->create( Logger => $simple_logger ); isa_ok($simple_app, 'Bread::Board::Container'); isa_ok($simple_app->resolve( service => 'app' )->log_handle, 'My::Simple::Logger'); my $db_app = $app->create( Logger => $db_logger->create( DBConnInfo => $db_conn_info ) ); isa_ok($db_app, 'Bread::Board::Container'); isa_ok($db_app->resolve( service => 'app' )->log_handle, 'My::Database::Logger'); done_testing; 045_parameters_in_dependency.t100644001750000144 312312243443340 20747 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package Serializer; use Moose; has 'format' => ( is => 'ro', isa => 'Str' ); package Application; use Moose; has 'json' => ( is => 'ro', isa => 'Serializer' ); } { my $c = container 'Test' => as { service 'Serializer' => ( class => 'Serializer', parameters => { 'format' => { isa => 'Str' } } ); service 'App' => ( class => 'Application', dependencies => { json => Bread::Board::Dependency->new( service_path => 'Serializer', service_params => { 'format' => 'JSON' } ) } ); }; my $app = $c->resolve( service => 'App' ); isa_ok($app, 'Application'); isa_ok($app->json, 'Serializer'); is($app->json->format, 'JSON', '... got the right format'); } { my $c = container 'Test' => as { service 'Serializer' => ( class => 'Serializer', parameters => { 'format' => { isa => 'Str' } } ); service 'App' => ( class => 'Application', dependencies => { json => { 'Serializer' => { 'format' => 'JSON' } } } ); }; my $app = $c->resolve( service => 'App' ); isa_ok($app, 'Application'); isa_ok($app->json, 'Serializer'); is($app->json->format, 'JSON', '... got the right format'); } done_testing; 046_custom_parameter_service.t100644001750000144 617712243443340 21027 0ustar00doyusers000000000000Bread-Board-0.29/t#!perl use warnings; use strict; use Test::More; use Bread::Board; our $at_underscore; our $params; { package Foo; use Moose; has myattr => ( isa => 'Int', is => 'rw', ); has foo => ( is => 'rw', isa => 'Str', required => 1, ); } { package MyCustomWithParametersService; use Moose::Role; with 'Bread::Board::Service::WithParameters' => { -excludes => '_build_parameters' }; sub _build_parameters { { foo => { isa => 'Str', required => 1, } } } no Moose::Role; } { package MyCustomBlockInjection; use Moose; extends 'Bread::Board::BlockInjection'; with 'MyCustomWithParametersService', 'Bread::Board::Service::WithDependencies'; around get => sub { my $orig = shift; my $self = shift; $at_underscore = \@_; $params = $self->params; return $self->$orig(@_); }; __PACKAGE__->meta->make_immutable; no Moose; } { package MyCustomConstructorInjection; use Moose; extends 'Bread::Board::ConstructorInjection'; with 'Bread::Board::Service::WithClass', 'MyCustomWithParametersService', 'Bread::Board::Service::WithDependencies'; around get => sub { my $orig = shift; my $self = shift; $at_underscore = \@_; $params = $self->params; return $self->$orig(@_); }; __PACKAGE__->meta->make_immutable; no Moose; } my $c = Bread::Board::Container->new( name => 'TestApp' ); $c->add_service( MyCustomConstructorInjection->new( class => 'Foo', name => 'foo_ci', dependencies => { myattr => Bread::Board::Literal->new( name => 'true', value => 1 ) } ) ); $c->add_service( MyCustomBlockInjection->new( block => sub { my $s = shift; my $foo = $s->param('foo_ci'); $foo->myattr(2); return $foo; }, name => 'foo_bi', dependencies => { foo_ci => Bread::Board::Dependency->new( service_path => 'foo_ci', service_params => { foo => 'baz' }, ) }, ) ); eval { $c->resolve(service => 'foo_ci') }; like($@, qr/'foo' missing/, q/Can't resolve foo_ci without mandatory attribute/); ok(my $foo_ci = $c->resolve(service => 'foo_ci', parameters => { foo => 'bar' }), 'got the constructor injection right'); isa_ok($foo_ci, 'Foo'); is_deeply($params, { myattr => 1, foo => 'bar' }, 'params ok'); is_deeply($at_underscore, [ 'foo', 'bar' ], '@_ ok'); $foo_ci->myattr(2); $foo_ci->foo('baz'); eval { $c->resolve(service => 'foo_bi') }; like($@, qr/'foo' missing/, q/Can't resolve foo_bi without mandatory attribute/); ok(my $foo_bi = $c->resolve(service => 'foo_bi', parameters => { foo => 'baz' }), 'got the block injection right'); isa_ok($foo_bi, 'Foo'); is_deeply($params, { foo_ci => $foo_ci, foo => 'baz' }, 'params ok'); is_deeply($at_underscore, [ 'foo', 'baz' ], '@_ ok'); done_testing; 071_typemap_with_basic_infer.t100644001750000144 443712243443340 20766 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package Foo::Role; use Moose::Role; package My::Foo; use Moose; with 'Foo::Role'; } # give infer() enough information to create # the service all by itself ... { my $c = container 'MyTestContainer' => as { typemap 'Foo::Role' => infer( class => 'My::Foo' ); }; ok($c->has_type_mapping_for('Foo::Role'), '... have a type mapping for Foo::Role'); does_ok( $c->get_type_mapping_for('Foo::Role'), 'Bread::Board::Service' ); { my $foo = $c->resolve( type => 'Foo::Role' ); isa_ok($foo, 'My::Foo'); } } # don't give infer enough information # and make it figure it out for itself { my $c = container 'MyTestContainer' => as { typemap 'My::Foo' => infer; }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); does_ok( $c->get_type_mapping_for('My::Foo'), 'Bread::Board::Service' ); { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); } } { my $c = container 'MyTestContainer' => as { typemap 'My::Foo' => infer( dependencies => { thing => service('thing' => 'THING') } ); }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); my $s = $c->get_type_mapping_for('My::Foo'); does_ok($s, 'Bread::Board::Service'); ok($s->has_dependency('thing'), "service_args were passed along"); { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); } } { package My::ConstructorInjection; use Moose; extends 'Bread::Board::ConstructorInjection'; } { my $c = container 'MyTestContainer' => as { typemap 'My::Foo' => infer( My::ConstructorInjection->new( name => 'foo', class => 'My::Foo', ) ); }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); my $s = $c->get_type_mapping_for('My::Foo'); does_ok($s, 'Bread::Board::Service'); isa_ok($s, 'My::ConstructorInjection'); { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); } } done_testing; 041_parameter_cache_handling.t100644001750000144 201612243443340 20663 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; { package Foo; use Moose; has 'bar' => (is => 'ro', isa => 'Int', required => 1); package Bar; use Moose; has 'foo' => (is => 'ro', isa => 'Int', required => 1); } my $c = container 'MyApp' => as { service 'foo' => ( class => 'Foo', parameters => { bar => { isa => 'Int' } } ); service 'bar' => ( class => 'Bar', parameters => { foo => { isa => 'Int' } } ); }; my $foo; is(exception { $foo = $c->resolve( service => 'foo', parameters => { bar => 10 } ); }, undef, '... got the service correctly'); isa_ok($foo, 'Foo'); is($foo->bar, 10, '... got the right parameter value'); my $bar; is(exception { $bar = $c->resolve( service => 'bar', parameters => { foo => 20 } ); }, undef, '... got the service correctly'); isa_ok($bar, 'Bar'); is($bar->foo, 20, '... got the right parameter value'); done_testing; 150_deferred_parameters_fail.t100644001750000144 242512243443340 20717 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; { package Model; use Moose; has [qw(dsn extra_args)] => ( is => 'ro', required => 1, ); } { package UserStore; use Moose; has model => ( is => 'ro', isa => 'Model', required => 1, ); } my $c = container 'MyApp' => as { service model_dsn => 'foo:bar'; service model => ( class => 'Model', lifecycle => 'Singleton', parameters => { extra_args => { default => { create => 1, user => 'foo', password => 'bar', }, }, }, dependencies => { dsn => depends_on('model_dsn'), }, ); service user_store => ( class => 'UserStore', lifecycle => 'Singleton', dependencies => { model => depends_on('/model'), }, ); }; my $store; is(exception { $store = $c->fetch('/user_store')->get; }, undef, '... deferred parameters that have defaults should pass through too'); is($store->model->dsn, 'foo:bar', '... got the right default values'); done_testing; BlockInjection.pm100644001750000144 223712243443340 20752 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::BlockInjection; BEGIN { $Bread::Board::BlockInjection::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::BlockInjection::VERSION = '0.29'; } use Moose; with 'Bread::Board::Service::WithParameters', 'Bread::Board::Service::WithDependencies', 'Bread::Board::Service::WithClass'; has 'block' => ( is => 'rw', isa => 'CodeRef', required => 1, ); sub get { my $self = shift; $self->block->($self) } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::BlockInjection =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 074_typemap_w_recursive_infer.t100644001750000144 153712243443340 21210 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package My::Foo; use Moose; has 'bar' => ( is => 'ro', isa => 'My::Bar', required => 1 ); package My::Bar; use Moose; has 'foo' => ( is => 'ro', isa => 'My::Foo', required => 1 ); } { my $c = container 'MyTestContainer' => as { typemap 'My::Foo' => infer; }; ok($c->has_type_mapping_for('My::Foo'), '... have a type mapping for My::Foo'); { my $foo = $c->resolve( type => 'My::Foo' ); isa_ok($foo, 'My::Foo'); isa_ok($foo->bar, 'My::Bar'); } { my $bar = $c->resolve( service => 'type:My::Bar' ); isa_ok($bar, 'My::Bar'); isa_ok($bar->foo, 'My::Foo'); } } done_testing; 152_sugar_service_inheritance.t100644001750000144 641612243443340 21141 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; { package Thing; use Moose; has foo => (is => 'ro', required => 1); has moo => (is => 'ro', required => 1); no Moose; __PACKAGE__->meta->make_immutable; } { package TestThing; use Moose; extends 'Thing'; has bar => (is => 'ro', required => 1); has kooh => (is => 'ro', required => 1); no Moose; __PACKAGE__->meta->make_immutable; } { my $c = container 'MyApp' => as { service foo => 42; service thing => ( class => 'Thing', dependencies => [depends_on('foo')], parameters => { moo => { isa => 'Int' }, }, ); }; { my $t = $c->resolve( service => 'thing', parameters => { moo => 123, }, ); isa_ok $t, 'Thing'; is $t->foo, 42; is $t->moo, 123; } container $c => as { service bar => 23; service '+thing' => ( class => 'TestThing', dependencies => [depends_on('bar')], parameters => ['kooh'], ); }; { my $t = $c->resolve( service => 'thing', parameters => { moo => 123, kooh => 456, }, ); isa_ok $t, 'TestThing'; is $t->foo, 42; is $t->moo, 123; is $t->bar, 23; is $t->kooh, 456; } } { my $parameterized = container MyApp => ['Config'] => as { service foo => (block => sub { 42 }); }; container $parameterized => as { service '+foo' => (block => sub { 23 }); }; my $c = $parameterized->create(Config => container Config => as {}); is $c->resolve(service => 'foo'), 23; } like exception { service '+foo' => 42; }, qr/^Service inheritance doesn't make sense for literal services/; like exception { container Foo => as { container foo => as {}; service '+foo' => (block => sub { 42 }); }; }, qr/^Trying to inherit from service 'foo', but found a Bread::Board::Container/; like exception { container Foo => as { service foo => 42; service '+foo' => (block => sub { 123 }); }; }, qr/^Trying to inherit from a literal service/; { package Bread::Board::FooInjection; use Moose; extends 'Bread::Board::Literal'; no Moose; } like exception { container Foo => as { service foo => (block => sub { 123 }); service '+foo' => (service_class => 'Bread::Board::FooInjection'); }; }, qr/^Changing a service's class is not possible when inheriting/; like exception { container Foo => as { service foo => (block => sub { 123 }); service '+foo' => (service_type => 'Foo'); }; }, qr/^Changing a service's class is not possible when inheriting/; { package Foo; use Moose; no Moose; } like exception { container Foo => as { service foo => (block => sub { 123 }); service '+foo' => (class => 'Foo'); }; }, qr/^/; like exception { container Foo => as { service foo => (class => 'Foo'); service '+foo' => (block => sub { 123 }); }; }, qr/^/; done_testing; SetterInjection.pm100644001750000144 221112243443340 21156 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::SetterInjection; BEGIN { $Bread::Board::SetterInjection::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::SetterInjection::VERSION = '0.29'; } use Moose; use Bread::Board::Types; with 'Bread::Board::Service::WithClass', 'Bread::Board::Service::WithParameters', 'Bread::Board::Service::WithDependencies'; has '+class' => (required => 1); sub get { my $self = shift; my $o = $self->class->new; $o->$_($self->param($_)) foreach $self->param; return $o; } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::SetterInjection =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Manual000755001750000144 012243443340 16570 5ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/BoardExample.pod100644001750000144 241612243443340 21032 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Manual# PODNAME: Bread::Board::Manual::Example # ABSTRACT: A set of examples of Bread::Board usage __END__ =pod =head1 NAME Bread::Board::Manual::Example - A set of examples of Bread::Board usage =head1 VERSION version 0.29 =head1 DESCRIPTION The goal of this set of documents it to provide examples of how you can use Bread::Board in different situations. It is still pretty raw and sparse right now, but more will come soon. Each example attempts to show a real world problem and how one might go about solving it with Bread::Board. These examples are currently are born out of discussions I had with people about how they might be able to utilize Bread::Board. =over 4 =item L An example of how to get more dynamic behavior for your dependencies. =item L An example of using parameterized containers and dynamic dependencies together to build a set of re-usable components within an application. =back =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 302_path_traversal_deprecation.t100644001750000144 67112243443340 21275 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/env perl use strict; use warnings; use Test::More; use Bread::Board; my $c = container 'Foo' => as { service bar => 'baz'; }; { my $warning; local $SIG{__WARN__} = sub { $warning = $_[0] }; my $baz = $c->resolve(service => '/Foo/bar'); is($baz, 'baz'); like($warning, qr/Traversing into the current container \(Foo\) is deprecated; you should remove the Foo component from the path/); } done_testing; 012_container_with_shared_deps.t100644001750000144 305312243443340 21272 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board::Container; use Bread::Board::ConstructorInjection; use Bread::Board::BlockInjection; use Bread::Board::Literal; { package DBH; use Moose; has ['dsn', 'user', 'pass'] => (is => 'ro', required => 1); } my $c = Bread::Board::Container->new( name => 'Model', services => [ Bread::Board::ConstructorInjection->new( name => 'schema', class => 'My::App::Schema', dependencies => { dsn => Bread::Board::Literal->new(name => 'dsn', value => ''), user => Bread::Board::Literal->new(name => 'user', value => ''), pass => Bread::Board::Literal->new(name => 'pass', value => ''), }, ), Bread::Board::BlockInjection->new( name => 'dbh', block => sub { my $s = shift; DBH->new( dsn => $s->param('dsn'), user => $s->param('user'), pass => $s->param('pass'), ) }, dependencies => { dsn => Bread::Board::Dependency->new(service_path => 'schema/dsn'), user => Bread::Board::Dependency->new(service_path => 'schema/user'), pass => Bread::Board::Dependency->new(service_path => 'schema/pass'), }, ) ] ); my $s = $c->fetch('dbh'); does_ok($s, 'Bread::Board::Service'); my $dbh = $s->get; isa_ok($dbh, 'DBH'); done_testing; 052_parameterized_in_hierarchy.t100644001750000144 257412243443340 21307 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; { package My::Database::Handle; use Moose; has ['dsn', 'username', 'password'] => ( is => 'ro', isa => 'Str', required => 1 ); } my $utils = container 'Utils' => as { container 'Database' => [ 'DBConnInfo' ] => as { service 'handle' => ( class => 'My::Database::Handle', dependencies => { dsn => depends_on('DBConnInfo/dsn'), username => depends_on('DBConnInfo/username'), password => depends_on('DBConnInfo/password'), } ); }; }; isa_ok($utils, 'Bread::Board::Container'); my $db_conn_info = container 'DatabaseConnection' => as { service 'dsn' => 'dbi:mysql:foo'; service 'username' => 'bar'; service 'password' => '***'; }; isa_ok($db_conn_info, 'Bread::Board::Container'); my $db = $utils->fetch('Database'); isa_ok($db, 'Bread::Board::Container::Parameterized'); isnt(exception { $utils->fetch('Database')->fetch('handle'); }, undef, '... cannot fetch on a parameterized container'); isnt(exception { $utils->fetch('Database/handle'); }, undef, '... cannot fetch within a parameterized container'); my $dbh = $db->create( DBConnInfo => $db_conn_info )->resolve( service => 'handle' ); isa_ok($dbh, 'My::Database::Handle'); done_testing; Inferred.pm100644001750000144 1574312243443340 21241 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Servicepackage Bread::Board::Service::Inferred; BEGIN { $Bread::Board::Service::Inferred::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Service::Inferred::VERSION = '0.29'; } use Moose; use Moose::Util::TypeConstraints 'find_type_constraint'; use Try::Tiny; use Bread::Board::Types; use Bread::Board::ConstructorInjection; has 'current_container' => ( is => 'ro', isa => 'Bread::Board::Container', required => 1, ); has 'service' => ( is => 'ro', isa => 'Bread::Board::ConstructorInjection', predicate => 'has_service', ); has 'service_args' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { +{} } ); has 'infer_params' => ( is => 'ro', isa => 'Bool', default => sub { 0 }, ); sub infer_service { my $self = shift; my $type = shift; my $seen = shift || {}; my $type_constraint = find_type_constraint( $type ); my $current_container = $self->current_container; # the type must exist ... (defined $type_constraint) || confess "$type is not an existing valid Moose type"; # the type must be either # a class type, or a subtype # of object. ($type_constraint->isa('Moose::Meta::TypeConstraint::Class') || $type_constraint->is_subtype_of('Object')) || confess 'Only class types, role types, or subtypes of Object can be inferred. ' . 'I don\'t know what to do with type (' . $type_constraint->name . ')'; my %params = ( name => 'type:' . $type, ); if ($self->has_service) { my $service = $self->service; %params = ( %params, name => $service->name, class => $service->class, dependencies => $service->dependencies, parameters => $service->parameters, ); } else { %params = ( %params, %{ $self->service_args } ); } # if the class is specified, then # we can use that reliably, otherwise # we need to try and figure out the # class name ... unless ( exists $params{'class'} ) { # if it is a class type, it is easy if ($type_constraint->isa('Moose::Meta::TypeConstraint::Class')) { $params{'class'} = $type_constraint->class; } # if it is not a class type, then # we will make the assumption that # the name of the type constraint # is also the name of the class. else { $params{'class'} = $type_constraint->name; } } my $meta = Class::MOP::class_of($params{'class'}) || confess "Could not get the meta object for class(" . $params{'class'} . ")"; ($meta->isa('Moose::Meta::Class')) || confess "We can only infer Moose classes" . ($meta->isa('Moose::Meta::Role') ? (', ' . $meta->name . ' is a role and therefore not concrete enough') : ''); my @required_attributes = grep { $_->is_required && $_->has_type_constraint } $meta->get_all_attributes; $params{'dependencies'} ||= {}; $params{'parameters'} ||= {}; # defer this for now ... $seen->{ $type } = $params{'name'}; foreach my $attribute (@required_attributes) { my $name = $attribute->name; next if exists $params{'dependencies'}->{ $name }; my $type_constraint = $attribute->type_constraint; my $type_name = $type_constraint->isa('Moose::Meta::TypeConstraint::Class') ? $type_constraint->class : $type_constraint->name; my $service; if ($current_container->has_type_mapping_for( $type_name )) { $service = $current_container->get_type_mapping_for( $type_name ) } elsif ( exists $seen->{ $type_name } ) { if ( blessed($seen->{ $type_name }) ) { # if the type has already been # inferred, then we use it $service = $seen->{ $type_name }; } else { # if not, then we have to use # the built in laziness and # make it a dependency $service = Bread::Board::Dependency->new( service_path => $seen->{ $type_name } ); } } else { if ( $type_constraint->isa('Moose::Meta::TypeConstraint::Class') || $type_constraint->is_subtype_of('Object') ) { $service = Bread::Board::Service::Inferred->new( current_container => $self->current_container )->infer_service( $type_name, $seen ); } else { if ($self->infer_params) { $params{'parameters'}->{ $name } = { isa => $type_name }; } else { confess 'Only class types, role types, or subtypes of Object can be inferred. ' . 'I don\'t know what to do with type (' . $type_name . ')'; } } } $params{'dependencies'}->{ $name } = $service if defined $service; } if ( $self->infer_params ) { map { $params{'parameters'}->{ $_->name } = { optional => 1, ($_->has_type_constraint ? ( isa => $_->type_constraint ) : ()) }; } grep { ( not $_->is_required ) } $meta->get_all_attributes } # NOTE: # this is always going to be # constructor injection because # that is what we do when we # infer. No other type of # injection makes sense here. # - SL my $service; if ($self->has_service) { $service = $self->service->clone(%params); } else { $service = Bread::Board::ConstructorInjection->new(%params); } # NOTE: # We need to do this so that # anything created by a typemap # can still also refer back to # an actual service in the parent # container. # - SL $self->current_container->add_service( $service ); $service; } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::Service::Inferred =head1 VERSION version 0.29 =head1 DESCRIPTION CAUTION, EXPERIMENTAL FEATURE. Docs to come, as well as refactoring. =head1 METHODS =over 4 =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Deferred.pm100644001750000144 606012243443340 21173 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Servicepackage Bread::Board::Service::Deferred; BEGIN { $Bread::Board::Service::Deferred::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Service::Deferred::VERSION = '0.29'; } use Moose (); use overload # cover your basic operatins ... 'bool' => sub { 1 }, '""' => sub { $_[0] = $_[0]->{service}->get; if (my $func = overload::Method($_[0], '""')) { return $_[0]->$func(); } return overload::StrVal($_[0]); }, # cover your basic dereferncers '%{}' => sub { return $_[0] if (caller)[0] eq 'Bread::Board::Service::Deferred'; $_[0] = $_[0]->{service}->get; $_[0] }, '@{}' => sub { $_[0] = $_[0]->{service}->get; $_[0] }, '${}' => sub { $_[0] = $_[0]->{service}->get; $_[0] }, '&{}' => sub { $_[0] = $_[0]->{service}->get; $_[0] }, '*{}' => sub { $_[0] = $_[0]->{service}->get; $_[0] }, ## and as a last ditch resort ... nomethod => sub { $_[0] = $_[0]->{service}->get; return overload::StrVal($_[0]) if $_[3] eq '""' && !overload::Method($_[0], $_[3]); if (my $func = overload::Method($_[0], $_[3])) { return $_[0]->$func($_[1]); } return $_[0]; # if all else fails, just return the object }, ; sub new { my ($class, %params) = @_; (Scalar::Util::blessed($params{service}) && $params{service}->does('Bread::Board::Service')) || Carp::confess "You can only defer Bread::Board::Service instances"; bless { service => $params{service} } => $class; } sub meta { if ($_[0]->{service}->can('class')) { my $class = $_[0]->{service}->class; return $class->meta; } $_[0] = $_[0]->{service}->get; (shift)->meta; } sub can { if ($_[0]->{service}->can('class')) { my $class = $_[0]->{service}->class; return $class->can($_[1]); } $_[0] = $_[0]->{service}->get; (shift)->can(shift); } sub isa { if ($_[0]->{service}->can('class')) { my $class = $_[0]->{service}->class; return 1 if $class eq $_[1]; return $class->isa($_[1]); } $_[0] = $_[0]->{service}->get; (shift)->isa(shift); } sub DESTROY { (shift)->{service} = undef } sub AUTOLOAD { my ($subname) = our $AUTOLOAD =~ /([^:]+)$/; $_[0] = $_[0]->{service}->get; my $func = $_[0]->can($subname); (ref($func) eq 'CODE') || Carp::confess "You cannot call '$subname'"; goto &$func; } 1; __END__ =pod =head1 NAME Bread::Board::Service::Deferred =head1 VERSION version 0.29 =head1 DESCRIPTION No user servicable parts. Read the source if you are interested. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =for Pod::Coverage can isa meta new =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Concepts.pod100644001750000144 4327312243443340 21243 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Manual# PODNAME: Bread::Board::Manual::Concepts # ABSTRACT: An overview of the concepts in Bread::Board __END__ =pod =head1 NAME Bread::Board::Manual::Concepts - An overview of the concepts in Bread::Board =head1 VERSION version 0.29 =head1 INTRODUCTION This document attempts to convey the central concepts of Bread::Board and show how they work together to manage both object lifecycles and object dependencies. In this document we use the raw OO syntax of Bread::Board, this is so that the concepts being illustrated are not clouded by syntactic sugar. We only introduce the I layer at the end, at which point we hope that it will become clear what is going on "under the hood" when you use it. =head1 CONCEPTS =head2 What is Inversion of Control? Inversion of Control (or IoC) is the very simple idea of releasing control of some part of your application over to some other part of your application, be it your code or an outside framework. IoC is a common paradigm in GUI frameworks, whereby you give up control of your application flow to the framework and install your code at callbacks hooks within the framework. For example, take a very simple command line interface; the application asks a question, the user responds, the application processes the answer and asks another question, and so on until it is done. Now consider the GUI approach for the same application; the application displays a screen and goes into an event loop, users actions are processed with event handlers and callback functions. The GUI framework has inverted the control of the application flow and relieved your code from having to deal with it. IoC is also sometimes referred to as 'Dependency Injection' or the 'Dependency Injection Principle', and many people confused the two. However IoC and dependency injection are not the same, in fact the concepts behind dependency injection are actually just an I IoC principles in action, in particular about your applications dependency relationships. IoC is also sometimes referred to as the Hollywood Principle because of the I approach of things like callback functions and event handlers. Howard Lewis Ship, the creator of the HiveMind IoC Framework, once referred to dependency injection as being the inverse of garbage collection. With garbage collection you hand over the details of the destruction of your objects to the garbage collector. With dependency injection you are handing over control of object creation, which also includes the satisfaction of your dependency relationships. The following sections will explain the basis concepts around the Bread::Board and how it relates to the concept of IoC. =head2 Containers The central part of just about any IoC framework is the container. A container's responsibilities are roughly to dispense services and to handle the resolution of said service's dependency relationships. First we can start with a simple container for our services to live in. We give the container a name so that we can address it later on, think of this like a package namespace. my $c = Bread::Board::Container->new( name => 'Application' ); Next we need to add a service to that container (we will explain services a little later on). $c->add_service( Bread::Board::BlockInjection->new( name => 'logger', block => sub { Logger->new() } ) ); Now if we want an instance of our 'logger' service, we simply ask the container for it. my $logger_service = $c->fetch('logger'); And we then can ask the service to give us an instance of our Logger object. my $logger = $logger_service->get; Or if we want to make this even simpler we can use the C method of the container object. my $logger = $c->resolve( service => 'logger' ); The C method will look up the service asked for and return the instance, which is basically equivalent to the chained C and C calls above. =head2 Dependency Management Dependency management is also quite simple, and is easily shown with an example. But first lets create another component for our container, a database connection. $c->add_service( Bread::Board::BlockInjection->new( name => 'db_conn', block => sub { DBI->connect('dbi:mysql:test', '', '') } ) ); Now lets add an authenticator to our container. The authenticator requires both a database connection and a logger instance in its constructor. We specify dependency relationships between services by providing a HASH of Bread::Board::Dependency objects which themselves have a path to the services they depend upon. In this case since all these services are in the same container, the service path is simply the name. $c->add_service( Bread::Board::BlockInjection->new( name => 'authenticator', block => sub { my $service = shift; Authenticator->new( db_conn => $service->param('db_conn'), logger => $service->param('logger') ); }, dependencies => { db_conn => Bread::Board::Dependency->new( service_path => 'db_conn' ), logger => Bread::Board::Dependency->new( service_path => 'logger' ), } ) ); As you can see, the first argument to our service subroutine is actually our service instance. Through this we can access the resolved dependencies and use them in our Authenticator object's constructor. The above example is deceptively simple, but really powerful. What you don't see on the surface is that Bread::Board is completely managing initialization order for you. No longer to do you need to worry if your database is connected or your logger initialized and in what order you need to do that initialization, Bread::Board handles that all for you, including circular dependencies. This may not seem terribly interesting in such a small example, but the larger an application grows, the more sensitive it becomes to these kinds of initialization order issues. =head2 Lifecycle Management The default lifecycle for Bread::Board::Service components is a 'prototype' lifecycle, which means each time we ask for say, the logger, we will get a new instance back. There is also another option for lifecycle management that we call 'Singleton'. Here is an example of how we would use the 'Singleton' lifecycle to ensure that you always get back the same logger instance. $c->add_service( Bread::Board::BlockInjection->new( lifecycle => 'Singleton', name => 'logger', block => sub { Logger->new() } ) ); Now each time we request a new logger component from our container we will get the exact same instance. Being able to change between the different lifecycles by simply changing one service parameter can come in very handy as you application grows. Extending this idea, it is possible to see how you could create your own custom service objects to manage your specific lifecycle needs, such as a pool of database connections. =head2 Services Up until now, we have shown the default way of creating a service by using the Bread::Board::BlockInjection and an anonymous subroutine. But this is not the only way to go about this. Those who have encountered IoC in the Java world may be familiar with the idea that there are 3 'types' of IoC/Dependency Injection; Constructor Injection, Setter Injection, and Interface Injection. In Bread::Board we support both Constructor and Setter injection, it is the authors opinion though that Interface injection was not only too complex, but highly java specific and the concept did not adapt itself well to perl. =over 4 =item Block Injection While not in the 'official' 3 types (mostly because it's not possible in Java), but found in a few Ruby IoC frameworks, BlockInjection is by far the most versatile type. It simply requires a subroutine and a name and you do all the rest of it yourself. $c->add_service( Bread::Board::BlockInjection->new( name => 'logger', class => 'ComplexLogger', block => sub { my $s = shift; my $l = ComplexLogger->new( file => $s->param('log_file') ); $l->init_with_timezone( $s->param('timezone') ); $l->log_timestamp; $l; }, dependencies => { log_file => Bread::Board::Dependency->new( service_path => 'log_file' ), timezone => Bread::Board::Dependency->new( service_path => 'timezone' ), } ) ); BlockInjection comes in really handy when your object requires more then just constructor parameters and needs some more complex initialization code. As long as your subroutine block returns an object, everything else is fair game. Also note the optional 'class' parameter, which when supplied will perform a basic type check on the result of the subroutine block. =item Constructor Injection Bread::Board also supports Constructor Injection. With constructor injection, the service calls the class's constructor and feeds it the dependencies you specify. This promotes what is called a "Good Citizen" object, or an object who is completely initialized upon construction. $c->add_service( Bread::Board::ConstructorInjection->new( name => 'authenticator', class => 'Authenticator', dependencies => { db_conn => Bread::Board::Dependency->new( service_path => 'db_conn' ), logger => Bread::Board::Dependency->new( service_path => 'logger' ), } ) ); Since Bread::Board is built both with L and for use with L objects, it makes the assumption here that the constructor takes named arguments. Here is our earlier authenticator service rewritten to use constructor injection. This is by far the simplest injection type as it requires little more then a class name and a HASH of dependencies. =item Setter Injection Bread::Board also supports Setter Injection. The idea behind setter injection is that for each component dependency a corresponding setter method must exist. This style has been popularized by the Spring java framework. I will be honest, I don't find this type of injection as useful as block of constructor, but it can come in handy if your object prefers you to call setters to initialize it. Here is a fairly contrived example using the L module. $c->add_service( Bread::Board::SetterInjection->new( name => 'json', class => 'JSON', dependencies => { utf8 => Bread::Board::Literal->new( name => 'true', value => 1 ) pretty => Bread::Board::Literal->new( name => 'true', value => 1 ) } ) ); Setter injection actually creates the object without passing any arguments to the constructor, then loops through the keys in the dependency HASH and treats each key as a method name, and each value as that method's argument. In this case, the above is the equivalent of doing: my $json = JSON->new; $json->utf8(1); $json->pretty(1); You might have been wondering about the fact we didn't specify Bread::Board::Dependency objects in our dependency HASH, but instead supplied Bread::Board::Literal instances. Bread::Board::Literal is just another Service type that simply holds a literal value, or a constant. When dependencies are specified like this, Bread::Board internally converts them into Bread::Board::Dependency whose service is already resolved to that service. =back =head2 Hierarchal Containers Up until now, we have seen basic containers which only have a single level of components. As your application grows larger it may become useful to have a more hierarchal approach to your containers. Bread::Board::Container supports this behavior through its many subcontainer methods. Here is an example of how we might re-arrange the previous examples using subcontainers. my $app_c = Bread::Board::Container->new( name => 'app' ); my $db_c = Bread::Board::Container->new( name => 'database' ); $db_c->add_service( Bread::Board::BlockInjection->new( name => 'db_conn' block => sub { my $s = shift; return DBI->connect( $s->param('dsn'), $s->param('username'), $s->param('password') ); }, dependencies => { dsn => Bread::Board::Literal->new( name => 'dsn', value => 'dbi:mysql:test' ), username => Bread::Board::Literal->new( name => 'username', value => 'user' ), password => Bread::Board::Literal->new( name => 'password', value => '****' ), } ) ); $app_c->add_sub_container( $db_c ); my $log_c = Bread::Board::Container->new( name => 'logging' ); $log_c->add_service( Bread::Board::Literal->new( name => 'log_file', value => '/var/log/app.log' ) ); $log_c->add_service( Bread::Board::ConstructorInjection->new( name => 'logger', class => 'Logger', dependencies => { log_file => Bread::Board::Dependency->new( service_path => 'log_file' ) } ) ); $app_c->add_sub_container( $log_c ); my $sec_c = Bread::Board::Container->new( name => 'security' ); $sec_c->add_service( Bread::Board::ConstructorInjection->new( name => 'authenticator', class => 'Authenticator', dependencies => { db_conn => Bread::Board::Dependency->new( service_path => '../database/db_conn' ), logger => Bread::Board::Dependency->new( service_path => '../logging/logger' ), } ) ); $app_c->add_sub_container( $sec_c ); $app_c->add_service( Bread::Board::ConstructorInjection->new( name => 'app', class => 'Application', dependencies => { auth => Bread::Board::Dependency->new( service_path => '/security/authenticator' ), db_conn => Bread::Board::Dependency->new( service_path => '/database/db_conn' ), logger => Bread::Board::Dependency->new( service_path => '/logging/logger' ), } ) ); So, as an example that can be seen above, hierarchal containers can be used as a form of namespacing to organize your Bread::Board configuration better. As it is shown with the 'authenticator' service, it is possible to address services outside of your container using path notation. In this case the 'authenticator' service makes the assumption that its parent container has both a 'database' and a 'logging' sub-container and they contain a 'db_conn' and 'logger' service respectively. And as is shown in the 'app' service, it is also possible to address services using an absolute path notation. =head2 Sugar Layer So, up until now we have been creating all our Bread::Board objects by hand. As you can tell, this is both verbose and tedious. To make your life easier, Bread::Board provides a simple I layer over these objects. Here is the equivalent of the above Bread::Board configuration using the sugar layer. my $c = container 'app' => as { container 'database' => as { service 'db_conn' => ( block => sub { my $s = shift; return DBI->connect( $s->param('dsn'), $s->param('username'), $s->param('password') ); }, dependencies => { dsn => ( service 'dsn' => 'dbi:mysql:test' ), username => ( service 'username' => 'user' ), password => ( service 'password' => '****' ), } ) }; container 'logging' => as { service 'log_file' => '/var/log/app.log'; service 'logger' => ( class => 'Logger', dependencies => { log_file => depends_on('log_file'), } ) }; container 'security' => as { service 'authenticator' => ( class => 'Authenticator', dependencies => { db_conn => depends_on('../database/db_conn'), logger => depends_on('../logging/logger'), } ) }; service 'app' => ( class => 'Application', dependencies => { auth => depends_on('/security/authenticator'), db_conn => depends_on('/database/db_conn'), logger => depends_on('/logging/logger'), } ) }; As you can see this not only makes the code shorter, but more declarative and easier to read. =head1 SEE ALSO This article is based on an article I wrote for The Perl Journal about my earlier L module. That article can be found online at L. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 153_sugar_container_inheritance.t100644001750000144 526112243443340 21461 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; { my $c = container Foo => as { container Bar => as { service baz => 21; }; container Moo => ['Bar'] => as { service kooh => ( block => sub { my ($s) = @_; $s->param('baz') * 2; }, dependencies => { baz => depends_on('Bar/baz'), }, ); }; }; container $c => as { container '+Bar' => as { service bif => 123; }; container '+Moo' => as { service boo => ( block => sub { my ($s) = @_; $s->param('a') + $s->param('b'); }, dependencies => { a => depends_on('kooh'), b => depends_on('Bar/bif'), }, ); }; }; is $c->resolve(service => 'Bar/baz'), 21; is $c->resolve(service => 'Bar/bif'), 123; my $p = $c->fetch('Moo')->create(Bar => $c->fetch('Bar')); is $p->resolve(service => 'kooh'), 42; is $p->resolve(service => 'boo'), 165; like exception { container '+Foo' => as {}; }, qr/^Inheriting containers isn't possible outside of the context of a container/; like exception { container $c => as { container '+Buf' => as {}; }; }, qr/^Could not find container or service for Buf in Foo/; like exception { container $c => as { container '+Buf' => ['Moo'] => as {}; }; }, qr/^Declaring container parameters when inheriting is not supported/; } { { package Thing; use Moose; has bar => (is => 'ro', required => 1); no Moose; } { package TestThing; use Moose; extends 'Thing'; no Moose; } my $c = container Foo => as { service bar => 42; container Moo => as { container Kooh => as { service boo => ( class => 'Thing', dependencies => { bar => '../../bar', }, ); }; }; }; isa_ok $c->resolve(service => 'Moo/Kooh/boo'), 'Thing'; is $c->resolve(service => 'Moo/Kooh/boo')->bar, 42; container $c => as { container '+Moo/Kooh' => as { service '+boo' => (class => 'TestThing'); }; }; isa_ok $c->resolve(service => 'Moo/Kooh/boo'), 'TestThing'; is $c->resolve(service => 'Moo/Kooh/boo')->bar, 42; } done_testing; 004_block_injection_w_out_class.t100644001750000144 146412243443340 21457 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Scalar::Util 'blessed'; use Bread::Board::BlockInjection; use Bread::Board::Literal; my $s = Bread::Board::BlockInjection->new( name => 'NoClass', block => sub { my $s = shift; return +{ foo => $s->param('foo') } }, dependencies => { foo => Bread::Board::Literal->new( name => 'foo', value => 'FOO' ) } ); isa_ok($s, 'Bread::Board::BlockInjection'); does_ok($s, 'Bread::Board::Service::WithDependencies'); does_ok($s, 'Bread::Board::Service::WithParameters'); does_ok($s, 'Bread::Board::Service'); my $x = $s->get; ok( !blessed($x), '... the result of the block injection is not blessed'); is_deeply($x, { foo => 'FOO' }, '... block injections can return unblessed values'); done_testing; WithClass.pm100644001750000144 212612243443340 21353 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Servicepackage Bread::Board::Service::WithClass; BEGIN { $Bread::Board::Service::WithClass::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Service::WithClass::VERSION = '0.29'; } use Moose::Role; use Bread::Board::Types; with 'Bread::Board::Service'; has 'class' => ( is => 'rw', isa => 'Str', predicate => 'has_class', ); before 'get' => sub { my $self = shift; Class::MOP::load_class($self->class) if $self->has_class; }; no Moose::Role; 1; __END__ =pod =head1 NAME Bread::Board::Service::WithClass =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 077_more_complex_typemap_w_roles.t100644001750000144 765412243443340 21724 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { # Abstract items ... package Desk; use Moose::Role; package Chair; use Moose::Role; package WorkArea; use Moose::Role; has 'desk' => ( is => 'ro', does => 'Desk', required => 1, ); has 'chair' => ( is => 'ro', does => 'Chair', required => 1, ); } # crappy stuff { package CheapMetalDesk; use Moose; with 'Desk'; package CheapOfficeChair; use Moose; with 'Chair'; package Cubicle; use Moose; with 'WorkArea'; } # good stuff { package NiceWoodenDesk; use Moose; with 'Desk'; package AeronChair; use Moose; with 'Chair'; package Office; use Moose; with 'WorkArea'; } { package Employee; use Moose; has [ 'first_name', 'last_name' ] => ( is => 'ro', isa => 'Str', required => 1, ); has 'work_area' => ( is => 'ro', does => 'WorkArea', required => 1, ); package Manager; use Moose; extends 'Employee'; has '+work_area' => ( isa => 'Office' ); } my $c = container 'Initech' => as { # Employees ... typemap 'Desk' => infer( class => 'CheapMetalDesk' ); typemap 'Chair' => infer( class => 'CheapOfficeChair' ); typemap 'WorkArea' => infer( class => 'Cubicle' ); # Managers ... service 'managers_desk' => (class => 'NiceWoodenDesk'); service 'managers_chair' => (class => 'AeronChair'); typemap 'Office' => infer( dependencies => { desk => depends_on('managers_desk'), chair => depends_on('managers_chair') } ); typemap 'Employee' => infer; typemap 'Manager' => infer; }; my $micheal = $c->resolve( type => 'Employee', parameters => { first_name => 'Micheal', last_name => 'Bolton' } ); my $samir = $c->resolve( type => 'Employee', parameters => { first_name => 'Samir', last_name => 'Nagheenanajar' } ); isa_ok($micheal, 'Employee'); is($micheal->first_name, 'Micheal', '... got the right first name'); is($micheal->last_name, 'Bolton', '... got the right last name'); does_ok($micheal->work_area, 'WorkArea'); isa_ok($micheal->work_area, 'Cubicle'); does_ok($micheal->work_area->desk, 'Desk'); isa_ok($micheal->work_area->desk, 'CheapMetalDesk'); does_ok($micheal->work_area->chair, 'Chair'); isa_ok($micheal->work_area->chair, 'CheapOfficeChair'); isa_ok($samir, 'Employee'); is($samir->first_name, 'Samir', '... got the right first name'); is($samir->last_name, 'Nagheenanajar', '... got the right last name'); does_ok($samir->work_area, 'WorkArea'); isa_ok($samir->work_area, 'Cubicle'); does_ok($samir->work_area->desk, 'Desk'); isa_ok($samir->work_area->desk, 'CheapMetalDesk'); does_ok($samir->work_area->chair, 'Chair'); isa_ok($samir->work_area->chair, 'CheapOfficeChair'); isnt($micheal, $samir, '... two different employees'); isnt($micheal->work_area, $samir->work_area, '... two different cubicles'); isnt($micheal->work_area->chair, $samir->work_area->chair, '... two different cubicle chairs'); isnt($micheal->work_area->desk, $samir->work_area->desk, '... two different cubicle desks'); # managers my $lundberg = $c->resolve( type => 'Manager', parameters => { first_name => 'Bill', last_name => 'Lundberg' } ); isa_ok($lundberg, 'Manager'); is($lundberg->first_name, 'Bill', '... got the right first name'); is($lundberg->last_name, 'Lundberg', '... got the right last name'); does_ok($lundberg->work_area, 'WorkArea'); isa_ok($lundberg->work_area, 'Office'); does_ok($lundberg->work_area->desk, 'Desk'); isa_ok($lundberg->work_area->desk, 'NiceWoodenDesk'); does_ok($lundberg->work_area->chair, 'Chair'); isa_ok($lundberg->work_area->chair, 'AeronChair'); done_testing; 051_more_parameterized_containers.t100644001750000144 732312243443340 22026 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Bread::Board; { package My::Form; use Moose; has 'fields' => ( is => 'ro', isa => 'ArrayRef[My::Form::Field]', required => 1 ); has 'state' => ( is => 'ro', isa => 'HashRef', required => 1, ); package My::Form::Field; use Moose; has 'name' => ( is => 'ro', isa => 'Str', required => 1, ); package My::Form::Field::Text; use Moose; extends 'My::Form::Field'; has 'validations' => ( is => 'ro', isa => 'RegexpRef', required => 1, ); package My::Form::Field::Select; use Moose; extends 'My::Form::Field'; has 'options' => ( is => 'ro', isa => 'ArrayRef[HashRef]', required => 1, ); package My::Model; use Moose; sub get_all_states { return [ { value => 'CT', name => 'Connecticut' }, { value => 'CO', name => 'Colorado' }, { value => 'CA', name => 'California' }, ] } } my $FormBuilder = container 'Form' => [ 'Fields' ] => as { service 'form' => ( class => 'My::Form', block => sub { my $s = shift; my $c = $s->parent->get_sub_container('Fields'); return My::Form->new( state => $s->param('state'), fields => [ map { $c->fetch( $_ )->get; } reverse sort $c->get_service_list ] ); }, parameters => { state => { isa => 'HashRef' } } ); }; isa_ok($FormBuilder, 'Bread::Board::Container::Parameterized'); my $fields = container 'Fields' => [ 'Model' ] => as { service 'username' => ( class => 'My::Form::Field::Text', parameters => { name => { isa => 'Str', default => 'username' }, validations => { isa => 'RegexpRef', default => qr/^[a-zA-Z0-9_]*$/ }, } ); service 'states' => ( class => 'My::Form::Field::Select', block => sub { my $s = shift; My::Form::Field::Select->new( name => 'states', options => $s->param('schema')->get_all_states, ); }, dependencies => { schema => depends_on('Model/schema') , }, ); }; isa_ok($fields, 'Bread::Board::Container::Parameterized'); my $model = container 'Model' => as { service 'schema' => My::Model->new; }; isa_ok($model, 'Bread::Board::Container'); my $form = $FormBuilder->create( Fields => $fields->create( Model => $model ) ); isa_ok($form, 'Bread::Board::Container'); my $f = $form->resolve( service => 'form', parameters => { state => { username => 'stevan', state => 'CT' } } ); isa_ok($f, 'My::Form'); is_deeply( $f->state, { username => 'stevan', state => 'CT' }, '... got the right state' ); my $username = $f->fields->[0]; isa_ok($username, 'My::Form::Field::Text'); isa_ok($username, 'My::Form::Field'); is($username->name, 'username', '... got the right name'); ok(ref $username->validations eq 'Regexp', '... got the right validation'); my $states = $f->fields->[1]; isa_ok($states, 'My::Form::Field::Select'); isa_ok($states, 'My::Form::Field'); is($states->name, 'states', '... got the right name'); is_deeply( $states->options, [ { value => 'CT', name => 'Connecticut' }, { value => 'CO', name => 'Colorado' }, { value => 'CA', name => 'California' }, ], '... got the right option list' ); done_testing; 100_clone_w_constructor_injection.t100644001750000144 413312243443340 22047 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Scalar::Util qw(refaddr); use Bread::Board; { package Test::Class; use Moose; has 'dep' => ( is => 'ro', isa => 'Int' ); } my $board = Bread::Board::Container->new( name => 'app' ); isa_ok($board, 'Bread::Board::Container'); $board->add_service( Bread::Board::ConstructorInjection->new( name => 'test', class => 'Test::Class', dependencies => { dep => Bread::Board::Dependency->new(service_path => '/dep'), }, ) ); ok($board->has_service('test'), '... got the test service'); isa_ok($board->get_service('test'), 'Bread::Board::ConstructorInjection'); # clone ... my $board2 = $board->clone; isa_ok($board2, 'Bread::Board::Container'); isnt($board, $board2, '... they are not the same instance'); ok($board2->has_service('test'), '... got the test service'); isa_ok($board2->get_service('test'), 'Bread::Board::ConstructorInjection'); isnt($board->get_service('test'), $board2->get_service('test'), '... not the same test services'); # add dep services ... $board->add_service( Bread::Board::Literal->new(name => 'dep', value => 1) ); ok($board->has_service('dep'), '... got the dep service'); isa_ok($board->get_service('dep'), 'Bread::Board::Literal'); ok(!$board2->has_service('dep'), '... board2 does not have the dep service'); $board2->add_service( Bread::Board::Literal->new(name => 'dep', value => 2) ); ok($board2->has_service('dep'), '... got the dep service'); isa_ok($board2->get_service('dep'), 'Bread::Board::Literal'); isnt($board->get_service('dep'), $board2->get_service('dep'), '... not the same dep services'); # test them ... is($board->fetch('/dep')->get(), 1, '... got correct dep'); is($board->fetch('/test')->get()->dep, 1, '... test uses dep'); is(refaddr $board->fetch('/test')->parent, refaddr $board, '... got the right board'); is($board2->fetch('/dep')->get(), 2, '... got correct dep'); is($board2->fetch('/test')->get()->dep, 2, '... test uses dep'); is(refaddr $board2->fetch('/test')->parent, refaddr $board2, '... got the right board'); done_testing; LifeCycle000755001750000144 012243443340 17212 5ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/BoardSingleton.pm100644001750000144 372712243443340 21663 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/LifeCyclepackage Bread::Board::LifeCycle::Singleton; BEGIN { $Bread::Board::LifeCycle::Singleton::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::LifeCycle::Singleton::VERSION = '0.29'; } use Moose::Role; use Try::Tiny; with 'Bread::Board::LifeCycle'; has 'instance' => ( traits => [ 'NoClone' ], is => 'rw', isa => 'Any', predicate => 'has_instance', clearer => 'flush_instance' ); has 'resolving_singleton' => ( traits => [ 'NoClone' ], is => 'rw', isa => 'Bool', default => 0, ); around 'get' => sub { my $next = shift; my $self = shift; # return it if we got it ... return $self->instance if $self->has_instance; my $instance; if ($self->resolving_singleton) { $instance = Bread::Board::Service::Deferred->new(service => $self); } else { $self->resolving_singleton(1); my @args = @_; try { # otherwise fetch it ... $instance = $self->$next(@args); } catch { die $_; } finally { $self->resolving_singleton(0); }; } # if we get a copy, and our copy # has not already been set ... $self->instance($instance); # return whatever we have ... return $self->instance; }; no Moose::Role; 1; __END__ =pod =head1 NAME Bread::Board::LifeCycle::Singleton =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 042_parameter_cache_with_singleton.t100644001750000144 501612243443340 22140 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; use Bread::Board; use Bread::Board::LifeCycle::Singleton::WithParameters; { package Foo; use Moose; has 'bar' => (is => 'ro', isa => 'Int', required => 1); has 'baz' => (is => 'ro', isa => 'Str', required => 1); } my $c = container 'MyApp' => as { service 'foo' => ( lifecycle => 'Singleton::WithParameters', class => 'Foo', parameters => { bar => { isa => 'Int' }, baz => { isa => 'Str' }, } ); }; my $foo; is(exception { $foo = $c->resolve( service => 'foo', parameters => { bar => 10, baz => 'BAZ' } ); }, undef, '... got the service correctly'); isa_ok($foo, 'Foo'); is($foo->bar, 10, '... got the right parameter value'); is($foo->baz, 'BAZ', '... got the right parameter value'); # this is the same instance ... my $foo2; is(exception { $foo2 = $c->resolve( service => 'foo', parameters => { bar => 10, baz => 'BAZ' } ); }, undef, '... got the service correctly'); isa_ok($foo2, 'Foo'); is($foo2->bar, 10, '... got the right parameter value'); is($foo2->baz, 'BAZ', '... got the right parameter value'); # this will be different instance ... my $foo3; is(exception { $foo3 = $c->resolve( service => 'foo', parameters => { bar => 20, baz => 'BAZ' } ); }, undef, '... got the service correctly'); isa_ok($foo3, 'Foo'); is($foo3->bar, 20, '... got the right parameter value'); is($foo3->baz, 'BAZ', '... got the right parameter value'); # this is the same instance ... my $foo4; is(exception { $foo4 = $c->resolve( service => 'foo', parameters => { bar => 10, baz => 'BAZ' } ); }, undef, '... got the service correctly'); isa_ok($foo4, 'Foo'); is($foo4->bar, 10, '... got the right parameter value'); is($foo4->baz, 'BAZ', '... got the right parameter value'); # this will be different instance ... my $foo5; is(exception { $foo5 = $c->resolve( service => 'foo', parameters => { bar => 10, baz => 'Baz' }); }, undef, '... got the service correctly'); isa_ok($foo5, 'Foo'); is($foo5->bar, 10, '... got the right parameter value'); is($foo5->baz, 'Baz', '... got the right parameter value'); # confirm our assumptions ... is($foo, $foo2, '... they are the same instances (same params)'); isnt($foo, $foo3, '... they are not the same instances (diff params)'); is($foo, $foo4, '... they are the same instances (same params)'); isnt($foo, $foo5, '... they are the same instances (same params)'); isnt($foo3, $foo5, '... they are the same instances (same params)'); done_testing; ConstructorInjection.pm100644001750000144 270012243443340 22240 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Boardpackage Bread::Board::ConstructorInjection; BEGIN { $Bread::Board::ConstructorInjection::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::ConstructorInjection::VERSION = '0.29'; } use Moose; use Try::Tiny; use Bread::Board::Types; with 'Bread::Board::Service::WithClass', 'Bread::Board::Service::WithParameters', 'Bread::Board::Service::WithDependencies'; has 'constructor_name' => ( is => 'rw', isa => 'Str', lazy => 1, builder => '_build_constructor_name', ); has '+class' => (required => 1); sub _build_constructor_name { my $self = shift; try { Class::MOP::class_of($self->class)->constructor_name } || 'new'; } sub get { my $self = shift; my $constructor = $self->constructor_name; $self->class->$constructor( %{ $self->params } ); } __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::ConstructorInjection =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut 061_extends_w_sugar_and_inheritance.t100644001750000144 564112243443340 22321 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Moose; use Bread::Board; { package FileLogger; use Moose; has 'log_file' => (is => 'ro', required => 1); package DBH; use Moose; has 'dsn' => (is => 'ro', isa => 'Str'); package MyApplication; use Moose; has 'logger' => (is => 'ro', isa => 'FileLogger', required => 1); has 'dbh' => (is => 'ro', isa => 'DBH', required => 1); } { package My::App; use Moose; use Bread::Board; extends 'Bread::Board::Container'; has 'log_file_name' => ( is => 'ro', isa => 'Str', default => 'logfile.log', ); sub BUILD { my $self = shift; container $self => as { service 'log_file' => $self->log_file_name; service 'logger' => ( class => 'FileLogger', lifecycle => 'Singleton', dependencies => { log_file => depends_on('log_file'), } ); service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), } ); }; } package My::App::Extended; use Moose; use Bread::Board; extends 'My::App'; has 'dsn' => ( is => 'ro', isa => 'Str', required => 1, ); sub BUILD { my $self = shift; container $self => as { service 'db_conn' => ( class => 'DBH', dependencies => [ (service 'dsn' => $self->dsn) ] ); service 'application' => ( class => 'MyApplication', dependencies => { logger => depends_on('logger'), dbh => depends_on('db_conn'), } ); }; } } my $c = My::App::Extended->new( name => 'MyApp', dsn => 'dbi:mysql:test' ); isa_ok($c, 'My::App::Extended'); isa_ok($c, 'My::App'); isa_ok($c, 'Bread::Board::Container'); # test the first one my $logger = $c->resolve( service => 'logger' ); isa_ok($logger, 'FileLogger'); is($logger->log_file, 'logfile.log', '... got the right logfile dep'); is($c->fetch('logger/log_file')->service, $c->fetch('log_file'), '... got the right value'); is($c->fetch('logger/log_file')->get, 'logfile.log', '... got the right value'); my $dbh = $c->resolve( service => 'db_conn' ); isa_ok($dbh, 'DBH'); is($dbh->dsn, 'dbi:mysql:test', '... got the right dsn'); my $app = $c->resolve( service => 'application' ); isa_ok($app, 'MyApplication'); isa_ok($app->logger, 'FileLogger'); is($app->logger, $logger, '... got the right logger (singleton)'); isa_ok($app->dbh, 'DBH'); isnt($app->dbh, $dbh, '... got the right db_conn (not a singleton)'); done_testing; 047_dependencies_override_parameters.t100644001750000144 131412243443340 22472 0ustar00doyusers000000000000Bread-Board-0.29/t#!/usr/bin/env perl use strict; use warnings; use Test::More; use Bread::Board; my $c = container Foo => as { service a => 'A'; service foo => ( block => sub { $_[0]->param('a'); }, dependencies => ['a'], parameters => { # XXX should optional need to be specified here? or should an # existing dependency of the same name imply that? seems to # parallel the default/required situation in moose, where default # overrides required, but not sure a => { optional => 1 }, }, ); }; is($c->resolve(service => 'foo'), 'A'); is($c->resolve(service => 'foo', parameters => { a => 'B' }), 'B'); done_testing; WithParameters.pm100644001750000144 536712243443340 22423 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Servicepackage Bread::Board::Service::WithParameters; BEGIN { $Bread::Board::Service::WithParameters::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Service::WithParameters::VERSION = '0.29'; } use Moose::Role; use MooseX::Params::Validate qw(validated_hash); use Bread::Board::Types; with 'Bread::Board::Service'; has 'parameters' => ( traits => [ 'Hash', 'Copy' ], is => 'ro', isa => 'Bread::Board::Service::Parameters', lazy => 1, coerce => 1, builder => '_build_parameters', handles => { 'has_parameters' => 'count' } ); has '_parameter_keys_to_remove' => ( is => 'rw', isa => 'ArrayRef', clearer => '_clear_parameter_keys_to_remove', predicate => '_has_parameter_keys_to_remove', ); before 'get' => sub { my $self = shift; my %params = $self->check_parameters(@_); $self->_parameter_keys_to_remove( [ keys %params ] ); $self->params({ %{ $self->params }, %params }); }; after 'get' => sub { my $self = shift; return unless $self->_has_parameter_keys_to_remove; map { $self->_clear_param( $_ ) } @{ $self->_parameter_keys_to_remove }; $self->_clear_parameter_keys_to_remove; }; sub _build_parameters { +{} } sub check_parameters { my $self = shift; return validated_hash(\@_, ( %{ $self->parameters }, # NOTE: # cache the parameters in a per-service # basis, this should be more than adequate # since each service can only have one set # of parameters at a time. If this does end # up breaking then we can give it a better # key at that point. # - SL (MX_PARAMS_VALIDATE_CACHE_KEY => Scalar::Util::refaddr($self)) )) if $self->has_parameters; return (); } sub has_required_parameters { my $self = shift; scalar grep { ! $_->{optional} } values %{ $self->parameters }; } sub has_parameter_defaults { my $self = shift; scalar grep { $_->{default} } values %{ $self->parameters }; } no Moose::Role; 1; __END__ =pod =head1 NAME Bread::Board::Service::WithParameters =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Deferred000755001750000144 012243443340 20473 5ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/ServiceThunk.pm100644001750000144 177112243443340 22270 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Service/Deferredpackage Bread::Board::Service::Deferred::Thunk; BEGIN { $Bread::Board::Service::Deferred::Thunk::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Service::Deferred::Thunk::VERSION = '0.29'; } use Moose; has 'thunk' => ( traits => [ 'Code' ], is => 'bare', isa => 'CodeRef', required => 1, handles => { 'inflate' => 'execute' } ); 1; __END__ =pod =head1 NAME Bread::Board::Service::Deferred::Thunk =head1 VERSION version 0.29 =head1 DESCRIPTION No user servicable parts. Read the source if you are interested. =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Container000755001750000144 012243443340 17275 5ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/BoardParameterized.pm100644001750000144 666512243443340 22604 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Containerpackage Bread::Board::Container::Parameterized; BEGIN { $Bread::Board::Container::Parameterized::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Container::Parameterized::VERSION = '0.29'; } use Moose; use Moose::Util 'find_meta'; use Bread::Board::Container::FromParameterized; # ABSTRACT: A parameterized container use Bread::Board::Container; with 'Bread::Board::Traversable'; has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); has 'allowed_parameter_names' => ( is => 'ro', isa => 'ArrayRef', required => 1, ); has 'container' => ( is => 'ro', isa => 'Bread::Board::Container', lazy => 1, builder => '_build_container', handles => [qw[ add_service get_service has_service get_service_list has_services add_sub_container get_sub_container has_sub_container get_sub_container_list has_sub_containers ]] ); sub _build_container { my $self = shift; Bread::Board::Container->new( name => $self->name ) } sub fetch { die "Cannot fetch from a parameterized container"; } sub resolve { die "Cannot resolve from a parameterized container"; } sub create { my ($self, %params) = @_; my @allowed_names = sort @{ $self->allowed_parameter_names }; my @given_names = sort keys %params; (scalar @allowed_names == scalar @given_names) || confess "You did not pass the correct number of parameters"; ((join "" => @allowed_names) eq (join "" => @given_names)) || confess "Incorrect parameter list, got: (" . (join "" => @given_names) . ") expected: (" . (join "" => @allowed_names) . ")"; my $clone = $self->container->clone( name => ($self->container->name eq $self->name ? join "|" => $self->name, @given_names : $self->container->name) ); my $from_parameterized_meta = find_meta('Bread::Board::Container::FromParameterized'); $clone = $from_parameterized_meta->rebless_instance($clone); if ($self->has_parent) { my $cloned_parent = $self->parent->clone; $cloned_parent->sub_containers({ %{ $cloned_parent->sub_containers }, $self->name => $clone, }); $clone->parent($cloned_parent); } foreach my $key ( @given_names ) { $clone->add_sub_container( $params{ $key }->clone( name => $key ) ); } $clone; } __PACKAGE__->meta->make_immutable; no Moose; no Moose::Util; 1; __END__ =pod =head1 NAME Bread::Board::Container::Parameterized - A parameterized container =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 ATTRIBUTES =over 4 =item B =item B =item B =back =head1 METHODS =over 4 =item B =item B =item B These two methods die, they are not appropriate, but are here for completeness. =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut WithDependencies.pm100644001750000144 1003612243443340 22713 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Servicepackage Bread::Board::Service::WithDependencies; BEGIN { $Bread::Board::Service::WithDependencies::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Service::WithDependencies::VERSION = '0.29'; } use Moose::Role; use Try::Tiny; use Bread::Board::Types; use Bread::Board::Service::Deferred; use Bread::Board::Service::Deferred::Thunk; with 'Bread::Board::Service'; has 'dependencies' => ( traits => [ 'Hash', 'Clone' ], is => 'rw', isa => 'Bread::Board::Service::Dependencies', lazy => 1, coerce => 1, default => sub { +{} }, trigger => sub { my $self = shift; $_->parent($self) foreach values %{$self->dependencies}; }, handles => { 'add_dependency' => 'set', 'get_dependency' => 'get', 'has_dependency' => 'exists', 'has_dependencies' => 'count', 'get_all_dependencies' => 'kv', } ); around 'init_params' => sub { my $next = shift; my $self = shift; +{ %{ $self->$next() }, $self->resolve_dependencies } }; after 'get' => sub { (shift)->clear_params }; sub resolve_dependencies { my $self = shift; my %deps; if ($self->has_dependencies) { foreach my $dep ($self->get_all_dependencies) { my ($key, $dependency) = @$dep; my $service = $dependency->service; # NOTE: # this is what checks for # circular dependencies if ($service->is_locked) { confess "You cannot defer a parameterized service" if $service->does('Bread::Board::Service::WithParameters') && $service->has_parameters; $deps{$key} = Bread::Board::Service::Deferred->new(service => $service); } else { # since we can't pass in parameters here, # we return a deferred thunk and you can do # with it what you will. if ( $service->does('Bread::Board::Service::WithParameters') && $service->has_required_parameters && (not $service->has_parameter_defaults) && (not $dependency->has_service_params) ) { $deps{$key} = Bread::Board::Service::Deferred::Thunk->new( thunk => sub { my %params = @_; $service->lock; return try { $service->get( %params ) } finally { $service->unlock } catch { die $_ } } ); } else { $service->lock; try { $deps{$key} = $dependency->has_service_params ? $service->get( %{ $dependency->service_params }) : $service->get; } finally { $service->unlock } catch { die $_ }; } } } } return %deps; } no Moose::Role; 1; __END__ =pod =head1 NAME Bread::Board::Service::WithDependencies =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =item B =item B =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Concepts000755001750000144 012243443340 20346 5ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/ManualTypemap.pod100644001750000144 1124612243443340 22655 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Manual/Concepts# PODNAME: Bread::Board::Manual::Concepts::Typemap # ABSTRACT: An overview of the typemapping feature __END__ =pod =head1 NAME Bread::Board::Manual::Concepts::Typemap - An overview of the typemapping feature =head1 VERSION version 0.29 =head1 INTRODUCTION A new (read: experimental) feature of Bread::Board is typemapped services. These are services which are mapped to a particular type rather then just a name. This feature has the potential to make obsolete a large amount of the Bread::Board configuration by simply asking Bread::Board to figure things out on its own. Here is a small example of how this works. # define the classes making sure # to specify required items and # their types { package Stapler; use Moose; package Desk; use Moose; package Chair; use Moose; package Cubicle; use Moose; has 'desk' => ( is => 'ro', isa => 'Desk', required => 1 ); has 'chair' => ( is => 'ro', isa => 'Chair', required => 1 ); package Employee; use Moose; has [ 'first_name', 'last_name' ] => ( is => 'ro', isa => 'Str', required => 1, ); has 'stapler' => ( is => 'rw', isa => 'Stapler', predicate => 'has_stapler' ); has 'work_area' => ( is => 'ro', isa => 'Cubicle', required => 1 ); } # now create the container, and # map the Employee type and ask # Bread::Board to infer all the # other relationships my $c = container 'Initech' => as { typemap 'Employee' => infer; }; # now you can create new Employee objects # by calling ->resolve with the type and # supplying the required parameters (see # below for details). my $micheal = $c->resolve( type => 'Employee', parameters => { first_name => 'Micheal', last_name => 'Bolton' } ); my $cube = $micheal->work_area; # this will be a Cubicle object $cube->desk; # this will be a Desk object $cube->chair; # this will be a Chair object $micheal->has_stapler; # this is false # We can create another Employee object # and this time we pass in the optional # parameter for the non-required 'stapler' # attribute my $milton = $c->resolve( type => 'Employee', parameters => { first_name => 'Milton', last_name => 'Waddams', stapler => Stapler->new } ); $milton->has_stapler; # this is true In the above example, we created a number of Moose classes that had specific required relationships. When we called C for the B object, Bread::Board figured out those relationships and set up dependencies and parameters accordingly. For the C object, we saw the B type and then basically called C on the B object. We then saw the B and B objects and called C on those as well. The result of this recursive inferrence was that the B, B, B and B relationships were modeled in Bread::Board as dependent services. Bread::Board also took it one step further. We were able to resolve the B, B and B types automatically because they were already defined by Moose as subtypes of the I type. We knew that it could introspect those classes and get more information. However, this was not the case with the I and I attributes of the B object. In that case, we determined that we couldn't resolve those objects and (because it was a top-level inferrence) instead turned them into required parameters for the inferred B service. And lastly, with a top-level inferrence (not one caused by recursion) Bread::Board will also look at all the remaining non-required attributes and turn them into optional parameters. In this case we have a C attribute that is not required and so is listed as an optional parameter, meaning that it is not required, but still subject to type checking. =head1 CONCLUSION This example should give a good basic overview of this feature and more details can be found in the test suite (F). These show examples of how to typemap roles to concrete classes and how to supply hints to C to help Bread::Board figure out specific details. As I mentioned above, this feature should be considered experimental and we are still working out details and writing tests for it. Any contributions are welcome. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Advanced.pod100644001750000144 1467412243443340 22753 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Manual/Concepts# PODNAME: Bread::Board::Manual::Concepts::Advanced # ABSTRACT: An overview of some of the more advanced Bread::Board concepts __END__ =pod =head1 NAME Bread::Board::Manual::Concepts::Advanced - An overview of some of the more advanced Bread::Board concepts =head1 VERSION version 0.29 =head1 INTRODUCTION In the L document we attempted to explain the conceptual foundations of Bread::Board. In that we exposed you to the idea of a container and a service and showed how they could be used. In that document we built a hierarchal container which organized different sets of services into what could be seen as subsystems within an overall application. While this alone has plenty of value, you might be asking yourself, what about re-use? Bread::Board already encourages decoupled object design by removing the need to manually wire your application components together, but what about re-using Bread::Board components themselves? This document will illustrate some of the more advanced concepts in Bread::Board with the specific focus on re-use and extension. =head1 ADVANCED CONCEPTS NOTE: This is just a quick sketch of these docs, more to come in the next few releases, for now I need to get this one out the door. =head2 Subclassing Bread::Board was built from the very start to be an open system and to allow for the subclassing of all its internal components. Here is a simple example of extending L to build a container specific to your application. package My::Application::Container; use Moose; use Bread::Board; extends 'Bread::Board::Container'; has 'log_file_name' => ( is => 'ro', isa => 'Str', default => 'logfile.log', ); sub BUILD { my $self = shift; container $self => as { service 'log_file' => $self->log_file_name; service 'logger' => ( class => 'My::FileLogger', lifecycle => 'Singleton', dependencies => { log_file => depends_on('log_file'), } ); service 'application' => ( class => 'My::Application', dependencies => { logger => depends_on('logger'), } ); }; } Then you can simply create an instance of the container and instantiate an instance of the application. my $c = My::Application::Container->new( name => 'MyLoggingContainer', log_file_name => 'other_logfile.log' ); my $app = $c->resolve( service => 'application'); It should be noted that when calling the constructor of a subclass of Bread::Board::Container, you must pass the "name" attribute as a parameter. Additionally you could use the C<+name> syntax in the subclass itself like so: has '+name' => ( default => 'MyLoggingContainer' ); which will remove the requirement in the constructor unless you choose to override it. It is also possible to extend/specialize a L type to customize it for your needs. More to come later. =head2 Parameterized Containers Extending containers is just one form of re-use, just like extending a class in plain old OOP. But Bread::Board also provides another means of re-use, and that is parameterized containers. If you are familiar with functors in Standard ML or O'Caml then this might look familiar to you. A parameterized container is basically a container which expects another container (or containers) as an argument and produces a third container as the result. Lets take a simple example here of a Logger object which logs to a database. my $db_logger = container 'DatabaseLogger' => [ 'DBConnInfo' ] => as { service 'handle' => ( class => 'My::Database::Logger', dependencies => { dsn => depends_on('DBConnInfo/dsn'), username => depends_on('DBConnInfo/username'), password => depends_on('DBConnInfo/password'), } ); }; It is parameterized with a C container which has three services, a C, a C and a C. Now let's create a simple container which fufills these requirements. my $db_conn_info = container 'DatabaseConnection' => as { service 'dsn' => 'dbi:mysql:foo'; service 'username' => 'bar'; service 'password' => '***'; }; The above container fulfills the bare minimum, but this could have just as easily have been a much more complex container which also had a service for a L schema, or a L directory object. As long as the container provided the three required services, that was all that the C parameterized container required. Now, a parameterized container is not a usable container, you must create an instance of it. That is as simple as calling the C method, like so. my $my_db_logger = $db_logger->create( DBConnInfo => $db_conn_info ); After which you can use it just like any other Bread::Board container would be used. my $log_handle = $my_db_logger->resolve( service => 'handle' ); Parameterized containers can also be nested, here is an example of an Application container that expects a Logger. my $app = container 'Application' => [ 'Logger' ] => as { service 'app' => ( class => 'My::Application', dependencies => { log_handle => depends_on('Logger/handle') } ); }; And here we instantiate an instance of our Application container using the DatabaseLogger. my $db_app = $app->create( Logger => $db_logger->create( DBConnInfo => $db_conn_info ) ); And of course, since the Logger is a parameter we could just as easily pass in a simpler screen logger for a test environment or something. Here is what that would look like. my $simple_logger = container 'SimpleLogger' => as { service 'handle' => ( class => 'My::Simple::Logger' ); }; my $simple_app = $app->create( Logger => $simple_logger ); Parameterized containers provide a useful and powerful means of re-use and abstraction, making it easy to create flexible containers to model your applications subsystems. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut FromParameterized.pm100644001750000144 134012243443340 23411 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Containerpackage Bread::Board::Container::FromParameterized; BEGIN { $Bread::Board::Container::FromParameterized::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::Container::FromParameterized::VERSION = '0.29'; } use Moose; extends 'Bread::Board::Container'; has '+parent' => ( weak_ref => 0, ); __PACKAGE__->meta->make_immutable; no Moose; 1; __END__ =pod =head1 NAME Bread::Board::Container::FromParameterized =head1 VERSION version 0.29 =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Example000755001750000144 012243443340 20163 5ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/ManualLogDispatch.pod100644001750000144 764712243443340 23246 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Manual/Example# PODNAME: Bread::Board::Manual::Example::LogDispatch # ABSTRACT: An example of composing a dynamic Log::Dispatch object. __END__ =pod =head1 NAME Bread::Board::Manual::Example::LogDispatch - An example of composing a dynamic Log::Dispatch object. =head1 VERSION version 0.29 =head1 SYNOPSIS my $c = container 'Logging' => as { service 'Logger' => ( block => sub { my $s = shift; my $c = $s->parent; my $outputs = $c->get_sub_container('Outputs'); my $log = Log::Dispatch->new; foreach my $name ( $outputs->get_service_list ) { $log->add( $outputs->get_service( $name )->get ); } $log; } ); container 'Outputs' => as { service 'File' => ( block => sub { Log::Dispatch::File->new( name => 'file', min_level => 'debug', filename => 'logfile' ) } ); service 'Screen' => ( block => sub { Log::Dispatch::Screen->new( name => 'screen', min_level => 'warning', ) } ); }; }; my $logger = $c->resolve( service => 'Logging/Logger' ); =head1 DESCRIPTION This example was inspired by a discussion I had with Jay Shirley. He wanted to know an easy way to have a dynamic list of output types for his Log::Dispatch object. Often with Bread::Board you will be wiring up components that are of a fixed type and set, but this is not always the case. It is in these cases when you can simply use the Bread::Board objects themselves to fetch your dependencies. The value passed into the block of a BlockInjection service is the service itself. Calling the C method on that service will give you the container that service is in. From there you can introspect the other containers and services any which way you want to. This example can be made even more dynamic if you build the 'Logging' component as a parameterized container whose parameter is the 'Ouputs' container. Here is what that would look like. my $logging = container 'Logging' => [ 'Outputs' ] as { service 'Logger' => ( block => sub { my $s = shift; my $c = $s->parent; my $outputs = $c->get_sub_container('Outputs'); my $log = Log::Dispatch->new; foreach my $name ( $outputs->get_service_list ) { $log->add( $outputs->get_service( $name )->get ); } $log; } ); }; my $outputs = container 'Outputs' => as { service 'File' => ( block => sub { Log::Dispatch::File->new( name => 'file', min_level => 'debug', filename => 'logfile' ) } ); service 'Screen' => ( block => sub { Log::Dispatch::Screen->new( name => 'screen', min_level => 'warning', ) } ); }; my $c = $logging->create( Outputs => $outputs ); my $ld = $c->resolve( service => 'Logging/Logger' ); This example illustrates how when a parameterized container is instantiated, the parameters become sub-containers of the resulting container. This makes it just as easy to fetch the 'Outputs' container and use it inside the 'Logger' service. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut FormSensible.pod100644001750000144 1502312243443340 23440 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/Manual/Example# PODNAME: Bread::Board::Manual::Example::FormSensible # ABSTRACT: A Form::Sensible and Catalyst example. __END__ =pod =head1 NAME Bread::Board::Manual::Example::FormSensible - A Form::Sensible and Catalyst example. =head1 VERSION version 0.29 =head1 SYNOPSIS __PACKAGE__->config( # ... your other Catalyst configs ... # first put our universal # FormBuilder container # inside the config FormBuilder => container 'FormBuilder' => [ 'Fields' ] => as { service 'Form' => ( class => 'Form::Sensible', block => sub { my $s = shift; my $c = $s->parent; my $fields = $c->get_sub_container('Fields'); my $form = Form::Sensible::Form->new( name => $s->param('name') ); foreach my $name ( $fields->get_service_list ) { $form->add_field( $fields->get_service( $name )->get ); } if ( my $state = $s->param('state') ) { $form->set_values( $state ); } $form; }, parameters => { name => { isa => 'Str' }, state => { isa => 'HashRef', optional => 1 }, } ); }, # Then we can build a set of # Fields for the 'foo' form Fields => { foo => container 'FooFields' => [ 'Model' ] => as { service 'Username' => ( class => 'Form::Sensible::Field::Text', block => sub { Form::Sensible::Field::Text->new( name => 'username', validation => { regex => qr/^[0-9a-z]*$/ } ); } ); service 'Password' => ( class => 'Form::Sensible::Field::Text', block => sub { Form::Sensible::Field::Text->new( name => 'password', render_hints => { 'HTML' => { field_type => 'password' } } ); } ); service 'Submit' => ( class => 'Form::Sensible::Field::Trigger', block => sub { Form::Sensible::Field::Trigger->new( name => 'submit' ); } ); service 'AccessLevel' => ( class => 'Form::Sensible::Field::Select', block => sub { my $s = shift; my $select = Form::Sensible::Field::Select->new( name => 'access_level', ); foreach my $access_level ( $s->param('schema')->resultset('AccessLevels')->all ) { $select->add_option( $access_level->id, $access_level->name ); } $select; }, dependencies => { schema => depends_on('Model/schema') , }, ); } } ); # later, in a # catalyst action ... sub process_foo : Local { my ($self, $c) = @_; my $Model = container 'Model' => as { service 'schema' => $c->model('DBIC') }; my $Form = $c->config->{FormBuilder}->create( Fields => $c->config->{Fields}->{foo}->create( Model => $Model ) ); my $f = $Form->resolve( service => 'Form', parameters => { name => 'foo', state => $c->req->parameters } ); my $result = $f->validate; if ($result->is_valid) { # ... } else { # ... } } =head1 DESCRIPTION This example came out of a discussion with Jay Kuri about how Bread::Board might be used in conjunction with his Form::Sensible module. My idea was to create a generic form builder which is parameterized by a Fields container. This could be used to store all kind of application wide behaviors. Since this in the context of Catalyst it made sense to me for this to be stuffed into the Catalyst config hash. I also decided to use service parameters in the Form service, this allows you to pass in a specific name and to optionally pass in a captured state to the Form::Sensible::Form instance that is being created. The next idea was that the Fields container parameter could be created for each specific form in the application. In the above example all the services are hardcoded, but this could be made more re-usable using the C keyword from Bread::Board itself, or some degree of subclassing of the Container objects. Jay also asked about passing in the Catalyst model into the fields so that he could populate something like a select pulldown menu. Again I used parameterized modules, in this case we parameterized the FooFields container with a Model container which had a schema service (which was a DBIx::Class schema object). From here we move into a Catalyst action to show how this might be used. We start out by wrapping the Catalyst DBIC model with a simple container, and then proceed to build our C<$Form> object. The C<$Form> is a Bread::Board container born of 3 levels of parameterized containers, it is worth spending a little time pondering exactly what is happening there. So once we have the C<$Form> container, all we need to do is create an instance of our Form::Sensible::Form, passing in the name and the captured state. This example could likely be expanded even further to show the use of the Form::Sensible rendering as well. Further creative use of parameterized containers and a couple utility methods in the Catalyst controllers could produce fairly robust and easy to use API for an application. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Singleton000755001750000144 012243443340 21154 5ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/LifeCycleWithParameters.pm100644001750000144 403212243443340 24610 0ustar00doyusers000000000000Bread-Board-0.29/lib/Bread/Board/LifeCycle/Singletonpackage Bread::Board::LifeCycle::Singleton::WithParameters; BEGIN { $Bread::Board::LifeCycle::Singleton::WithParameters::AUTHORITY = 'cpan:STEVAN'; } { $Bread::Board::LifeCycle::Singleton::WithParameters::VERSION = '0.29'; } use Moose::Role; with 'Bread::Board::LifeCycle'; has 'instances' => ( traits => [ 'Hash', 'NoClone' ], is => 'rw', isa => 'HashRef', lazy => 1, default => sub { +{} }, clearer => 'flush_instances', handles => { 'has_instance_at_key' => 'exists', 'get_instance_at_key' => 'get', 'set_instance_at_key' => 'set', } ); around 'get' => sub { my $next = shift; my $self = shift; my $key = $self->generate_instance_key(@_); # return it if we got it ... return $self->get_instance_at_key($key) if $self->has_instance_at_key($key); # otherwise fetch it ... my $instance = $self->$next(@_); # if we get a copy, and our copy # has not already been set ... $self->set_instance_at_key($key => $instance) unless $self->has_instance_at_key($key); # return whatever we have ... return $self->get_instance_at_key($key); }; sub generate_instance_key { my ($self, @args) = @_; return "$self" unless @args; return join "|" => sort map { "$_" } @args } no Moose::Role; 1; __END__ =pod =head1 NAME Bread::Board::LifeCycle::Singleton::WithParameters =head1 VERSION version 0.29 =head1 DESCRIPTION =head1 METHODS =over 4 =item B =item B =item B =item B =item B =back =head1 BUGS All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. =head1 AUTHOR Stevan Little =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Infinity Interactive. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut