Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Some log refactoring #2

Closed
wants to merge 2 commits into from

2 participants

Jason May Ricardo Signes
Jason May

Take two, with fewer warnings. :)

jasonmay added some commits
Jason May jasonmay Throw the PAUSE version display variable in PAUSE.pm
This will be used in subsequent changes that rely on this value in
PAUSE.pm itself.
f7eb97f
Jason May jasonmay Move the logging functionality into the config
Makes the functionality of the logging easier to override. As a result,
it made one less place to rely on catching specific method calls in the
mocked object in tests.
e832560
Ricardo Signes
Owner
rjbs commented

Thanks! Merged and on its way to ANDK!

Ricardo Signes rjbs closed this
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Showing 2 unique commits by 1 author.

Mar 05, 2013
Jason May jasonmay Throw the PAUSE version display variable in PAUSE.pm
This will be used in subsequent changes that rely on this value in
PAUSE.pm itself.
f7eb97f
Jason May jasonmay Move the logging functionality into the config
Makes the functionality of the logging easier to override. As a result,
it made one less place to rely on catching specific method calls in the
mocked object in tests.
e832560
This page is out of date. Refresh to see the latest.
35 lib/PAUSE.pm
@@ -37,12 +37,13 @@ if ($USE_RECENTFILE_HOOKS) {
37 37 our $IS_PAUSE_US = Sys::Hostname::hostname =~ /pause2/ ? 1 : 0;
38 38
39 39 use strict;
40   -use vars qw(@ISA @EXPORT_OK $VERSION $Config);
  40 +use vars qw(@ISA @EXPORT_OK $VERSION $Config $Id);
41 41
42 42 @ISA = qw(Exporter); ## no critic
43 43 @EXPORT_OK = qw(urecord);
44 44
45 45 $VERSION = "1.005";
  46 +$Id = "PAUSE version $PAUSE::VERSION";
46 47
47 48 # for Configuration Variable we use PrivatePAUSE.pm, because these are
48 49 # really variables we cannot publish. Will separate harmless variables
@@ -100,6 +101,33 @@ $PAUSE::Config ||=
100 101 HTTP_ERRORLOG => '/usr/local/apache/logs/error_log', # harmless use in cron-daily
101 102 INCOMING => $IS_PAUSE_US ? 'ftp://localhost/incoming/' : 'ftp://pause.perl.org/incoming/',
102 103 INCOMING_LOC => '/home/ftp/incoming/',
  104 + LOG_CALLBACK => sub {
  105 + # $entity: entity from which to grab log configuration
  106 + # $level: level by which logs are filtered
  107 + # @what: messages being logged
  108 + my($entity,$level,@what) = @_;
  109 + unless (@what) {
  110 + @what = ("warning: verbose called without \@what: ", $level);
  111 + $level = 1;
  112 + }
  113 + return if $level > ($entity->{VERBOSE}||0);
  114 + unless (exists $entity->{INTRODUCED}) {
  115 + my $now = scalar localtime;
  116 + require Data::Dumper;
  117 + unshift @what, "Running $0, $Id, $now",
  118 + Data::Dumper->new([$entity],[qw()])->Indent(1)->Useqq(1)->Dump;
  119 + $entity->{INTRODUCED} = undef;
  120 + }
  121 + push @what, "\n" unless $what[-1] =~ m{\n$};
  122 + my $logfh;
  123 + if (my $logfile = $entity->{OPT}{logfile}) {
  124 + open $logfh, ">>", $logfile or die;
  125 + unshift @what, scalar localtime;
  126 + } else {
  127 + $logfh = *STDOUT;
  128 + }
  129 + print $logfh @what;
  130 + },
103 131 MAXRETRIES => 16,
104 132 MIRRORCONFIG => '/usr/local/mirror/mymirror.config',
105 133 MIRRORED_BY_URL => "ftp://ftp.funet.fi/pub/languages/perl/CPAN/MIRRORED.BY",
@@ -233,6 +261,11 @@ sub filehash {
233 261 return $ret;
234 262 }
235 263
  264 +sub log {
  265 + my ($self, @arg) = @_;
  266 + $PAUSE::Config->{LOG_CALLBACK}->(@arg);
  267 +}
  268 +
236 269 sub dbh {
237 270 my($db) = shift || "mod";
238 271 my $dsn = $PAUSE::Config->{uc($db)."_DATA_SOURCE_NAME"};
4 lib/PAUSE/dist.pm
@@ -6,6 +6,7 @@ use vars qw(%CHECKSUMDONE $AUTOLOAD);
6 6 use Email::Sender::Simple qw(sendmail);
7 7 use File::Copy ();
8 8 use List::MoreUtils ();
  9 +use PAUSE ();
9 10 use Parse::CPAN::Meta;
10 11 use PAUSE::mldistwatch::Constants;
11 12
@@ -949,8 +950,7 @@ sub version_from_meta_ok {
949 950 # package PAUSE::dist
950 951 sub verbose {
951 952 my($self,$level,@what) = @_;
952   - my $main = $self->{MAIN};
953   - $main->verbose($level,@what);
  953 + PAUSE->log($self, $level, @what);
954 954 }
955 955
956 956 # package PAUSE::dist
33 lib/PAUSE/mldistwatch.pm
@@ -49,7 +49,6 @@ use DB_File;
49 49 use Fcntl qw(O_RDWR O_CREAT);
50 50 use File::Find;
51 51 use File::Path qw(rmtree mkpath);
52   -our $Id = "PAUSE version $PAUSE::VERSION";
53 52 our $MAINTAIN_SYMLINKTREE = 1;
54 53
55 54 use Fcntl qw(:flock);
@@ -114,28 +113,8 @@ sub sleep {
114 113 }
115 114
116 115 sub verbose {
117   - my($self,$level,@what) = @_;
118   - unless (@what) {
119   - @what = ("warning: verbose called without \@what: ", $level);
120   - $level = 1;
121   - }
122   - return if $level > $self->{VERBOSE};
123   - unless (exists $self->{INTRODUCED}) {
124   - my $now = scalar localtime;
125   - require Data::Dumper;
126   - unshift @what, "Running $0, $Id, $now",
127   - Data::Dumper->new([$self],[qw()])->Indent(1)->Useqq(1)->Dump;
128   - $self->{INTRODUCED} = undef;
129   - }
130   - push @what, "\n" unless $what[-1] =~ m{\n$};
131   - my $logfh;
132   - if (my $logfile = $self->{OPT}{logfile}) {
133   - open $logfh, ">>", $logfile or die;
134   - unshift @what, scalar localtime;
135   - } else {
136   - $logfh = *STDOUT;
137   - }
138   - print $logfh @what;
  116 + my ($self, $level, @what) = @_;
  117 + PAUSE->log($self, $level, @what);
139 118 }
140 119
141 120 sub reindex {
@@ -474,7 +453,7 @@ sub check_for_new {
474 453 content_type => 'text/plain',
475 454 encoding => 'quoted-printable',
476 455 },
477   - body_str => join(qq{\n\n}, "Not indexed.\n\n\t$Id", $alert),
  456 + body_str => join(qq{\n\n}, "Not indexed.\n\n\t$PAUSE::Id", $alert),
478 457 );
479 458
480 459 sendmail($email);
@@ -574,7 +553,7 @@ URL: http://www.perl.com/CPAN/modules/02packages.details.txt
574 553 Description: Package names found in directory \$CPAN/authors/id/
575 554 Columns: package name, version, path
576 555 Intended-For: Automated fetch routines, namespace documentation.
577   -Written-By: $Id
  556 +Written-By: $PAUSE::Id
578 557 Line-Count: $numlines
579 558 Last-Updated: $date\n\n};
580 559
@@ -1100,7 +1079,7 @@ Modcount: %d
1100 1079 Written-By: %s
1101 1080 Date: %s
1102 1081
1103   -}, 0+@$modlist_data, $Id, $date;
  1082 +}, 0+@$modlist_data, $PAUSE::Id, $date;
1104 1083
1105 1084 $list = qq!
1106 1085 package CPAN::Modulelist;
@@ -1211,7 +1190,7 @@ Line-Count: %d
1211 1190 Written-By: %s
1212 1191 Date: %s
1213 1192
1214   -}, scalar keys %seen, $Id, $date;
  1193 +}, scalar keys %seen, $PAUSE::Id, $date;
1215 1194
1216 1195 {
1217 1196 for my $k (sort keys %seen) {
14 lib/PAUSE/package.pm
@@ -52,19 +52,7 @@ package in packages package in primeur
52 52
53 53 sub verbose {
54 54 my($self,$level,@what) = @_;
55   - my $parent = $self->parent;
56   - if ($parent) {
57   - require Scalar::Util;
58   - if (Scalar::Util::blessed($parent)) {
59   - $parent->verbose($level,@what);
60   - } else {
61   - require Carp;
62   - Carp::cluck("Could not find a sane parent[$parent] to log level[$level]what[@what]");
63   - }
64   - } else {
65   - require Carp;
66   - Carp::cluck("Could not find a parent to log level[$level]what[@what]");
67   - }
  55 + PAUSE->log($self, $level, @what);
68 56 }
69 57
70 58 sub parent {
4 lib/PAUSE/pmfile.pm
@@ -3,6 +3,7 @@ use warnings;
3 3 package PAUSE::pmfile;
4 4 use vars qw($AUTOLOAD);
5 5 use version (); # to get $version::STRICT
  6 +use PAUSE ();
6 7
7 8 BEGIN { die "Version of version.pm too low ($version::VERSION), does not define STRICT"
8 9 unless defined $version::STRICT }
@@ -16,8 +17,7 @@ sub DESTROY {}
16 17
17 18 sub verbose {
18 19 my($self,$level,@what) = @_;
19   - my $main = $self->{DIO};
20   - $main->verbose($level,@what);
  20 + PAUSE->log($self, $level, @what);
21 21 }
22 22
23 23 # package PAUSE::pmfile;
1  t/data/pmfile/dist_mock.yaml
... ... @@ -1,4 +1,3 @@
1   -- [ 'verbose', 1, 'test message' ]
2 1 - [ 'alert', 'warning' ]
3 2 - [ 'connect' ]
4 3 - [ 'disconnect' ]
5 t/lib/Mock/Dist.pm
@@ -39,9 +39,4 @@ sub next_call_ok {
39 39 );
40 40 }
41 41
42   -sub verbose_ok {
43   - my ($self, $level, @what) = @_;
44   - $self->next_call_ok(verbose => [ $level, @what ]);
45   -}
46   -
47 42 1;
38 t/lib/PAUSE/Test/pmfile.pm
@@ -73,10 +73,13 @@ sub dist_mock :Test :Plan(1) {
73 73 }
74 74
75 75 my $ppp = 'My::Package';
76   -sub filter_ppps :Test :Plan(3) {
  76 +sub filter_ppps :Test :Plan(2) {
77 77 my ($self, $no_index, $expect) = @_;
78 78 $self->{pmfile}{META_CONTENT}{no_index} = $no_index;
79 79
  80 + my @verbose;
  81 + local $PAUSE::Config->{LOG_CALLBACK} = sub { shift; push @verbose, [@_] };
  82 +
80 83 my @res = $self->{pmfile}->filter_ppps($ppp);
81 84 cmp_deeply(
82 85 \@res,
@@ -90,38 +93,55 @@ sub filter_ppps :Test :Plan(3) {
90 93 ? "Skipping ppp[$ppp] $reason"
91 94 : "NOT skipping ppp[$ppp] $reason";
92 95 }
93   - $self->{dist}->next_call_ok(verbose => [ 1, $reason ]);
94   - $self->{dist}->next_call_ok(verbose => [ 1, "Result of filter_ppps: res[@res]" ]);
  96 +
  97 + cmp_deeply(
  98 + \@verbose,
  99 + [
  100 + [1, $reason],
  101 + [1, "Result of filter_ppps: res[@res]"],
  102 + ]
  103 + );
95 104 } else {
96   - ok( ! $self->{dist}->called('verbose'), "no verbose() call");
97   - ok(1, "dummy");
  105 + ok(!@verbose, "no verbose() call");
98 106 $self->{dist}->clear;
99 107 }
100 108 }
101 109
102 110 sub simile :Test :Plan(2) {
103 111 my ($self, $file, $package, $ret) = @_;
  112 +
  113 + my @verbose;
  114 + local $PAUSE::Config->{LOG_CALLBACK} = sub { shift; push @verbose, [@_] };
  115 +
104 116 my $label = "$file and $package are "
105 117 . ($ret ? "" : "not ") . "similes";
106 118 ok( $self->{pmfile}->simile($file, $package) == $ret, $label );
107 119 $file =~ s/\.pm$//;
108   - $self->{dist}->verbose_ok(
109   - 1, "Result of simile(): file[$file] package[$package] ret[$ret]\n"
  120 + cmp_deeply(
  121 + shift(@verbose),
  122 + [1, "Result of simile(): file[$file] package[$package] ret[$ret]\n"],
110 123 );
111 124 }
112 125
113 126 sub examine_fio :Test :Plan(3) {
114 127 my ($self) = @_;
115 128 my $pmfile = $self->{pmfile};
  129 +
  130 + my @verbose = ();
  131 + local $PAUSE::Config->{LOG_CALLBACK} = sub { shift; push @verbose, [@_] };
  132 +
116 133 $pmfile->{PMFILE} = $self->fake_dist_dir->file('lib/My/Dist.pm')->stringify;
117 134 $pmfile->examine_fio;
118   - $self->{dist}->next_call for 1..5; # skip over some irrelevant logging
  135 + shift @verbose for 1..3; # skip over some irrelevant logging
119 136 # $self->{dist}->next_call_ok(connect => []);
120 137 # $self->{dist}->next_call_ok(version_from_meta_ok => []);
121 138 # $self->{dist}->verbose_ok(1, "simile: file[Dist] package[My::Dist] ret[1]\n");
122 139 # $self->{dist}->verbose_ok(1, "no keyword 'no_index' or 'private' in META_CONTENT");
123 140 # $self->{dist}->verbose_ok(1, "res[My::Dist]");
124   - $self->{dist}->verbose_ok(1, "Will check keys_ppp[My::Dist]\n");
  141 + cmp_deeply(
  142 + shift(@verbose),
  143 + [1, "Will check keys_ppp[My::Dist]\n"],
  144 + );
125 145 cmp_deeply(
126 146 [ @{$PACKAGE}{ qw(PACKAGE DIST FIO TIME PMFILE USERID META_CONTENT) } ],
127 147 [

Tip: You can add notes to lines in a file. Hover to the left of a line to make a note

Something went wrong with that request. Please try again.