Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

use $Logger in cronjobs #494

Merged
merged 7 commits into from
May 5, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 2 additions & 9 deletions cron/cleanup-incoming.pl
Original file line number Diff line number Diff line change
Expand Up @@ -36,15 +36,8 @@
next if $sth->rows > 0;
}
my $size = -s $absdirent;
if (0 && $dirent =~ /^(\d+)\.(\d+)$/) { # these come often, but I could not decipher
open my $fh, $absdirent or die "Could not open $absdirent: $!";
local $/;
my $str = <$fh>;
substr($str,100*1024) = "" if length($str)> 100*1024;
require Data::Dumper;
warn sprintf "content[%s]\n", Data::Dumper::Dumper($str);
}

unlink $absdirent or die "Could not unlink $absdirent: $!";
warn "unlinked $absdirent ($size)\n";
$Logger->log("unlinked $absdirent ($size)");
}
closedir DIR;
10 changes: 7 additions & 3 deletions cron/cron-daily.pl
Original file line number Diff line number Diff line change
Expand Up @@ -80,7 +80,7 @@ sub read_errorlog {
close LOG;
report "\nErrorlog contains $errorlines lines today\n";
} else {
warn "error opening $PAUSE::Config->{HTTP_ERRORLOG}: $!";
$Logger->log("error opening $PAUSE::Config->{HTTP_ERRORLOG}: $!");
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

if this is an error, should it be fatal?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think the whole premise of this code is kinda wonky, so I'm gonna not touch it beyond changing its logging. "Send me the day's web error logs" is odd.

}
}

Expand Down Expand Up @@ -241,7 +241,8 @@ sub watch_files {
quoteHighBit => 1,
);
my $v = $d->stringify($File::Find::name);
warn sprintf qq{Found a bad directory v[%s], rmtree-ing}, $v;

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

unnecessary blank line?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Most blanks are, right? :)

Anyway, so much of the PAUSE code is without any vertical whitespace. Sometimes I add some to help break things up. This is maybe not the most obvious place to put it, but: I will continue to add vertical whitespace to create paragraphs of code.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I like vertical whitespace, this just felt like a weird place to put it.

$Logger->log([ qq{Found a bad directory v[%s], rmtree-ing}, $v ]);
require File::Path;
File::Path::rmtree($File::Find::name);
}
Expand Down Expand Up @@ -649,7 +650,10 @@ sub mailrc {
require Text::Unidecode;
$r[1] = Text::Unidecode::unidecode($r[1]);
};
warn $@ if $@;

if ($@) {
$Logger->log([ "error unidecoding: %s", "$@" ]);
}
}
$r[1] =~ s/["<>]//g;
push @list, sprintf qq{alias %-10s "%s <%s>"\n}, @r[ 0 .. 2 ];
Expand Down
80 changes: 39 additions & 41 deletions cron/gmls-lR.pl
Original file line number Diff line number Diff line change
Expand Up @@ -27,51 +27,49 @@
facility => 'daemon',
} };

chdir $PAUSE::Config->{FTPPUB} or die "Could not chdir to $PAUSE::Config->{FTPPUB}: $!";
chdir $PAUSE::Config->{FTPPUB}
or die "Could not chdir to $PAUSE::Config->{FTPPUB}: $!";

mkdir "indexes", 0755 unless -d "indexes";

for my $dir (qw(authors modules)) {
chdir $dir or die;

# system qq(ls -lgR > ../indexes/.$dir.ls-lR);

# find goes depth first algorithm, we need breadth first
use File::Find;
local *FH;
open FH, ">../indexes/.$dir.ls-lR" or die;
my %seen;
find(sub {
return if $seen{$File::Find::dir}++;
my $ffdir = $File::Find::dir;
$ffdir =~ s|^./?||;
print FH "\n\n$ffdir\:\n" if $ffdir;
print FH "total 123456789\n";
local *DIR;
opendir DIR, "." or die "Couldn't open . [=$ffdir]: $!";
my @dir = sort readdir DIR;
closedir DIR;
for my $dirent (@dir) {
next if substr($dirent,0,1) eq ".";
print FH gmls($dirent);
}
print FH "\n\n";
}, "." );
return if $seen{$File::Find::dir}++;
my $ffdir = $File::Find::dir;
$ffdir =~ s|^./?||;
print FH "\n\n$ffdir\:\n" if $ffdir;
print FH "total 123456789\n";
local *DIR;
opendir DIR, "." or die "Couldn't open . [=$ffdir]: $!";
my @dir = sort readdir DIR;
closedir DIR;
for my $dirent (@dir) {
next if substr($dirent,0,1) eq ".";
print FH gmls($dirent);
}
print FH "\n\n";
}, "." );

close FH;
chdir "../indexes";
# system(qq(gzip -c9 < .$dir.ls-lR > .$dir.ls-lR.gz))==0 or
# rename ".$dir.ls-lR.gz", ".$dir.ls-lR.gz.error";

if (
-f ".$dir.ls-lR"
&&
(
! -f "$dir.ls-lR"
or
compare("$dir.ls-lR", ".$dir.ls-lR")
)
&&
system(qq(gzip -c9 < .$dir.ls-lR > .$dir.ls-lR.gz))==0
-f ".$dir.ls-lR"
&&
(
! -f "$dir.ls-lR"
or
compare("$dir.ls-lR", ".$dir.ls-lR")
)
&&
system(qq(gzip -c9 < .$dir.ls-lR > .$dir.ls-lR.gz))==0
) {
rename ".$dir.ls-lR", "$dir.ls-lR";
rename ".$dir.ls-lR.gz", "$dir.ls-lR.gz";
Expand All @@ -88,9 +86,9 @@ sub gmls {
my $pname = $name;

if ($blocks) {
$blocks = int(($blocks + 1) / 2);
$blocks = int(($blocks + 1) / 2);
} else {
$blocks = int(($sizemm + 1023) / 1024);
$blocks = int(($sizemm + 1023) / 1024);
}

if (-f _) { $perms = '-'; }
Expand Down Expand Up @@ -120,20 +118,20 @@ sub gmls {
my($timeyear);
my($moname) = $moname[$mon];
if (-M _ > 365.25 / 2) {
$timeyear = $year + 1900;
$timeyear = $year + 1900;
}
else {
$timeyear = sprintf("%02d:%02d", $hour, $min);
$timeyear = sprintf("%02d:%02d", $hour, $min);
}

sprintf "%-10s %2d %-3s %8s %s %2d %5s %s\n",
$perms,
$nlink,
$user,
$sizemm,
$moname,
$mday,
$timeyear,
$pname;
$perms,
$nlink,
$user,
$sizemm,
$moname,
$mday,
$timeyear,
$pname;
}

69 changes: 35 additions & 34 deletions cron/rm_stale_links
Original file line number Diff line number Diff line change
Expand Up @@ -41,39 +41,40 @@ my %KEEP_FOREVER = (
);

find(
{
bydepth => 1,
wanted => sub {
return if /^\.\.?$/;
return if $KEEP_FOREVER{ $File::Find::name };
my($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_);
if (-l $_ && ! -e $_){
warn "unlinking stale $File::Find::name\n";
unlink $_;
# PAUSE::delfile_hook(File::Spec->rel2abs($_)); # do we track symlinks?
{
bydepth => 1,
wanted => sub {
return if /^\.\.?$/;
return if $KEEP_FOREVER{ $File::Find::name };
my($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_);
if (-l $_ && ! -e $_){
$Logger->log("unlinking stale $File::Find::name");
unlink $_;
# PAUSE::delfile_hook(File::Spec->rel2abs($_)); # do we track symlinks?
}
if ($_ eq "CHECKSUMS") {
opendir DIR, ".";
my @readdir = readdir DIR;
closedir DIR;
if (@readdir == 3) {
$Logger->log("unlinking orphaned $File::Find::name");
unlink $_ or die "Could not unlink $_: $!";
PAUSE::delfile_hook(File::Spec->rel2abs($_)); # definitely needed
}
if ($_ eq "CHECKSUMS") {
opendir DIR, ".";
my @readdir = readdir DIR;
closedir DIR;
if (@readdir == 3) {
warn "unlinking orphaned $File::Find::name\n";
unlink $_ or die "Could not unlink $_: $!";
PAUSE::delfile_hook(File::Spec->rel2abs($_)); # definitely needed
}
}
return if -l $_;
($dev,$ino,$mode,$nlink,$uid,$gid) = stat($_);
if (-d _ and $nlink == 2) { # directory without subdir
opendir DIR, $_;
my @readdir = readdir DIR;
closedir DIR;
if (@readdir == 2) {
$Logger->log("rmdirring empty $File::Find::name");
rmdir $_ or die "Could not rmdir $_: $!";
# PAUSE::delfile_hook(File::Spec->rel2abs($_)); # we do not track directories
}
return if -l $_;
($dev,$ino,$mode,$nlink,$uid,$gid) = stat($_);
if (-d _ and $nlink == 2) { # directory without subdir
opendir DIR, $_;
my @readdir = readdir DIR;
closedir DIR;
if (@readdir == 2) {
warn "rmdirring empty $File::Find::name\n";
rmdir $_ or die "Could not rmdir $_: $!";
# PAUSE::delfile_hook(File::Spec->rel2abs($_)); # we do not track directories
}
}
},
},
"authors", "modules");
}
},
},
"authors", "modules"
);
15 changes: 12 additions & 3 deletions cron/update-checksums.pl
Original file line number Diff line number Diff line change
Expand Up @@ -88,8 +88,10 @@ =head1 DESCRIPTION

$Opt{debug} ||= 0;
if ($Opt{debug}) {
warn "Debugging on. CPAN::Checksums::VERSION[$CPAN::Checksums::VERSION]";
$Logger->set_debug(1);
$Logger->log("Debugging on. CPAN::Checksums::VERSION[$CPAN::Checksums::VERSION]");
}

my $root = $PAUSE::Config->{MLROOT};
$Opt{startdir} //= $root;
our $TESTDIR;
Expand Down Expand Up @@ -159,7 +161,7 @@ =head1 DESCRIPTION
}
my $ret = eval { CPAN::Checksums::updatedir($ffname, $root); };
if ($@) {
warn "error[$@] in checksums file[$ffname]: must unlink";
$Logger->log("error[$@] in checksums file[$ffname]: must unlink");
unlink "$ffname/CHECKSUMS";
}
if ($Opt{debug}) {
Expand All @@ -175,7 +177,14 @@ =head1 DESCRIPTION
) or die $!;
$yaml->{stop} = time;
my $tooktime = sprintf "%.6f", $yaml->{stop} - $yaml->{start};
warn "debugdir[$debugdir]ret[$ret]tooktime[$tooktime]cnt[$cnt]\n";

$Logger->log_event('checksum-debugging-file' => [
debugdir => $debugdir,
ret => $ret,
tooktime => $tooktime,
cnt => $cnt,
]);

$yaml->{tooktime} = $tooktime;
YAML::Syck::DumpFile(File::Spec->catfile($debugdir,
"YAML"), $yaml);
Expand Down
Loading