[Openinteract-commits] CVS: OpenInteract2/lib/OpenInteract2 Util.pm,1.16,1.17

[Chris W. <la...@us...>]

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