From: Jacob Bachmeyer Date: Sun, 16 Oct 2022 00:39:40 +0000 (-0500) Subject: Refactor scan_incoming as helper for gather_packets X-Git-Url: https://vcs.fsf.org/?a=commitdiff_plain;h=add3f3399509cea26784ac66fc41edceef97f789;p=gatekeeper.git Refactor scan_incoming as helper for gather_packets The old scan_incoming function was very long and performed two related but distinct tasks: collecting a list of files eligible for processing and collecting those files into packets. The new scan_incoming now only produces a list of files; the second loop to collect files into packets has been moved to a new gather_packets function. --- diff --git a/gatekeeper.pl b/gatekeeper.pl index a268629..41779d1 100755 --- a/gatekeeper.pl +++ b/gatekeeper.pl @@ -855,20 +855,16 @@ sub read_directive_from_file { # ftp.gnu.org does not allow overwrites or deletes. # -=item @packets = scan_incoming ( $directory, $scratchpad ) +=item @files = scan_incoming ( $directory ) -Scan DIRECTORY for newly-arrived upload packets. Remove blatantly bogus -files, ignore partial packets and acceptable files that are either still -open or recently modified, and return a list of arrayrefs representing -complete packets found. The files mentioned in the returned arrayrefs have -been moved to the SCRATCHPAD directory. Each returned packet begins with -the directive file, but order is not otherwise specified. +Scan DIRECTORY for newly-arrived uploaded files. Remove blatantly bogus +files, ignore acceptable files that are either still open or recently +modified, and return a list of filenames for further processing. =cut sub scan_incoming { my $directory = shift; - my $scratchpad = shift; local *_; @@ -972,12 +968,33 @@ sub scan_incoming { } close (LSOF); + return keys %possible; +} + +=item @packets = gather_packets ( $directory, $scratchpad ) + +Scan DIRECTORY for newly-arrived upload packets. Remove blatantly bogus +files, ignore partial packets and acceptable files that are either still +open or recently modified, and return a list of arrayrefs representing +complete packets found. The files mentioned in the returned arrayrefs have +been moved to the SCRATCHPAD directory. Each returned packet begins with +the directive file, but order is not otherwise specified. + +=cut + +sub gather_packets { + my $directory = shift; + my $scratchpad = shift; + + my @files = scan_incoming($directory); + my %havefile = map { $_ => 1 } @files; + # Find the directives among the possibilities and assemble packets my @ret; my @stems = map m/^(.*)[.]directive[.]asc$/, - grep m/[.]directive[.]asc$/, keys %possible; + grep m/[.]directive[.]asc$/, @files; STEM: foreach my $stem (@stems) { # This trades generality for efficiency. In the general case, the STEM @@ -991,12 +1008,12 @@ sub scan_incoming { ftp_syslog('debug', "DEBUG: " ."considering stem [$stem] for processing") if DEBUG; - # Note that all values in %possible are 1 and the undefined value is + # Note that all values in %havefile are 1 and the undefined value is # falsish in Perl, so simple checks are adequate here. No tests for # the directive file itself are done because each STEM is derived from # its presence. - if ($possible{$stem} && $possible{$stem.'.sig'}) { + if ($havefile{$stem} && $havefile{$stem.'.sig'}) { # File upload triplet: STEM.directive.asc, STEM.sig, STEM my $triplet = [$stem.'.directive.asc', $stem.'.sig', $stem]; @@ -1021,11 +1038,11 @@ sub scan_incoming { } else { # A lone directive file: STEM.directive.asc - # Here we have a potential problem. It's possible that we are seeing - # a directive file that belongs to a triplet the rest of which has - # not been uploaded yet. If so, we should ignore this file and not - # move it to $scratchpad. This means we need to read the file and see - # if there is a 'filename:' directive. + # Here we have a potential problem. We could be seeing a directive + # file that belongs to a triplet the rest of which has not been + # uploaded yet. If so, we should ignore this file and not move it to + # $scratchpad. This means we need to read the file and see if there + # is a 'filename:' directive. my $racecondition = 0; my $directive = read_directive_from_file @@ -1875,7 +1892,7 @@ sub cleanup { # have any directory. chdir ($incoming_dir) or ftp_die("FATAL: chdir($incoming_dir) failed: $!"); -my @incoming = scan_incoming ($incoming_dir, $incoming_tmp); +my @incoming = gather_packets($incoming_dir, $incoming_tmp); # Temporary scaffolding to convert the new values returned by scan_incoming # to the old format.