Here is a draft docheckgroups perl rewrite. The plan for the final version is to have a program which could automatically update active and newsgroups. Is switching the default behaviour of the program from "print a list of things to do" to "do everything is needed" acceptable? I am really tired of updating the newsgroups file by hand. :-) Does anybody have feature requests? -- ciao, Marco -- Attached file included as plaintext by Listar -- #!/usr/bin/perl -w require "/usr/local/news/lib/innshellvars.pl"; #require "/news/lib/innshellvars.pl"; $inn::active = "t/active"; $inn::newsgroups = "t/newsgroups"; use strict; # egrep re built from control.ctl data matching the (sub)hierarchies which # the checkgroups is allowed to act on my $hier; if ($ARGV[0]) { $hier = re2pcre($ARGV[0]); } else { $hier = '.'; } my (%hierarchies, %groups, @unparseable); parsegroups(\*STDIN, $hier, \%groups, \%hierarchies, \@unparseable); if (-s $inn::localgroups) { open(LOCAL, $inn::localgroups) or die "Cannot read $inn::localgroups: $!"; parsegroups(\*LOCAL, $hier, \%groups, \%hierarchies, \@unparseable); close LOCAL; } ############################################################################## my (@add, @addm, @remove, @mod, @unmod, @dadd, @dremove, @dchange); my $act_on = '^(?:' . join('|', keys %hierarchies) . ')[\.\s]'; check_active($act_on, \%groups, \@add, \@addm, \@remove, \@mod, \@unmod); check_newsgroups($act_on, \%groups, \@dadd, \@dremove, \@dchange); ############################################################################## my $output = print_report_classic1(\@add, \@addm, \@remove, \@mod, \@unmod); print $$output; $output = print_report_classic2(\@dadd, \@dremove, \@dchange); print $$output; #do_newsgroups_changes(\@dadd, \@dremove, \@dchange); exit 0; print "ADD: $_\n" foreach @add; print "REM: $_\n" foreach @remove; print "MOD: $_\n" foreach @mod; print "DADD: $_\n" foreach @dadd; print "DREM: $_\n" foreach @dremove; print "DCHG: $_\n" foreach @dchange; exit 0; ############################################################################## # functions to parse everything ############################################################################## sub check_active { my ($act_on, $groups, $add, $addm, $remove, $mod, $unmod) = @_; my %active; open(ACTIVE, $inn::active) or die "Cannot read $inn::active: $!"; while () { chop; my ($name, $mode) = /(\S+)\s\d+\s\d+\s([ynmx])/; next if not $mode; next if not /$act_on/; $active{$name} = $mode; } close ACTIVE; my %tempgroups = %$groups; foreach (keys %active) { if (not exists $tempgroups{$_}) { push @$remove, $_; delete $tempgroups{$_}; } } foreach (keys %tempgroups) { if (not exists $active{$_}) { if ($tempgroups{$_} =~ /\(Moderated\)$/) { push @$addm, $_; } else { push @$add, $_; } } else { if ($tempgroups{$_} =~ /\(Moderated\)$/) { push @$mod, $_ if $active{$_} eq 'y'; } else { push @$unmod, $_ if $active{$_} eq 'm'; } } } } sub check_newsgroups { my ($act_on, $groups, $dadd, $dremove, $dchange) = @_; my %tempgroups = %$groups; open(NEWSGROUPS, $inn::newsgroups) or die "Cannot read $inn::newsgroups: $!"; while () { my ($name, $text) = /(\S+)\s+(.*)/; next if not /$act_on/; if (not exists $tempgroups{$name}) { push @$dremove, "$name\t$text"; delete $tempgroups{$name}; } elsif (exists $tempgroups{$name}) { push @$dchange, "$name\t$tempgroups{$name}" if $tempgroups{$name} ne $text; delete $tempgroups{$name}; } } close NEWSGROUPS; push @dadd, "$_\t$tempgroups{$_}" foreach keys %tempgroups; } sub parsegroups { my ($file, $allowed, $groups, $hierarchies, $unparseable) = @_; while () { my $ok = 0; s/\s+$//; s/^!//; next if /^$/; last if /^-- $/; next if not /$allowed/; if (/^(\S+)\s+(.+)$/) { $groups->{$1} = $2; $ok = 1; } if (/^([^\.\s]+)/) { $hierarchies->{$1} = 1; $ok = 1; } push @$unparseable, $_ if not $ok; } } # convert a egrep-like re in a perl re # XXX what is missing? sub re2pcre { local $_ = shift; # s/\|/|^/g; s/\./\\./g; s/\?/./g; s/\*/.*/g; s/\\\.\.\*($|\|)/$1/g; $_; } ############################################################################## # print reports ############################################################################## sub print_report_classic1 { my ($add, $addm, $remove, $mod, $unmod) = @_; my $out = ''; $out .= "\t$inn::pathbin/ctlinnd throttle docheckgroups\n" if @$remove or @$add or @addm; if (@$remove) { $out .= "# The following newsgroups are non-standard.\n"; $out .= "#\t$_\n" foreach @$remove; $out .= "# You can remove them by executing the commands:\n"; $out .= "\t$inn::pathbin/ctlinnd rmgroup $_\n" foreach @$remove; $out .= "\n"; } if (@$add || @addm) { $out .= "# The following newsgroups were missing and should be added.\n"; $out .= "#\t$_\n" foreach (@$add, @$addm); $out .= "# You can do this by executing the command(s):\n"; $out .= "\t$inn::pathbin/ctlinnd newgroup $_ y\n" foreach @$add; $out .= "\t$inn::pathbin/ctlinnd newgroup $_ m\n" foreach @$addm; $out .= "\n"; } $out .= "\t$inn::pathbin/ctlinnd go docheckgroups\n" if @$remove or @$add or @addm; if (@$unmod) { $out .= "# The following groups are incorrectly marked as moderated:\n"; $out .= "#\t$_\n" foreach @$unmod; $out .= "# You can correct this by executing the following:\n"; $out .= "\t$inn::pathbin/ctlinnd changegroup $_ y\n" foreach @$unmod; $out .= "\n"; } if (@$mod) { $out .= "# The following groups are incorrectly marked as unmoderated:\n"; $out .= "#\t$_\n" foreach @$mod; $out .= "# You can correct this by executing the following:\n"; $out .= "\t$inn::pathbin/ctlinnd changegroup $_ m\n" foreach @$mod; $out .= "\n"; } } sub print_report_classic2 { my ($dadd, $dremove, $dchange) = @_; my $out = ''; return \$out if not (@$dadd or @$dremove or @$dchange); $out .= "exit # so you can feed this message into the shell\n"; $out .= "# And remember to update $inn::newsgroups.\n"; if (@$dremove) { $out .= "# Remove these lines:\n"; $out .= "#\t$_\n" foreach @$dremove; $out .= "\n"; } if (@$dadd) { $out .= "# Add these lines:\n"; $out .= "#\t$_\n" foreach @$dadd; $out .= "\n"; } if (@$dchange) { $out .= "# Change these lines:\n"; $out .= "#\t$_\n" foreach @$dchange; } return \$out; } sub do_newsgroups_changes { my ($dadd, $dremove, $dchange) = @_; my %remove; return if not (@$dremove or @$dchange or @$dadd); foreach (@$dremove, @$dchange) { my ($group, $desc) = split /\s+/; $remove{$group} = 1; } # shlock("$inn::locks/LOCK.newsgroups"); my $tempfile = "$inn::tmpdir/docheckgroups.$$"; open(TEMPFILE, ">$tempfile") or die "Cannot open $tempfile: $!"; open(NEWSGROUPS, $inn::newsgroups) or die "Cannot open $inn::newsgroups: $!"; while () { my ($group, $desc) = split /\s+/; print TEMPFILE "$_" unless exists $remove{$group}; } close NEWSGROUPS; print TEMPFILE "$_\n" foreach (@$dadd, @$dchange); close TEMPFILE; rename($tempfile, $inn::newsgroups) or die "Cannot rename $tempfile: $!"; # unlink("$inn::locks/LOCK.newsgroups", $tempfile); } print $inn::tmpdir if 0;