Update of /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14923
Modified Files:
Util.pm
Log Message:
move code to find factory subclasses from OI2::Manage; this is also used by the updated OI2::Setup (coming shortly)
Index: Util.pm
===================================================================
RCS file: /cvsroot/openinteract/OpenInteract2/lib/OpenInteract2/Util.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** Util.pm 5 Dec 2004 21:08:20 -0000 1.16
--- Util.pm 24 Jan 2005 17:00:43 -0000 1.17
***************
*** 4,8 ****
--- 4,10 ----
use strict;
+ use Carp qw( carp );
use Digest::MD5;
+ use File::Spec::Functions qw( catdir catfile );
use Log::Log4perl qw( get_logger );
use Mail::Sendmail ();
***************
*** 216,220 ****
my $website_dir = CTX->lookup_directory( 'website' );
! my $cleaned_filename = File::Spec->catfile( $website_dir, $filename );
if ( -f $cleaned_filename ) {
$log->is_debug &&
--- 218,222 ----
my $website_dir = CTX->lookup_directory( 'website' );
! my $cleaned_filename = catfile( $website_dir, $filename );
if ( -f $cleaned_filename ) {
$log->is_debug &&
***************
*** 242,245 ****
--- 244,311 ----
}
+ ########################################
+ # FACTORY IMPLEMENTATIONS
+
+ # Find all subclasses of a particular factory class anywhere on @INC
+
+ my %FACTORY_FILES = ();
+
+ sub find_factory_subclasses {
+ my ( $class, $factory_class, @dirs ) = @_;
+
+ foreach my $lib_dir ( @dirs ) {
+ next unless ( $lib_dir );
+ my $manage_dir = catdir( $lib_dir, split( '::', $factory_class ) );
+ next unless ( -d $manage_dir );
+ eval { _find_descend( $manage_dir ) };
+ if ( $@ ) {
+ carp "Error trying to find subclasses of '$factory_class' in $lib_dir: $@\n";
+ }
+ }
+
+ # Now grab the class names from the files stored in %FACTORY_FILES
+ # so we don't try to include the same class from different files
+ # -- this normally only happens for developers who have the OI2
+ # lib directory in their PERL5LIB and who are running tests
+
+ my %FACTORY_CLASSES = ();
+ foreach my $file ( sort keys %FACTORY_FILES ) {
+ my $file_class = $file;
+ $file_class =~ s/^.*OpenInteract2/OpenInteract2/;
+ $file_class =~ s/\.pm$//;
+ $file_class =~ s/\W/::/g;
+ $FACTORY_CLASSES{ $file_class } ||= $file;
+ }
+
+ # Why 'sort'? It ensures that classes further up the hierarchy
+ # (e.g., 'OI2::Manage::Website') get required before their
+ # children; otherwise we get lots of 'subroutine foo redefined'
+ # messages under '-w', irritating.
+
+ foreach my $factory_subclass ( sort keys %FACTORY_CLASSES ) {
+ eval "require $factory_subclass";
+ if ( $@ ) {
+ carp "Failed to bring in library '$factory_subclass': $@";
+ }
+ }
+ }
+
+ sub _find_descend {
+ my ( $lib_dir ) = @_;
+ opendir( FACTORYDIR, $lib_dir )
+ || die "Cannot open directory '$lib_dir': $!";
+ my @entries = grep ! /^\./, readdir( FACTORYDIR );
+ foreach my $entry ( @entries ) {
+ my $full_entry_dir = catdir( $lib_dir, $entry );
+ if ( -d $full_entry_dir ) {
+ _find_descend( $full_entry_dir ); # let this error bubble
+ }
+ next unless ( $entry =~ /\.pm$/ );
+ my $full_filename = catfile( $lib_dir, $entry );
+ $FACTORY_FILES{ $full_filename } = 1;
+ }
+ }
+
+
1;
***************
*** 424,427 ****
--- 490,513 ----
match up to one, undef is returned.
+ =head1 FACTORY SUBCLASSES
+
+ B<find_factory_subclasses( $factory_class, @directories )>
+
+ Finds all subclasses of C<$factory_class> using C<@directories> as the
+ list of directories from which to start. So to discover all the
+ L<OpenInteract2::Manage> subclasses from all Perl module directories
+ we would do:
+
+ OpenInteract2::Util->find_factory_subclasses(
+ 'OpenInteract2::Manage', @INC
+ );
+
+ And to find them from the temporary library directory, we'd do:
+
+ my $temp_lib_dir = CTX->lookup_temp_lib_directory;
+ OpenInteract2::Util->find_factory_subclasses(
+ 'OpenInteract2::Manage', $temp_lib_dir
+ );
+
=head1 TO DO
|
