[Bps-public-commit] r11254 - in SVN-PropDB: bin lib/Prophet lib/Prophet/Sync lib/Prophet/Sync/Source lib/Prophet/Sync/Source/SVN t
jesse at bestpractical.com
jesse at bestpractical.com
Fri Mar 28 14:32:00 EDT 2008
Author: jesse
Date: Fri Mar 28 14:31:58 2008
New Revision: 11254
Added:
SVN-PropDB/bin/prophet-merge
- copied, changed from r11068, /SVN-PropDB/bin/merger
SVN-PropDB/bin/prophet-node-create (contents, props changed)
SVN-PropDB/bin/prophet-node-delete (contents, props changed)
SVN-PropDB/bin/prophet-node-history (contents, props changed)
SVN-PropDB/bin/prophet-node-search (contents, props changed)
SVN-PropDB/bin/prophet-node-show (contents, props changed)
SVN-PropDB/bin/prophet-node-update (contents, props changed)
SVN-PropDB/lib/Prophet/CLI.pm
SVN-PropDB/lib/Prophet/Sync/Source/SVN/Util.pm
SVN-PropDB/t/01-dependencies.t
SVN-PropDB/t/99-pod-coverage.t
SVN-PropDB/t/99-pod.t
Removed:
SVN-PropDB/bin/merger
SVN-PropDB/lib/Prophet/Editor.pm
Modified:
SVN-PropDB/ (props changed)
SVN-PropDB/Makefile.PL
SVN-PropDB/lib/Prophet/Handle.pm
SVN-PropDB/lib/Prophet/Sync/Source.pm
SVN-PropDB/lib/Prophet/Sync/Source/SVN.pm
SVN-PropDB/t/use.t
Log:
r28753 at 100: jesse | 2008-03-28 10:34:04 -0400
* Dependency testing, pod testing, importing cli tools
Modified: SVN-PropDB/Makefile.PL
==============================================================================
--- SVN-PropDB/Makefile.PL (original)
+++ SVN-PropDB/Makefile.PL Fri Mar 28 14:31:58 2008
@@ -1,8 +1,10 @@
#!/usr/bin/perl
#
use inc::Module::Install;
-
-requires('SVN::Core');
+requires('Params::Validate');
+requires('Class::Accessor');
+requires('Data::UUID');
+requires('SVN::Core'); # SVN::Repos SVN::Fs SVN::Ra SVN::Delta::Editor SVN::Client SVN::Delta
all_from('lib/Prophet.pm');
WriteAll();
Copied: SVN-PropDB/bin/prophet-merge (from r11068, /SVN-PropDB/bin/merger)
==============================================================================
--- /SVN-PropDB/bin/merger (original)
+++ SVN-PropDB/bin/prophet-merge Fri Mar 28 14:31:58 2008
@@ -12,8 +12,8 @@
GetOptions( $opts, 'target=s', 'source=s' );
validate_options($opts);
-my $target = Prophet::Sync::Source::SVN->new( { url => $opts->{'target'} } );
-my $source = Prophet::Sync::Source::SVN->new( { url => $opts->{'source'} } );
+my $target = Prophet::Sync::Source->new( { url => $opts->{'target'} } );
+my $source = Prophet::Sync::Source->new( { url => $opts->{'source'} } );
if ( $target->uuid eq $source->uuid ) {
fatal_error( "You appear to be trying to merge two identical replicas. "
Added: SVN-PropDB/bin/prophet-node-create
==============================================================================
--- (empty file)
+++ SVN-PropDB/bin/prophet-node-create Fri Mar 28 14:31:58 2008
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Prophet::CLI;
+my $prophet = Prophet->new();
+my $cli_handle = Prophet::CLI->new();
+$cli_handle->parse_record_cmd_args();
+
+my $record = Prophet::Record->new(handle => $prophet->handle, type => $cli_handle->type);
+my ($id, $results)= $record->create( props => $cli_handle->args);
+print "Created $type ".$record->uuid."\n";
Added: SVN-PropDB/bin/prophet-node-delete
==============================================================================
--- (empty file)
+++ SVN-PropDB/bin/prophet-node-delete Fri Mar 28 14:31:58 2008
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Prophet::CLI;
+my $prophet = Prophet->new();
+my $cli_handle = Prophet::CLI->new();
+$cli_handle->parse_record_cmd_args();
+
+my $record = Prophet::Record->new( handle => $prophet->handle);
+$record->load(uuid => $cli_handle->uuid;
+if( $record->delete ) {
+ print $record->type." ".$record->uuid." deleted.\n";
+} else {
+ print $record->type." ".$record->uuid."could not be deleted.\n";
+}
+
+
+
Added: SVN-PropDB/bin/prophet-node-history
==============================================================================
--- (empty file)
+++ SVN-PropDB/bin/prophet-node-history Fri Mar 28 14:31:58 2008
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Prophet::CLI;
+my $prophet = Prophet->new();
+my $cli_handle = Prophet::CLI->new();
+$cli_handle->parse_record_cmd_args();
+
+my $record = Prophet::Record->new(handle => $prophet->handle, type => $cli_handle->type);
+
+
+$record->load(uuid => $cli_handle->uuid);
+
+print "id: ".$record->uuid."\n";
+my $props = $record->get_props();
+
+for (keys %$props) {
+print $_.": ".$props->{$_}."\n";
+}
+
+
+my $nodes = $record->history;
+for my $node (@$nodes) {
+print "="x40 ."\n";
+print $node->rev.'@'. $node->date .' <'.$node->author.">\n";
+print "- should show source information\n";
+print " - should skip merge info if not in a verbose mode";
+print $node->msg."\n" if ($node->msg);
+for my $key ( keys %{ $node->prop_changes } ) {
+ print "$key ";
+ if ( $node->prop_changes->{$key}->{'add'}
+ && $node->prop_changes->{$key}->{'del'} )
+ {
+
+ print "changed from '"
+ . $node->prop_changes->{$key}->{'add'}
+ . "' to '"
+ . $node->prop_changes->{$key}->{'del'} . "'\n"
+
+ } elsif ( $node->prop_changes->{$key}->{'add'} ) {
+ print "added '" . $node->prop_changes->{$key}->{'add'} . "'\n";
+ } elsif ( $node->prop_changes->{$key}->{'del'} ) {
+ print "removed '" . $node->prop_changes->{$key}->{'del'} . "'\n";
+ }
+}
+}
Added: SVN-PropDB/bin/prophet-node-search
==============================================================================
--- (empty file)
+++ SVN-PropDB/bin/prophet-node-search Fri Mar 28 14:31:58 2008
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+unless ($regex = $cli_handle->args->{regex}) {
+ die "Specify a regular expression and we'll search for records matching that regex"
+}
+
+
+my $records = Prophet::Collection->new(handle => $svb->handle, type => $cli_handle->type);
+$records->matching( sub {
+ my $item = shift;
+ my $props = $item->get_props;
+ map { return 1 if $props->{$_} =~ $regex} keys %$props;
+ return 0
+ });
+
+for (@{$records->as_array_ref}) {
+ printf ("%s %s %s \n", $_->uuid, $_->prop( 'summary')||"(no summary)", $_->prop('status')||'(no status)');
+}
Added: SVN-PropDB/bin/prophet-node-show
==============================================================================
--- (empty file)
+++ SVN-PropDB/bin/prophet-node-show Fri Mar 28 14:31:58 2008
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Prophet::CLI;
+my $prophet = Prophet->new();
+my $cli_handle = Prophet::CLI->new();
+$cli_handle->parse_record_cmd_args();
+
+my $record = Prophet::Record->new(handle => $prophet->handle, type => $cli_handle->type);
+
+$record->load(uuid => $cli_handle->uuid);
+print "id: ".$record->uuid."\n";
+my $props = $record->get_props();
+for (keys %$props) {
+ print $_.": ".$props->{$_}."\n";
+}
+
+
+
+
Added: SVN-PropDB/bin/prophet-node-update
==============================================================================
--- (empty file)
+++ SVN-PropDB/bin/prophet-node-update Fri Mar 28 14:31:58 2008
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use Prophet::CLI;
+my $prophet = Prophet->new();
+my $cli_handle = Prophet::CLI->new();
+$cli_handle->parse_record_cmd_args();
+
+my $record = Prophet::Record->new(handle => $prophet->handle, type => $cli_handle->type);
+
+$record->load(uuid => $cli_handle->uuid);
+$record->set_props(props => $prophet->args);
+
+warn "We want more feedback here";
Added: SVN-PropDB/lib/Prophet/CLI.pm
==============================================================================
--- (empty file)
+++ SVN-PropDB/lib/Prophet/CLI.pm Fri Mar 28 14:31:58 2008
@@ -0,0 +1,60 @@
+use warnings;
+use strict;
+
+package Prophet::CLI;
+use base qw/Class::Accessor/;
+__PACKAGE__->mk_accessors(qw/type uuid/);
+use Prophet;
+
+=head2 parse_args
+
+This routine pulls arguments passed on the command line out of ARGV and sticks them in L</args>. The keys have leading "--" stripped.
+
+
+=cut
+
+sub parse_args {
+ my $self = shift;
+ $self->{args} = @ARGV;
+ for my $name ( keys $self->{'args'} ) {
+ die "$name doesn't look like --prop-name" if ( $name !~ /^--/ );
+ $name =~ /^--(.*)$/;
+ $self->{args}->{$1} = delete $self->{'args'}->{$name};
+ }
+
+}
+
+=head2 parse_record_cmd_args
+
+When working with individual records, it is often the case that we'll be expecting a --type argument and then a mess of other key-value pairs.
+
+=cut
+
+sub parse_record_cmd_args {
+ my $self = shift;
+ $self->parse_args();
+
+ if ( my $uuid = delete $self->{args}->{uuid} ) {
+ $self->type( $uuid);
+ }
+ if ( $self->{args}->{type} ) {
+ $self->type( delete $self->{args}->{'type'} );
+ } else {
+ die 'Node "--type" argument is mandatory';
+ }
+}
+
+=head2 args
+
+Returns a reference to the key-value pairs passed in on the command line
+
+=cut
+
+
+sub args {
+ my $self = shift;
+ return $self->{'args'};
+
+}
+
+1;
Modified: SVN-PropDB/lib/Prophet/Handle.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Handle.pm (original)
+++ SVN-PropDB/lib/Prophet/Handle.pm Fri Mar 28 14:31:58 2008
@@ -7,13 +7,19 @@
use Data::Dumper;
use Data::UUID;
-use Prophet::Editor;
use SVN::Core;
use SVN::Repos;
use SVN::Fs;
__PACKAGE__->mk_accessors(qw(repo_path repo_handle db_root current_edit));
+
+=head2 new { repository => $FILESYSTEM_PATH, db_root => $REPOS_PATH }
+
+Create a new subversion filesystem backend repository handle. If the repository/path don't exist, create it.
+
+=cut
+
sub new {
my $class = shift;
my $self = {};
@@ -26,26 +32,26 @@
return $self;
}
+=head2 current_root
+
+Returns a handle to the svn filesystem's HEAD
+
+=cut
+
sub current_root {
my $self = shift;
- $self->repo_handle->fs->revision_root(
- $self->repo_handle->fs->youngest_rev );
+ $self->repo_handle->fs->revision_root( $self->repo_handle->fs->youngest_rev );
}
sub _connect {
my $self = shift;
+ my $repos = eval { SVN::Repos::open( $self->repo_path ); };
- my $repos;
- eval {
- $repos = SVN::Repos::open( $self->repo_path );
-
- };
-
- if ( $@ && !-d $self->repo_path ) {
- $repos = SVN::Repos::create( $self->repo_path, undef, undef, undef,
- undef );
-
+ # If we couldn't open the repository handle, we should create it
+ if ( $@ && ! -d $self->repo_path ) {
+ $repos = SVN::Repos::create( $self->repo_path, undef, undef, undef, undef );
}
+
$self->repo_handle($repos);
$self->_create_nonexistent_dir( $self->db_root );
}
@@ -59,14 +65,12 @@
$self->current_edit->root->make_dir($dir);
$self->commit_edit() unless ($inside_edit);
}
-
}
sub begin_edit {
my $self = shift;
my $fs = $self->repo_handle->fs;
$self->current_edit( $fs->begin_txn( $fs->youngest_rev ));
-
return $self->current_edit;
}
@@ -84,26 +88,10 @@
my $self = shift;
my $changeset = shift;
- # open up a change handle locally
-
$self->begin_edit();
-
- for my $change ( $changeset->changes ) {
- $self->_integrate_change($change);
- }
-
-
+ $self->_integrate_change($_) for ($changeset->changes);
$self->_set_original_source_metadata($changeset);
-
-
- # finalize the local change
$self->commit_edit();
-
-
-
- # update the change's metadata with:
- # original repo
- # orignal sequence no
}
sub _set_original_source_metadata {
@@ -112,8 +100,6 @@
$self->current_edit->change_prop( 'prophet:original-source' => $change->original_source_uuid ||$change->source_uuid );
$self->current_edit->change_prop( 'prophet:original-sequence-no' => $change->original_sequence_no ||$change->sequence_no);
-
-
}
Modified: SVN-PropDB/lib/Prophet/Sync/Source.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Sync/Source.pm (original)
+++ SVN-PropDB/lib/Prophet/Sync/Source.pm Fri Mar 28 14:31:58 2008
@@ -4,5 +4,45 @@
package Prophet::Sync::Source;
use base qw/Class::Accessor/;
+=head1 NAME
+
+Prophet::Sync::Source
+
+=head1 DESCRIPTION
+
+A base class for all Prophet sync sources
+
+=cut
+
+=head1 METHODS
+
+=head2 new
+
+Instantiates a new sync source
+
+=cut
+
+sub new {
+ my $self = shift->SUPER::new(@_);
+ $self->rebless_to_replica_type();
+ $self->setup();
+ return $self;
+}
+
+=head2 rebless_to_replica_type
+
+Reblesses this sync source into the right sort of sync source for whatever kind of replica $self->url points to
+
+TODO: currently knows that we only have SVN replicas
+
+
+=cut
+
+
+sub rebless_to_replica_type {
+ my $self = shift;
+ bless $self, 'Prophet::Sync::Source::SVN';
+}
+
1;
Modified: SVN-PropDB/lib/Prophet/Sync/Source/SVN.pm
==============================================================================
--- SVN-PropDB/lib/Prophet/Sync/Source/SVN.pm (original)
+++ SVN-PropDB/lib/Prophet/Sync/Source/SVN.pm Fri Mar 28 14:31:58 2008
@@ -7,26 +7,19 @@
use SVN::Core;
use SVN::Ra;
-use SVK;
-use SVK::Config;
use SVN::Delta;
use Prophet::Handle;
use Prophet::Sync::Source::SVN::ReplayEditor;
+use Prophet::Sync::Source::SVN::Util;
use Prophet::ChangeSet;
__PACKAGE__->mk_accessors(qw/url ra prophet_handle/);
-sub new {
- my $self = shift->SUPER::new(@_);
- $self->setup();
- return $self;
-}
-
sub setup {
my $self = shift;
- my ( $baton, $ref ) = SVN::Core::auth_open_helper( SVK::Config->get_auth_providers );
- my $config = SVK::Config->svnconfig;
+ my ( $baton, $ref ) = SVN::Core::auth_open_helper( Prophet::Sync::Source::SVN::Util->get_auth_providers );
+ my $config = Prophet::Sync::Source::SVN::Util->svnconfig;
$self->ra( SVN::Ra->new( url => $self->url, config => $config, auth => $baton ));
if ( $self->url =~ /^file:\/\/(.*)$/ ) {
@@ -44,7 +37,7 @@
Fetch all changesets from the source.
-Returns a reference to an array of L<Prophet::ChangeSet> objects.
+Returns a reference to an array of L<Prophet::ChangeSet/> objects.
=cut
@@ -172,7 +165,7 @@
=head2 conflicts_from_changeset Prophet::ChangeSet
-Returns a L<Prophet::Conflict> object if the supplied L<Prophet::ChangeSet
+Returns a L<Prophet::Conflict/> object if the supplied L<Prophet::ChangeSet/>
will generate conflicts if applied to the current replica.
Returns undef if the current changeset wouldn't generate a conflict.
Added: SVN-PropDB/lib/Prophet/Sync/Source/SVN/Util.pm
==============================================================================
--- (empty file)
+++ SVN-PropDB/lib/Prophet/Sync/Source/SVN/Util.pm Fri Mar 28 14:31:58 2008
@@ -0,0 +1,180 @@
+use warnings;
+use strict;
+
+# XXX CARGO CULTED FROM SVK::Util;
+package Prophet::Sync::Source::SVN::Util;
+
+use base 'Class::Data::Inheritable';
+
+__PACKAGE__->mk_classdata('_svnconfig');
+__PACKAGE__->mk_classdata('auth_providers');
+
+# XXX: this is 1.3 api. use SVN::Auth::* for 1.4 and we don't have to load ::Client anymore
+# (well, fix svn perl bindings to wrap the prompt functions correctly first.
+use SVN::Client;
+__PACKAGE__->auth_providers(
+ sub {
+ my $keychain = SVN::_Core->can('svn_auth_get_keychain_simple_provider');
+ my $win32 = SVN::_Core->can('svn_auth_get_windows_simple_provider');
+ [
+ $keychain ? $keychain : (),
+ $win32 ? $win32 : (),
+ SVN::Client::get_simple_provider(),
+ SVN::Client::get_ssl_server_trust_file_provider(),
+ SVN::Client::get_username_provider(),
+ SVN::Client::get_simple_prompt_provider( \&_simple_prompt, 2 ),
+ SVN::Client::get_ssl_server_trust_prompt_provider(
+ \&_ssl_server_trust_prompt
+ ),
+ SVN::Client::get_ssl_client_cert_prompt_provider(
+ \&_ssl_client_cert_prompt, 2
+ ),
+ SVN::Client::get_ssl_client_cert_pw_prompt_provider(
+ \&_ssl_client_cert_pw_prompt, 2
+ ),
+ SVN::Client::get_username_prompt_provider( \&_username_prompt, 2 ),
+ ];
+ }
+);
+
+my $pool = SVN::Pool->new;
+
+sub svnconfig {
+ my $class = shift;
+ return $class->_svnconfig if $class->_svnconfig;
+
+ return undef if $ENV{SVKNOSVNCONFIG};
+
+ SVN::Core::config_ensure(undef);
+ return $class->_svnconfig( SVN::Core::config_get_config(undef, $pool) );
+}
+
+# Note: Use a proper default pool when calling get_auth_providers
+sub get_auth_providers {
+ my $class = shift;
+ return $class->auth_providers->();
+}
+
+use constant OK => $SVN::_Core::SVN_NO_ERROR;
+
+# Implement auth callbacks
+sub _simple_prompt {
+ my ($cred, $realm, $default_username, $may_save, $pool) = @_;
+
+ if (defined $default_username and length $default_username) {
+ print "Authentication realm: $realm\n" if defined $realm and length $realm;
+ $cred->username($default_username);
+ }
+ else {
+ _username_prompt($cred, $realm, $may_save, $pool);
+ }
+
+ $cred->password(_read_password("Password for '" . $cred->username . "': "));
+ $cred->may_save($may_save);
+
+ return OK;
+}
+
+sub _ssl_server_trust_prompt {
+ my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
+
+ print "Error validating server certificate for '$realm':\n";
+
+ print " - The certificate is not issued by a trusted authority. Use the\n",
+ " fingerprint to validate the certificate manually!\n"
+ if ($failures & $SVN::Auth::SSL::UNKNOWNCA);
+
+ print " - The certificate hostname does not match.\n"
+ if ($failures & $SVN::Auth::SSL::CNMISMATCH);
+
+ print " - The certificate is not yet valid.\n"
+ if ($failures & $SVN::Auth::SSL::NOTYETVALID);
+
+ print " - The certificate has expired.\n"
+ if ($failures & $SVN::Auth::SSL::EXPIRED);
+
+ print " - The certificate has an unknown error.\n"
+ if ($failures & $SVN::Auth::SSL::OTHER);
+
+ printf(
+ "Certificate information:\n".
+ " - Hostname: %s\n".
+ " - Valid: from %s until %s\n".
+ " - Issuer: %s\n".
+ " - Fingerprint: %s\n",
+ map $cert_info->$_, qw(hostname valid_from valid_until issuer_dname fingerprint)
+ );
+
+ print(
+ $may_save
+ ? "(R)eject, accept (t)emporarily or accept (p)ermanently? "
+ : "(R)eject or accept (t)emporarily? "
+ );
+
+ my $choice = lc(substr(<STDIN> || 'R', 0, 1));
+
+ if ($choice eq 't') {
+ $cred->may_save(0);
+ $cred->accepted_failures($failures);
+ }
+ elsif ($may_save and $choice eq 'p') {
+ $cred->may_save(1);
+ $cred->accepted_failures($failures);
+ }
+
+ return OK;
+}
+
+sub _ssl_client_cert_prompt {
+ my ($cred, $realm, $may_save, $pool) = @_;
+
+ print "Client certificate filename: ";
+ chomp(my $filename = <STDIN>);
+ $cred->cert_file($filename);
+
+ return OK;
+}
+
+sub _ssl_client_cert_pw_prompt {
+ my ($cred, $realm, $may_save, $pool) = @_;
+
+ $cred->password(_read_password("Passphrase for '%s': "));
+
+ return OK;
+}
+
+sub _username_prompt {
+ my ($cred, $realm, $may_save, $pool) = @_;
+
+ print "Authentication realm: $realm\n" if defined $realm and length $realm;
+ print "Username: ";
+ chomp(my $username = <STDIN>);
+ $username = '' unless defined $username;
+
+ $cred->username($username);
+
+ return OK;
+}
+
+sub _read_password {
+ my ($prompt) = @_;
+
+ print $prompt;
+
+ require Term::ReadKey;
+ Term::ReadKey::ReadMode('noecho');
+
+ my $password = '';
+ while (defined(my $key = Term::ReadKey::ReadKey(0))) {
+ last if $key =~ /[\012\015]/;
+ $password .= $key;
+ }
+
+ Term::ReadKey::ReadMode('restore');
+ print "\n";
+
+ return $password;
+}
+
+
+1;
Added: SVN-PropDB/t/01-dependencies.t
==============================================================================
--- (empty file)
+++ SVN-PropDB/t/01-dependencies.t Fri Mar 28 14:31:58 2008
@@ -0,0 +1,76 @@
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+=head1 DESCRIPTION
+
+Makes sure that all of the modules that are 'use'd are listed in the
+Makefile.PL as dependencies.
+
+=cut
+
+use Test::More;
+use File::Find;
+eval 'use Module::CoreList';
+if($@) {plan skip_all => 'Module::CoreList not installed'}
+
+plan 'no_plan';
+
+my %used;
+find( \&wanted, qw/ lib bin t /);
+
+sub wanted {
+ return unless -f $_;
+ return if $File::Find::dir =~ m!/.svn($|/)!;
+ return if $File::Find::name =~ /~$/;
+ return if $File::Find::name =~ /\.(pod|html)$/;
+
+ # read in the file from disk
+ my $filename = $_;
+ local $/;
+ open(FILE, $filename) or return;
+ my $data = <FILE>;
+ close(FILE);
+
+ # strip pod, in a really idiotic way. Good enough though
+ $data =~ s/^=head.+?(^=cut|\Z)//gms;
+
+ # look for use and use base statements
+ $used{$1}{$File::Find::name}++ while $data =~ /^\s*use\s+([\w:]+)/gm;
+ while ($data =~ m|^\s*use base qw.([\w\s:]+)|gm) {
+ $used{$_}{$File::Find::name}++ for split ' ', $1;
+ }
+}
+
+my %required;
+{
+ local $/;
+ ok(open(MAKEFILE,"Makefile.PL"), "Opened Makefile");
+ my $data = <MAKEFILE>;
+ close(FILE);
+ while ($data =~ /^\s*?(?:requires|recommends)\('([\w:]+)'(?:\s*=>\s*['"]?([\d\.]+)['"]?)?.*?(?:#(.*))?$/gm) {
+ $required{$1} = $2;
+ if (defined $3 and length $3) {
+ $required{$_} = undef for split ' ', $3;
+ }
+ }
+}
+
+for (sort keys %used) {
+ my $first_in = Module::CoreList->first_release($_);
+ next if defined $first_in and $first_in <= 5.00803;
+ next if /^(Prophet|inc|t)(::|$)/;
+ ok(exists $required{$_}, "$_ in Makefile.PL")
+ or diag("used in ", join ", ", sort keys %{ $used{$_ } });
+ delete $used{$_};
+ delete $required{$_};
+}
+
+for (sort keys %required) {
+ my $first_in = Module::CoreList->first_release($_, $required{$_});
+ fail("Required module $_ (v. $required{$_}) is in core since $first_in") if defined $first_in and $first_in <= 5.008003;
+}
+
+1;
+
Added: SVN-PropDB/t/99-pod-coverage.t
==============================================================================
--- (empty file)
+++ SVN-PropDB/t/99-pod-coverage.t Fri Mar 28 14:31:58 2008
@@ -0,0 +1,13 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.00";
+plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
+plan skip_all => "Coverage tests only run for authors" unless (-d 'inc/.author');
+all_pod_coverage_ok( );
+
+# Workaround for dumb bug (fixed in 5.8.7) where Test::Builder thinks that
+# certain "die"s that happen inside evals are not actually inside evals,
+# because caller() is broken if you turn on $^P like Module::Refresh does
+#
+# (I mean, if we've gotten to this line, then clearly the test didn't die, no?)
+Test::Builder->new->{Test_Died} = 0;
+
Added: SVN-PropDB/t/99-pod.t
==============================================================================
--- (empty file)
+++ SVN-PropDB/t/99-pod.t Fri Mar 28 14:31:58 2008
@@ -0,0 +1,5 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+
Modified: SVN-PropDB/t/use.t
==============================================================================
--- SVN-PropDB/t/use.t (original)
+++ SVN-PropDB/t/use.t Fri Mar 28 14:31:58 2008
@@ -3,7 +3,6 @@
use Test::More 'no_plan';
use_ok('Prophet');
-use_ok('Prophet::Editor');
use_ok('Prophet::Handle');
use_ok('Prophet::Record');
use_ok('Prophet::Collection');
More information about the Bps-public-commit
mailing list