Permalink
Browse files

Replace warn() if $self->verbose() with Log::Any.

  • Loading branch information...
1 parent b425482 commit 9adfe33cddda24e9bd5a7592c41d5e7186fa87fa @rcaputo committed Aug 19, 2012
Showing with 110 additions and 55 deletions.
  1. +13 −0 bin/snanalyze
  2. +22 −6 bin/snassign-auto
  3. +13 −0 bin/snerp
  4. +13 −0 bin/snerp-projector
  5. +23 −14 lib/SVN/Analysis.pm
  6. +7 −11 lib/SVN/Dump/Analyzer.pm
  7. +19 −24 lib/SVN/Dump/Replayer.pm
View
@@ -10,6 +10,9 @@ use lib qw(./lib);
use Getopt::Long;
use SVN::Dump::Analyzer;
+use Log::Any::Adapter;
+use POSIX qw(strftime);
+
my ($dump_file_name, $db_file_name);
my ($verbose, $help) = (0, 0);
@@ -49,6 +52,16 @@ die "$0: --db=FILENAME required\n" unless (
die "$0: --db path ($db_file_name) must not exist\n" if -e $db_file_name;
+Log::Any::Adapter->set(
+ 'ScreenColoredLevel',
+ min_level => ($verbose ? 'trace' : 'warning'),
+ formatter => sub {
+ my ($file, $line) = (caller(1))[1,2];
+ $file =~ s!.*/!!;
+ strftime('%F %T', localtime()) . " - $file:$line - $_[1]";
+ },
+);
+
# Analyze the SVN dump.
my $analyzer = SVN::Dump::Analyzer->new(
View
@@ -10,10 +10,16 @@ use lib qw(./lib);
use Getopt::Long;
use SVN::Analysis;
-my ($help, $analysis_db);
+use Log::Any::Adapter;
+use POSIX qw(strftime);
+use Log::Any qw($log);
+
+my ($help, $analysis_db, $verbose);
+
my $getopt_okay = GetOptions(
"help" => \$help,
"analysis=s" => \$analysis_db,
+ "verbose" => \$verbose,
);
if ($help or !$getopt_okay) {
@@ -34,21 +40,31 @@ die "$0: --analysis path ($analysis_db) must be a file\n" unless (
-f $analysis_db
);
+Log::Any::Adapter->set(
+ 'ScreenColoredLevel',
+ min_level => ($verbose ? 'trace' : 'warning'),
+ formatter => sub {
+ my ($file, $line) = (caller(1))[1,2];
+ $file =~ s!.*/!!;
+ strftime('%F %T', localtime()) . " - $file:$line - $_[1]";
+ },
+);
+
### Load the Subversion analysis.
-warn time(), " attaching to database...\n";
+$log->trace("Attaching to database.");
my $analysis = SVN::Analysis->new(db_file_name => $analysis_db);
-warn time(), " analyzing...\n";
+$log->trace("Analyzing.");
$analysis->analyze();
-warn time(), " finding tags, etc...\n";
+$log->trace("Finding tags, etc.");
$analysis->auto_tag(\&get_entity_hint);
-warn time(), " fixing copy targets...\n";
+$log->trace("Fixing copy targets.");
$analysis->fix_copy_targets();
-warn time(), " done.\n";
+$log->trace("Done.");
exit;
sub get_entity_hint {
View
@@ -11,6 +11,9 @@ STDOUT->autoflush(1);
use Getopt::Long;
+use Log::Any::Adapter;
+use POSIX qw(strftime);
+
my $replayer_class = "git";
my (
$authors_file, $replay_base, $dump_file_name, $copy_depot_path,
@@ -126,6 +129,16 @@ if (-e $copy_depot_path) {
die "$0: --copies path ($copy_depot_path) must not exist\n";
}
+Log::Any::Adapter->set(
+ 'ScreenColoredLevel',
+ min_level => ($verbose ? 'trace' : 'warning'),
+ formatter => sub {
+ my ($file, $line) = (caller(1))[1,2];
+ $file =~ s!.*/!!;
+ strftime('%F %T', localtime()) . " - $file:$line - $_[1]";
+ },
+);
+
# Convert the replayer class into a Perl class, and load it.
$replayer_class = "SVN::Dump::Replayer::" . ucfirst(lc($replayer_class));
eval "require $replayer_class";
View
@@ -10,6 +10,9 @@ use SVN::Analysis;
use Git::Repository;
use Getopt::Long;
+use Log::Any::Adapter;
+use POSIX qw(strftime);
+
my $last_log_time = $^T;
my ($map_file_name, $db_file_name, $git_base, $new_base, $help_me, $verbose);
@@ -42,6 +45,16 @@ die "$0: Source git directory $git_base must pre-exist.\n" unless (
-e $git_base
);
+Log::Any::Adapter->set(
+ 'ScreenColoredLevel',
+ min_level => ($verbose ? 'trace' : 'warning'),
+ formatter => sub {
+ my ($file, $line) = (caller(1))[1,2];
+ $file =~ s!.*/!!;
+ strftime('%F %T', localtime()) . " - $file:$line - $_[1]";
+ },
+);
+
my $analysis = SVN::Analysis->new(
db_file_name => $db_file_name,
verbose => $verbose,
View
@@ -6,6 +6,7 @@ use Carp qw(confess croak);
use DBI;
use SVN::Analysis::Dir;
use SVN::Analysis::Copy;
+use Log::Any qw($log);
has db_file_name => (
is => 'ro',
@@ -128,7 +129,7 @@ sub reset {
sub consider_add {
my ($self, $path, $revision, $kind) = @_;
- warn "add: $path $revision\n" if $self->verbose();
+ $log->trace("add: $path $revision");
# Touch the parent directory of the thing being added.
$self->_touch_parent_directory($path, $revision);
@@ -153,7 +154,7 @@ sub consider_add {
)
") or die $self->dbh()->errstr();
- warn "INSERT $path r$revision\n" if $self->verbose();
+ $log->trace("INSERT $path r$revision");
$sth->execute($path, $revision, $revision, "add", "add", 1, 1, 0, 0) or die (
$sth->errstr()
);
@@ -190,9 +191,7 @@ sub consider_copy {
# If this is a file, we're done.
return if $kind ne "dir";
- warn "copy: $src_path $src_rev > $dst_path $dst_rev\n" if (
- $self->verbose()
- );
+ $log->trace("copy: $src_path $src_rev > $dst_path $dst_rev");
# Copy the source path and all the entire tree below.
foreach my $path_to_copy ($self->_get_tree_paths($src_path, $src_rev)) {
@@ -201,7 +200,7 @@ sub consider_copy {
"can't relocate $path_to_copy from $src_path to $dst_path"
);
- warn "copy includes: $path_to_copy > $relocated_path\n" if $self->verbose();
+ $log->trace("copy includes: $path_to_copy > $relocated_path");
my $sth = $self->dbh()->prepare_cached("
INSERT INTO dir (
@@ -246,7 +245,7 @@ sub consider_delete {
$self->_path_exists($path_to_delete, $revision)
);
- warn "UPDATE $path $revision (is_active=0)\n" if $self->verbose();
+ $log->trace("UPDATE $path $revision (is_active=0)");
my $sth = $self->dbh()->prepare_cached("
UPDATE dir SET rev_last = ?, op_last = ?, is_active = ?
@@ -281,9 +280,13 @@ sub analyze {
my $failures = 0;
while ($sth->fetch()) {
$failures++;
- warn "path $path has $count is_active rows";
+ $log->warn("path $path has $count is_active rows");
+ }
+
+ if ($failures) {
+ $log->fatal("only 1 is_active row allowed for any path");
+ die;
}
- die "only 1 is_active row allowed for any path" if $failures;
# Normalize active directory final revisions.
@@ -382,9 +385,15 @@ sub auto_tag {
my $failures = 0;
while ($sth_find_sub_roots->fetch()) {
$failures++;
- warn "failure: entity at $ent_path contains sub-entity at $broken_path";
+ $log->warn(
+ "failure: entity at $ent_path contains sub-entity at $broken_path"
+ );
+ }
+
+ if ($failures) {
+ $log->fatal("sub-entities indicate bad entity recognition");
+ die;
}
- die "sub-entities indicate bad entity recognition" if $failures;
# Second, ensure that the lop and prepend paths are consistent
# throughout the tree.
@@ -797,7 +806,7 @@ sub _touch_directory {
foreach my $dir_path ($self->_get_container_paths($path, $revision)) {
- warn "touchdir: $dir_path $revision\n" if $self->verbose();
+ $log->trace("touchdir: $dir_path $revision");
my $sth_query = $self->dbh()->prepare_cached("
SELECT op_last, rev_first
@@ -820,7 +829,7 @@ sub _touch_directory {
"more than one active row for $path r$revision"
);
- warn "UPDATE $dir_path $rev_first -> $revision\n" if $self->verbose();
+ $log->trace("UPDATE $dir_path $rev_first -> $revision");
my $sth_update = $self->dbh()->prepare_cached("
UPDATE dir
@@ -897,7 +906,7 @@ sub _get_tree_paths {
my @found_paths;
while ($sth->fetch()) {
- warn "... $path = $found_path ($found_rev)\n" if $self->verbose();
+ $log->trace("... $path = $found_path ($found_rev)");
push @found_paths, $found_path;
}
View
@@ -8,6 +8,8 @@ use SVN::Analysis;
use Carp qw(croak);
use Storable qw(dclone);
+use Log::Any qw($log);
+
has analysis => (
is => 'rw',
isa => 'SVN::Analysis',
@@ -36,13 +38,13 @@ has verbose => ( is => 'ro', isa => 'Bool', default => 0 );
sub on_node_add {
my ($self, $revision, $path, $kind, $data) = @_;
- $self->log("ANL) r$revision add $kind $path");
+ $log->trace("r$revision add $kind $path");
$self->analysis()->consider_add($path, $revision, $kind);
}
sub on_node_change {
my ($self, $revision, $path, $kind, $data) = @_;
- $self->log("ANL) r$revision edit $kind $path");
+ $log->trace("ANL) r$revision edit $kind $path");
$self->analysis()->consider_change($path, $revision, $kind);
}
@@ -54,22 +56,22 @@ sub on_node_change {
# and addition in the same revision is confusing.
sub on_node_replace {
my ($self, $revision, $path, $kind, $data) = @_;
- $self->log("ANL) r$revision replace $kind $path");
+ $log->trace("ANL) r$revision replace $kind $path");
$self->analysis()->consider_delete($path, $revision);
$self->analysis()->consider_add($path, $revision, $kind);
}
sub on_node_copy {
my ($self, $dst_rev, $dst_path, $kind, $src_rev, $src_path, $text) = @_;
- $self->log("ANL) r$dst_rev copy $kind $dst_path from $src_path r$src_rev");
+ $log->trace("ANL) r$dst_rev copy $kind $dst_path from $src_path r$src_rev");
$self->analysis()->consider_copy(
$dst_path, $dst_rev, $kind, $src_path, $src_rev,
);
}
sub on_node_delete {
my ($self, $revision, $path) = @_;
- $self->log("ANL) r$revision delete $path");
+ $log->trace("ANL) r$revision delete $path");
$self->analysis()->consider_delete($path, $revision);
}
@@ -85,10 +87,4 @@ sub on_walk_begin {
$self->analysis()->consider_add("", 0, "dir");
}
-sub log {
- my $self = shift;
- return unless $self->verbose();
- warn time() - $^T, " ", join("", @_), "\n";
-}
-
1;
Oops, something went wrong.

0 comments on commit 9adfe33

Please sign in to comment.