Permalink
Browse files

split out some common subs to ::Tools

  • Loading branch information...
1 parent 9afef13 commit 2c20aa568840b5e577d25d795ae5bc307db2dc0a @szabgab committed May 17, 2011
Showing with 55 additions and 57 deletions.
  1. +9 −13 lib/CPAN/Digger/DB.pm
  2. +2 −35 lib/CPAN/Digger/Index.pm
  3. +41 −0 lib/CPAN/Digger/Tools.pm
  4. +3 −9 lib/CPAN/Digger/WWW.pm
View
@@ -12,6 +12,8 @@ use Data::Dumper qw(Dumper);
use File::Basename qw(dirname);
use File::Path qw(mkpath);
+use CPAN::Digger::Tools;
+
my $sql_insert = q{
INSERT INTO distro (author, name, version, path, file_timestamp, added_timestamp)
VALUES (?, ?, ?, ?, ?, ?)
@@ -54,7 +56,7 @@ sub insert_distro {
$self->dbh->do($sql_insert, {}, @args);
};
if ($@) {
- CPAN::Digger::Index::ERROR("Exception in insert_distro @args");
+ ERROR("Exception in insert_distro @args");
}
}
}
@@ -149,7 +151,7 @@ sub _get_distros {
sub unzip_error {
my ($self, $path, $error, $details) = @_;
- CPAN::Digger::Index::WARN("unzip_error $error - $details in $path");
+ WARN("unzip_error $error - $details in $path");
my $cnt = $self->dbh->do('UPDATE distro SET unzip_error=?, unzip_error_details=? WHERE path=?', {},
$error, $details, $path);
# TODO: report if cannot update?
@@ -200,8 +202,8 @@ sub update_distro_details {
my $sql = "INSERT INTO distro_details (id $fields) VALUES(? $placeholders)";
- #CPAN::Digger::Index::LOG("SQL: $sql");
- #CPAN::Digger::Index::LOG("$id @values");
+ #LOG("SQL: $sql");
+ #LOG("$id @values");
$self->dbh->do('DELETE FROM distro_details WHERE id=?', {}, $id);
$self->dbh->do($sql, {}, $id, @values);
@@ -307,7 +309,7 @@ sub update_author_json {
##### module table
sub update_module {
my ($self, $data, $min_perl, $is_module, $distro_id) = @_;
- CPAN::Digger::Index::LOG("update_module of $distro_id " . Dumper $data);
+ LOG("update_module of $distro_id " . Dumper $data);
# name is defined as unique though I think what should be unique is the name + distro_id
# we then will have to also find out which distro is the one that is really supplying the module!
# for now we keep this simple (and probably incorrect)
@@ -326,9 +328,9 @@ sub get_module_by_name {
sub add_subs {
my ($self, $module, $subs) = @_;
- CPAN::Digger::Index::LOG("add subs $module " . Dumper $subs);
+ LOG("add subs $module " . Dumper $subs);
my $m = $self->get_module_by_name($module);
- CPAN::Digger::Index::LOG("m: " . Dumper $m);
+ LOG("m: " . Dumper $m);
return if not $m;
foreach my $s (@$subs) {
@@ -467,11 +469,5 @@ sub count_violations {
#########################################################
-sub slurp {
- my $file = shift;
- open my $fh, '<', $file or die;
- local $/ = undef;
- <$fh>;
-}
1;
View
@@ -34,6 +34,7 @@ use Archive::Any;
use CPAN::Digger::PPI;
use CPAN::Digger::Pod;
use CPAN::Digger::DB;
+use CPAN::Digger::Tools;
#has 'counter' => (is => 'rw', isa => 'HASH');
has 'counter_distro' => (is => 'rw', isa => 'Int', default => 0);
@@ -99,7 +100,7 @@ sub process_all_distros {
next if $filter and $name !~ qr{$filter};
- LOG(Dumper $name);
+ LOG("Work on $name");
my $d = $distros->{$name};
my $details = db->get_distro_details_by_id($d->{id});
next if $details;
@@ -159,7 +160,6 @@ sub process_distro {
my $dist = db->get_distro_by_path($path);
#LOG("Update DB for id $dist->{id}");
- #LOG(Dumper $id
my $min_perl_version = 1;
db->dbh->begin_work;
@@ -796,37 +796,4 @@ sub update_from_whois {
}
-
-
-sub ERROR {
- _log('ERROR', @_);
-}
-sub WARN {
- _log('WARN', @_);
-}
-sub LOG {
- _log('LOG', @_);
-}
-sub _log {
- my ($level, @msg) = @_;
-
- return if $ENV{DIGGER_SILENT};
- #return if $level eq 'LOG';
-
- my $time = POSIX::strftime("%Y-%b-%d %H:%M:%S", localtime);
-
- # need to interpolate outside the printf format as there might be % signs in @msg somewhere
- printf STDERR "%5s - %s - %s\n", $level, $time, "@msg";
-
- return;
-}
-
-sub slurp {
- my $file = shift;
- open my $fh, '<', $file or die;
- local $/ = undef;
- <$fh>;
-}
-
-
1;
View
@@ -0,0 +1,41 @@
+package CPAN::Digger::Tools;
+use strict;
+use warnings;
+
+our $VERSION = '0.02';
+
+use base 'Exporter';
+our @EXPORT = qw(slurp LOG ERROR WARN);
+
+sub slurp {
+ my $file = shift;
+ open my $fh, '<', $file or die;
+ local $/ = undef;
+ <$fh>;
+}
+
+sub ERROR {
+ _log('ERROR', @_);
+}
+sub WARN {
+ _log('WARN', @_);
+}
+sub LOG {
+ _log('LOG', @_);
+}
+sub _log {
+ my ($level, @msg) = @_;
+
+ return if $ENV{DIGGER_SILENT};
+ #return if $level eq 'LOG';
+
+ my $time = POSIX::strftime("%Y-%b-%d %H:%M:%S", localtime);
+
+ # need to interpolate outside the printf format as there might be % signs in @msg somewhere
+ printf STDERR "%5s - %s - %s\n", $level, $time, "@msg";
+
+ return;
+}
+
+
+1;
View
@@ -4,8 +4,6 @@ our $VERSION = '0.02';
use Dancer ':syntax';
-use CPAN::Digger::DB;
-
use Data::Dumper qw(Dumper);
use Encode qw(decode);
use File::Basename qw(basename);
@@ -15,6 +13,9 @@ use POSIX ();
use Time::HiRes qw(time);
use YAML ();
+use CPAN::Digger::DB;
+use CPAN::Digger::Tools;
+
#set serializer => 'Mutable';
sub render_response {
@@ -479,13 +480,6 @@ sub _date {
return POSIX::strftime("%Y %b %d", gmtime shift);
}
-sub slurp {
- my $file = shift;
- open my $fh, '<', $file or die;
- local $/ = undef;
- <$fh>;
-}
-
sub _escape {
my $str = shift;
$str =~ s{<}{&lt;}g;

0 comments on commit 2c20aa5

Please sign in to comment.