[Bps-public-commit] r14703 - in Prophet/trunk: . lib/Prophet/CLI lib/Prophet/Replica

jesse at bestpractical.com jesse at bestpractical.com
Thu Jul 31 23:36:23 EDT 2008


Author: jesse
Date: Thu Jul 31 23:36:22 2008
New Revision: 14703

Modified:
   Prophet/trunk/Makefile.PL
   Prophet/trunk/lib/Prophet/App.pm
   Prophet/trunk/lib/Prophet/CLI.pm
   Prophet/trunk/lib/Prophet/CLI/CollectionCommand.pm
   Prophet/trunk/lib/Prophet/CLI/RecordCommand.pm
   Prophet/trunk/lib/Prophet/Record.pm
   Prophet/trunk/lib/Prophet/Replica.pm
   Prophet/trunk/lib/Prophet/Replica/SVN.pm
   Prophet/trunk/lib/Prophet/ReplicaExporter.pm

Log:
Removed dependencies on:

List::MoreUtils
Class::Accessor
UNIVERSAL::require


Modified: Prophet/trunk/Makefile.PL
==============================================================================
--- Prophet/trunk/Makefile.PL	(original)
+++ Prophet/trunk/Makefile.PL	Thu Jul 31 23:36:22 2008
@@ -6,14 +6,11 @@
 license('Perl');
 
 requires('Params::Validate');
-requires('List::MoreUtils');
-requires('Class::Accessor');
 requires('IPC::Run3');
 requires('File::Rsync');
 requires('Data::UUID');
 requires('Path::Class');
 requires('Test::Exception');
-requires('UNIVERSAL::require');
 requires('Term::ReadKey');
 requires('Digest::SHA1');  # Core in 5.10
 requires('LWP::Simple'); # Part of lib-www-perl
@@ -32,7 +29,6 @@
     'Web server' => [
         -default => 1,
         'HTTP::Server::Simple', # HTTP::Server::Simple::CGI
-        'Test::HTTP::Server::Simple',
         'Test::WWW::Mechanize' => '1.16',
         'HTTP::Server::Simple'
     ],
@@ -48,17 +44,15 @@
     ],
     'Maintainer testing tools' => [
         -default   => 1,
+        'Test::HTTP::Server::Simple',
         'Acme::MetaSyntactic',
+        'YAML::Syck' => 0,
         'Test::Pod::Coverage'
     ],
     q{Devel::Gladiator support (contact sky at crucially.net if it's not on CPAN)} => [
         -default => 0,
         'Devel::Gladiator'
     ],
-    'Testing' => [
-        -default => 1,
-        'YAML::Syck' => 0
-    ]
 );
 
 all_from('lib/Prophet.pm');

Modified: Prophet/trunk/lib/Prophet/App.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/App.pm	(original)
+++ Prophet/trunk/lib/Prophet/App.pm	Thu Jul 31 23:36:22 2008
@@ -1,6 +1,7 @@
 package Prophet::App;
 use Moose;
 use Path::Class;
+use Prophet::Config;
 
 has handle => (
     is      => 'rw',
@@ -33,7 +34,6 @@
     isa     => 'Prophet::Config',
     default => sub {
         my $self = shift;
-        Prophet::Config->require;
         return Prophet::Config->new(app_handle => $self);
     },
     documentation => "This is the config instance for the running application",
@@ -58,7 +58,7 @@
     my $except = $replica_class."::(.*)::";
     Module::Pluggable->import( search_path => $replica_class, sub_name => 'app_replica_types', require => 0, except => qr/$except/);
     for my $package ( $self->app_replica_types) {
-        $package->require;
+        $self->require($package);
         next unless $package->can('scheme');
         Prophet::Replica->register_replica_scheme(scheme => $package->scheme, class => $package) 
     }
@@ -69,19 +69,73 @@
     return $ENV{'PROPHET_REPLICA_TYPE'} || DEFAULT_REPLICA_TYPE;
 }
 
-sub require_module {
+sub require {
     my $self = shift;
     my $class = shift;
-    $class->require;
-    if (my $msg = $@) {
-        my $class_path = $class .".pm";
-        $class_path =~ s/::/\//g;
-        my $ok_err= "Can't locate $class_path";
-        die $msg if $msg !~  qr/^$ok_err/;
+    return undef unless $class;
+    $self->_require(module => $class);
+}
+
+sub try_to_require {
+    my $self = shift;
+    my $class = shift;
+    $self->_require(module => $class, quiet => 1);
+}
+
+
+sub _require {
+    my $self = shift;
+    my %args = ( module => undef, quiet => undef, @_);
+    my $class = $args{'module'};
+    
+    # Quick hack to silence warnings.
+    # Maybe some dependencies were lost.
+    unless ($class) {
+        warn sprintf("no class was given at %s line %d\n", (caller)[1,2]);
+        return 0;
+    }   
+    
+    return 1 if $self->already_required($class);
+    
+    # .pm might already be there in a weird interaction in Module::Pluggable
+    my $file = $class;
+    $file .= ".pm"
+        unless $file =~ /\.pm$/;
+
+    $file =~ s/::/\//g;
+
+    my $retval = eval  {CORE::require "$file"} ;
+    my $error = $@;
+    if (my $message = $error) {
+        $message =~ s/ at .*?\n$//;
+        if ($args{'quiet'} and $message =~ /^Can't locate $file/) {
+            return 0;
+        }
+        elsif ( $error !~ /^Can't locate $file/) {
+            die $error;
+        } else {
+            warn sprintf("$message at %s line %d\n", (caller(1))[1,2]);
+            return 0;
+        }
     }
-    $@ = '';
+
+    return 1;
 }
 
+=head2 already_required class
+
+Helper function to test whether a given class has already been require'd.
+
+=cut
+    
+    
+sub already_required {
+    my ($self, $class) = @_;
+    my $path =  join('/', split(/::/,$class)).".pm";
+    return ( $INC{$path} ? 1 : 0);
+}
+
+
 __PACKAGE__->meta->make_immutable;
 no Moose;
 

Modified: Prophet/trunk/lib/Prophet/CLI.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI.pm	(original)
+++ Prophet/trunk/lib/Prophet/CLI.pm	Thu Jul 31 23:36:22 2008
@@ -182,12 +182,12 @@
 sub _try_to_load_cmd_class {
     my $self = shift;
     my $class = shift;
-    Prophet::App->require_module($class);
+    Prophet::App->try_to_require($class);
     return $class if $class->isa('Prophet::CLI::Command');
 
     warn "Invalid class $class - not a subclass of Prophet::CLI::Command."
         if $class !~ /::$/ # don't warn about "Prophet::CLI::Command::" (which happens on "./bin/sd")
-        && Class::MOP::is_class_loaded($class);
+        && Prophet::App->already_required($class);
 
     return undef;
 }

Modified: Prophet/trunk/lib/Prophet/CLI/CollectionCommand.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI/CollectionCommand.pm	(original)
+++ Prophet/trunk/lib/Prophet/CLI/CollectionCommand.pm	Thu Jul 31 23:36:22 2008
@@ -12,7 +12,7 @@
 
     my $record_class = $self->_get_record_class(type => $args{type});
     my $class = $record_class->collection_class;
-    Prophet::App->require_module($class);
+    Prophet::App->require($class);
 
     my $records = $class->new(
         app_handle => $self->app_handle,

Modified: Prophet/trunk/lib/Prophet/CLI/RecordCommand.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/CLI/RecordCommand.pm	(original)
+++ Prophet/trunk/lib/Prophet/CLI/RecordCommand.pm	Thu Jul 31 23:36:22 2008
@@ -36,7 +36,7 @@
         return $class->new($constructor_args);
     }
     elsif (my $class = $self->record_class) {
-        Prophet::App->require_module($class);
+        Prophet::App->require($class);
         return $class->new($constructor_args);
     }
     else {
@@ -56,11 +56,11 @@
     my $self = shift;
     my $type = shift;
     my $try = $self->cli->app_class . "::Model::" . ucfirst( lc($type) );
-    Prophet::App->require_module($try);    # don't care about fails
+    Prophet::App->try_to_require($try);    # don't care about fails
     return $try if ( $try->isa('Prophet::Record') );
 
     $try = $self->cli->app_class . "::Record";
-    Prophet::App->require_module($try);    # don't care about fails
+    Prophet::App->try_to_require($try);    # don't care about fails
     return $try if ( $try->isa('Prophet::Record') );
     return 'Prophet::Record';
 }

Modified: Prophet/trunk/lib/Prophet/Record.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Record.pm	(original)
+++ Prophet/trunk/lib/Prophet/Record.pm	Thu Jul 31 23:36:22 2008
@@ -3,7 +3,6 @@
 use MooseX::ClassAttribute;
 use Params::Validate;
 use Data::UUID;
-use List::MoreUtils qw/uniq/;
 use Prophet::App; # for require_module. Kinda hacky
 
 use constant collection_class => 'Prophet::Collection';
@@ -85,7 +84,7 @@
 
 sub register_reference {
     my ( $class, $accessor, $foreign_class, @args ) = @_;
-    $foreign_class->require();
+    Prophet::App->require($foreign_class);
     if ( $foreign_class->isa('Prophet::Collection') ) {
         return $class->register_collection_reference(
             $accessor => $foreign_class,
@@ -112,7 +111,7 @@
     my %args = validate( @args, { by => 1 } );
     no strict 'refs';
 
-    Prophet::App->require_module( $collection_class->record_class );
+    Prophet::App->require( $collection_class->record_class );
 
     *{ $class . "::$accessor" } = sub {
         my $self       = shift;
@@ -325,6 +324,11 @@
             @changesets;
 }
 
+
+# uniq ganked from List::MoreUtils 0.21 
+sub uniq (@) { my %h; map { $h{$_}++ == 0 ? $_ : () } @_; }
+
+
 sub validate_props {
     my $self   = shift;
     my $props  = shift;

Modified: Prophet/trunk/lib/Prophet/Replica.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Replica.pm	(original)
+++ Prophet/trunk/lib/Prophet/Replica.pm	Thu Jul 31 23:36:22 2008
@@ -1,7 +1,6 @@
 package Prophet::Replica;
 use Moose;
 use Params::Validate qw(:all);
-use UNIVERSAL::require;
 use Data::UUID;
 use Path::Class;
 
@@ -44,12 +43,13 @@
 
 use constant state_db_uuid => 'state';
 use Module::Pluggable search_path => 'Prophet::Replica', sub_name => 'core_replica_types', require => 0, except => qr/Prophet::Replica::(.*)::/;
+use Prophet::App;
 
 our $REPLICA_TYPE_MAP = {};
 our $MERGETICKET_METATYPE = '_merge_tickets';
 
 for ( __PACKAGE__->core_replica_types) {
-   $_->require or die $@; # Require here, rather than with the autorequire from Module::Pluggable as that goes too far
+Prophet::App->require($_) or die $@; # Require here, rather than with the autorequire from Module::Pluggable as that goes too far
 
    # and tries to load Prophet::Replica::SVN::ReplayEditor;
    __PACKAGE__->register_replica_scheme(scheme => $_->scheme, class => $_) 
@@ -97,7 +97,7 @@
 
     return $orig->($class, %args) if $class eq $new_class;
 
-    $new_class->require;
+    Prophet::App->require($new_class);
     return $new_class->new(%args);
 };
 
@@ -245,7 +245,7 @@
         $args{conflict_callback}->($conflict) if $args{'conflict_callback'};
         $conflict->resolvers( [ sub { $args{resolver}->(@_) } ] ) if $args{resolver};
         if ( $args{resolver_class} ) {
-            $args{resolver_class}->require || die $@;
+            Prophet::App->require($args{resolver_class}) || die $@;
             $conflict->resolvers(
                 [   sub {
                         $args{resolver_class}->new->run(@_);
@@ -539,7 +539,7 @@
 sub export_to {
     my $self = shift;
     my %args = validate( @_, { path => 1, } );
-    Prophet::ReplicaExporter->require();
+    require Prophet::ReplicaExporter;
 
     my $exporter = Prophet::ReplicaExporter->new({target_path => dir($args{'path'}), source_replica => $self});
     $exporter->export();

Modified: Prophet/trunk/lib/Prophet/Replica/SVN.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/Replica/SVN.pm	(original)
+++ Prophet/trunk/lib/Prophet/Replica/SVN.pm	Thu Jul 31 23:36:22 2008
@@ -2,7 +2,6 @@
 use Moose;
 extends 'Prophet::Replica';
 use Params::Validate qw(:all);
-use UNIVERSAL::require;
 
 # require rather than use to make them late-binding
 use Prophet::ChangeSet;

Modified: Prophet/trunk/lib/Prophet/ReplicaExporter.pm
==============================================================================
--- Prophet/trunk/lib/Prophet/ReplicaExporter.pm	(original)
+++ Prophet/trunk/lib/Prophet/ReplicaExporter.pm	Thu Jul 31 23:36:22 2008
@@ -2,7 +2,6 @@
 use Moose;
 use Params::Validate qw(:all);
 use Path::Class;
-use UNIVERSAL::require;
 
 has source_replica => (
     is  => 'rw',



More information about the Bps-public-commit mailing list