r9071 - in /branches/upstream/libclass-factory-perl/current: Changes MANIFEST META.yml README lib/Class/Factory.pm t/MyFlexibleBand.pm t/factory.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Fri Nov 9 15:32:19 UTC 2007
Author: gregoa-guest
Date: Fri Nov 9 15:32:19 2007
New Revision: 9071
URL: http://svn.debian.org/wsvn/?sc=1&rev=9071
Log:
[svn-upgrade] Integrating new upstream version, libclass-factory-perl (1.06)
Added:
branches/upstream/libclass-factory-perl/current/t/MyFlexibleBand.pm
Modified:
branches/upstream/libclass-factory-perl/current/Changes
branches/upstream/libclass-factory-perl/current/MANIFEST
branches/upstream/libclass-factory-perl/current/META.yml
branches/upstream/libclass-factory-perl/current/README
branches/upstream/libclass-factory-perl/current/lib/Class/Factory.pm
branches/upstream/libclass-factory-perl/current/t/factory.t
Modified: branches/upstream/libclass-factory-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-factory-perl/current/Changes?rev=9071&op=diff
==============================================================================
--- branches/upstream/libclass-factory-perl/current/Changes (original)
+++ branches/upstream/libclass-factory-perl/current/Changes Fri Nov 9 15:32:19 2007
@@ -1,4 +1,8 @@
Revision history for Perl extension Class::Factory.
+
+1.06 Tue Nov 6 21:16:07 CET 2007
+ - Added remove_factory_type(), unregister_factory_type() and
+ get_factory_type_for(). Marcel Gruenauer <marcel at cpan.org>
1.05 Thu Feb 1 22:57:21 PST 2007
- Added method get_registered_class(), suggested by
Modified: branches/upstream/libclass-factory-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-factory-perl/current/MANIFEST?rev=9071&op=diff
==============================================================================
--- branches/upstream/libclass-factory-perl/current/MANIFEST (original)
+++ branches/upstream/libclass-factory-perl/current/MANIFEST Fri Nov 9 15:32:19 2007
@@ -7,5 +7,6 @@
t/MyCountryBand.pm
t/MyRockBand.pm
t/MySimpleBand.pm
+t/MyFlexibleBand.pm
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libclass-factory-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-factory-perl/current/META.yml?rev=9071&op=diff
==============================================================================
--- branches/upstream/libclass-factory-perl/current/META.yml (original)
+++ branches/upstream/libclass-factory-perl/current/META.yml Fri Nov 9 15:32:19 2007
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Class-Factory
-version: 1.05
+version: 1.06
version_from: lib/Class/Factory.pm
installdirs: site
requires:
Modified: branches/upstream/libclass-factory-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-factory-perl/current/README?rev=9071&op=diff
==============================================================================
--- branches/upstream/libclass-factory-perl/current/README (original)
+++ branches/upstream/libclass-factory-perl/current/README Fri Nov 9 15:32:19 2007
@@ -40,6 +40,14 @@
# Get a registered class name given it's factory type
my $registered_class = MyFactory->get_registered_class( 'bleededge' );
+
+ # Remove a factory type
+
+ MyFactory->remove_factory_type('custom');
+
+ # Unregister a factory type
+
+ MyFactory->unregister_factory_type('bleededge');
See POD for details
@@ -85,3 +93,7 @@
Sebastian Knapp <giftnuss at netscape.net> contributed the idea for
'get_registered_class()'
+
+Marcel Gruenauer <marcel at cpan.org> contributed the methods
+remove_factory_type() and unregister_factory_type().
+
Modified: branches/upstream/libclass-factory-perl/current/lib/Class/Factory.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-factory-perl/current/lib/Class/Factory.pm?rev=9071&op=diff
==============================================================================
--- branches/upstream/libclass-factory-perl/current/lib/Class/Factory.pm (original)
+++ branches/upstream/libclass-factory-perl/current/lib/Class/Factory.pm Fri Nov 9 15:32:19 2007
@@ -1,10 +1,10 @@
package Class::Factory;
-# $Id: Factory.pm 40 2006-08-02 05:51:40Z cwinters $
+# $Id: Factory.pm 46 2007-11-07 00:06:38Z cwinters $
use strict;
-$Class::Factory::VERSION = '1.05';
+$Class::Factory::VERSION = '1.06';
my %CLASS_BY_FACTORY_AND_TYPE = ();
my %FACTORY_INFO_BY_CLASS = ();
@@ -123,6 +123,48 @@
}
+sub remove_factory_type {
+ my ( $item, @object_types ) = @_;
+ my $class = ref $item || $item;
+
+ for my $object_type (@object_types) {
+ unless ( $object_type ) {
+ $item->factory_error(
+ "Cannot remove factory type from '$class': no type defined"
+ );
+ }
+
+ delete $CLASS_BY_FACTORY_AND_TYPE{ $class }->{ $object_type };
+ }
+}
+
+
+sub unregister_factory_type {
+ my ( $item, @object_types ) = @_;
+ my $class = ref $item || $item;
+
+ for my $object_type (@object_types) {
+ unless ( $object_type ) {
+ $item->factory_error(
+ "Cannot remove factory type from '$class': no type defined"
+ );
+ }
+
+ delete $REGISTER{ $class }->{ $object_type };
+
+ # Also delete from $CLASS_BY_FACTORY_AND_TYPE because if the object
+ # type has already been instantiated, then it will have been processed
+ # by add_factory_type(), thus creating an entry in
+ # $CLASS_BY_FACTORY_AND_TYPE. We can call register_factory_type()
+ # again, but when we try to instantiate an object via
+ # get_factory_class(), it will find the old entry in
+ # $CLASS_BY_FACTORY_AND_TYPE and use that.
+
+ delete $CLASS_BY_FACTORY_AND_TYPE{ $class }->{ $object_type };
+ }
+}
+
+
sub get_loaded_classes {
my ( $item ) = @_;
my $class = ref $item || $item;
@@ -180,6 +222,14 @@
sub get_my_factory_type {
my ( $item ) = @_;
+ $item->get_factory_type_for($item);
+}
+
+
+# Return the type that the factory uses to create a given object or class.
+
+sub get_factory_type_for {
+ my ( $self, $item ) = @_;
my $impl_class = ref( $item ) || $item;
my $impl_info = $FACTORY_INFO_BY_CLASS{ $impl_class };
if ( ref( $impl_info ) eq 'ARRAY' ) {
@@ -246,13 +296,21 @@
my $registered_class = My::Factory->get_registered_class( 'type' );
- # Ask the object created by the factory: Where did I come from?
-
- my $custom_object = My::Factory->new( 'custom' );
- print "Object was created by factory: ",
+ # Ask the object created by the factory: Where did I come from?
+
+ my $custom_object = My::Factory->new( 'custom' );
+ print "Object was created by factory: ",
$custom_object->get_my_factory, " ",
"and is of type: ",
$custom_object->get_my_factory_type;
+
+ # Remove a factory type
+
+ My::Factory->remove_factory_type('perl');
+
+ # Unregister a factory type
+
+ My::Factory->unregister_factory_type('blech');
=head1 DESCRIPTION
@@ -601,6 +659,29 @@
C<factory_log()> message is issued if the type has already been
registered.
+B<remove_factory_type( @object_types )>
+
+Removes a factory type from the factory. This is the opposite of
+C<add_factory_type()>. No return value.
+
+Removing a factory type is useful if a subclass of the factory wants to
+redefine the mapping for the factory type. C<add_factory_type()> doesn't allow
+overriding a factory type, so you have to remove it first.
+
+B<unregister_factory_type( @object_types )>
+
+Unregisters a factory type from the factory. This is the opposite of
+C<register_factory_type()>. No return value.
+
+Unregistering a factory type is useful if a subclass of the factory wants to
+redefine the mapping for the factory type. C<register_factory_type()> doesn't
+allow overriding a factory type, so you have to unregister it first.
+
+B<get_factory_type_for( $class )>
+
+Takes an object or a class name string and returns the factory type that is
+used to construct that class. Returns undef if there is no such factory type.
+
B<get_loaded_classes()>
Returns a sorted list of the currently loaded classes. If no classes
@@ -688,7 +769,7 @@
=head1 COPYRIGHT
-Copyright (c) 2002-2006 Chris Winters. All rights reserved.
+Copyright (c) 2002-2007 Chris Winters. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -701,6 +782,8 @@
=head1 AUTHORS
+Fred Moyer <fred at redhotpenguin.com> is the current maintainer.
+
Chris Winters E<lt>chris at cwinters.comE<gt>
Eric Andreychek E<lt>eric at openthought.netE<gt> implemented overridable
@@ -711,3 +794,7 @@
Sebastian Knapp <giftnuss at netscape.net> contributed the idea for
'get_registered_class()'
+
+Marcel Gruenauer <marcel at cpan.org> contributed the methods
+remove_factory_type() and unregister_factory_type().
+
Added: branches/upstream/libclass-factory-perl/current/t/MyFlexibleBand.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-factory-perl/current/t/MyFlexibleBand.pm?rev=9071&op=file
==============================================================================
--- branches/upstream/libclass-factory-perl/current/t/MyFlexibleBand.pm (added)
+++ branches/upstream/libclass-factory-perl/current/t/MyFlexibleBand.pm Fri Nov 9 15:32:19 2007
@@ -1,0 +1,39 @@
+package MyFlexibleBand;
+
+# $Id: MyFlexibleBand.pm 28 2002-02-10 17:41:10Z cwinters $
+
+use strict;
+use base qw( Class::Factory );
+
+my %TYPES = ();
+sub get_factory_type { return $TYPES{ $_[1] } }
+sub set_factory_type { return $TYPES{ $_[1] } = $_[2] }
+
+my %REGISTER = ();
+sub get_register_type { return $REGISTER{ $_[1] } }
+sub set_register_type { return $REGISTER{ $_[1] } = $_[2] }
+
+sub init {
+ my ( $self, $params ) = @_;
+ $self->band_name( $params->{band_name} );
+ return $self;
+}
+
+
+sub band_name {
+ my ( $self, $name ) = @_;
+ $self->{band_name} = $name if ( $name );
+ return $self->{band_name};
+}
+
+sub genre {
+ my ( $self, $genre ) = @_;
+ $self->{genre} = $genre if ( $genre );
+ return $self->{genre};
+}
+
+MyFlexibleBand->add_factory_type( rock => 'MyRockBand' );
+MyFlexibleBand->register_factory_type( country => 'MyCountryBand' );
+
+1;
+
Modified: branches/upstream/libclass-factory-perl/current/t/factory.t
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-factory-perl/current/t/factory.t?rev=9071&op=diff
==============================================================================
--- branches/upstream/libclass-factory-perl/current/t/factory.t (original)
+++ branches/upstream/libclass-factory-perl/current/t/factory.t Fri Nov 9 15:32:19 2007
@@ -1,7 +1,7 @@
# -*-perl-*-
use strict;
-use Test::More tests => 33;
+use Test::More tests => 39;
use lib qw( ./t ./lib );
@@ -102,4 +102,25 @@
ok( $MySimpleBand::error_msg =~ /^Cannot add factory type 'disco' to class 'MySimpleBand': factory class 'SomeKeyboardGuy' cannot be required:/,
'Generated correct error message when instantiate object with nonexistent class registration' );
+ MySimpleBand->unregister_factory_type('country');
+ MySimpleBand->new( 'country', { band_name => $country_band } );
+ ok( $MySimpleBand::error_msg =~ /^Factory type 'country' is not defined in 'MySimpleBand'/,
+ 'Error message for instantiating after the factory type was unregistered' );
+
+ MySimpleBand->remove_factory_type('rock');
+ MySimpleBand->new( 'rock', { band_name => $rock_band } );
+ ok( $MySimpleBand::error_msg =~ /^Factory type 'rock' is not defined in 'MySimpleBand'/,
+ 'Error message for instantiating after the factory type was removed' );
+
+ $MySimpleBand::log_msg = '';
+ MySimpleBand->add_factory_type( rock => 'MyRockBand' );
+ is( $MySimpleBand::log_msg, '', 'no warning after re-adding factory type');
+
+ is(MySimpleBand->get_factory_type_for('MyRockBand'), 'rock',
+ 'Factory type retrievable for any given class');
+ is(MySimpleBand->get_factory_type_for($rock), 'rock',
+ 'Factory type retrievable for any given object');
+
+ is(MySimpleBand->get_factory_type_for('MyJPopBand'), undef,
+ 'Factory type undef for unknown class');
}
More information about the Pkg-perl-cvs-commits
mailing list