Prev: Using Substr and Regular expressions.
Next: Help with search and replace
From: Anonymous via Panta Rhei on 23 Feb 2007 10:25
#!/usr/bin/perl
require 5;
$VERSION = '1.0';
use File::Slurp;
use warnings;
use Getopt::Std;
use List::Util ('shuffle');
use News::Article;
use strict 'refs';

my(%option, $inputFilename, $outputFilename, @addBody, $code);
my $ctr = 0;
my(@dropGroups) = ();
my(@followups) = ();

# generate messages to enforce Godwin's law
# example:
# $ grep -r -l -i '\(nazi\|hitler\)' /var/spool/news/alt/what/ever |xargs godwin

# By default this script adds Followup-To: alt.dev.null,
# X-No-Archive: Yes, and a X-Code header to keep it from replying
# to its own messages.

# This script just generates messages, it's up to you how you get
# them onto usenet. Warning, if you post a lot of these so you
# can be traced, you'll probably get TOSsed!

# -G alt.foo,alt.bar
# drop some Newsgroups
# -N
# do not FU alt.dev.null
# -a
# do not set X-No-Archive: Yes
# -b FILE
# use text from FILE instead of default data
# -c
# suppress X-Code: random header
# -d DIRECTORY
# put output file here instead of pwd
# -f 'Some Name foo(a)bar'
# use this From header instead of the default
# -u alt.foo,alt.bar
# add FUs
# -L FILE
# ignore files not newer than FILE

# This script is hereby donated to the PUBLIC DOMAIN.

getopts 'd:af:b:u:G:NcL:', \%option;

my $maxAge = $option{L} ? (-M $option{L}) : 0;
my $outputDirectory = $option{'d'} || '.';
my $from = $option{'f'} || 'Godwin <godwin@...>';

if ($option{'G'}) {
@dropGroups = split(/,/, $option{'G'}, 0);
}

push @followups, 'alt.dev.null' unless $option{'N'};
push @followups, split(/,/, $option{'u'}, 0) if $option{'u'};

if ($option{'b'}) {
@addBody = read_file($option{'b'});
}
else {
@addBody = <DATA>;
}

foreach $inputFilename (@ARGV) {
if (($option{L}) && (-M $inputFilename >= $maxAge)) {
print "$inputFilename ignored (too old)\n";
}
else {
my $input = 'News::Article'->new($inputFilename);
if ($input->header('X-Code')) {
print "$inputFilename ignored (X-Code)\n";
}
else {
my $output = 'News::Article'->new;
$output->set_headers('Subject', reSubject($input),
'From', $from,
'References', reRefs($input));
$output->set_headers('X-No-Archive', 'Yes') unless $option{'a'};
unless ($option{'c'}) {
$code = `mcookie`;
chomp $code;
$output->set_headers('X-Code', $code);
}
$output->set_body(reBody($input));
my(@groupings) = reGroup($input);
my $groups;
while (@groupings) {
$outputFilename = getFilename($outputDirectory, $inputFilename);
$groups = shift @groupings;
$output->set_headers('Newsgroups', $groups);
$output->set_headers('Followup-To', fu($groups)) if @followups > 0;
open OUTFILE, ">$outputFilename";
$output->write(\*OUTFILE);
close OUTFILE;
print "$inputFilename --> $outputFilename\n";
}
}
}
}

sub reSubject {
my $subject = $_[0]->header('Subject');
$subject = 'Re: ' . $subject unless $subject =~ /\s*(\[.*\])?\s*Re:/i;
return $subject;
}

sub reRefs {
my(@refs) = $_[0]->header('Message-ID');
my(@oldRefs) = split(/\s+/, $_[0]->header('References') || '', 0);
unshift @refs, pop @oldRefs if @oldRefs;
unshift @refs, shift @oldRefs if @oldRefs;
return join(' ', @refs);
}

sub getFilename {
my $orig = $_[1];
$orig =~ s[^.*/][];
my $fn;
do {
$fn = $_[0] . '/' . $orig . '-' . $$ . $ctr++ . '.output'
} while -f $fn;
return $fn;
}

sub reGroup {
my(@groups) = shuffle(split(/,/, $_[0]->header('Newsgroups'), 0));
if ($option{'G'}) {
@groups = dropGroups(@groups);
}
my(@output) = ();
while (@groups > 3) {
push @output, join(',', @groups[0, 1, 2]);
shift @groups;
shift @groups;
shift @groups;
}
push @output, join(',', @groups);
return @output;
}

sub dropGroups {
my(%groups) = map({$_, 1;} @_);
foreach my $item (@dropGroups) {
delete $groups{$item};
}
return keys %groups;
}

sub fu {
my(@groups) = split(/,/, $_[0], 0);
unshift @groups, @followups;
if (@groups > 3) {
@groups = @groups[0, 1, 2];
}
return join(',', shuffle(@groups));
}

sub reBody {
my(@old) = $_[0]->body;
my(@new) = map({"> $_";} grep({$_ =~ /nazi|hitler/i;} @old));
push @new, '', @addBody;
return @new;
}

__DATA__
This thread is terminated by Godwin's Law.

Further posts are prohibited.

Thank you for co-operating.
~~~~~~~~~~~~~~~~~~~~~
This message was posted via one or more anonymous remailing services.
The original sender is unknown. Any address shown in the From header
is unverified. You need a valid hashcash token to post to groups other
than alt.test and alt.anonymous.messages. Visit www.panta-rhei.eu.org
for abuse and hashcash info.



From: john.swilting on 24 Feb 2007 06:40
Anonymous via Panta Rhei wrote:

> sub getFilename {
> my $orig = $_[1];
> $orig =~ s[^.*/][];
> my $fn;
> do {
> $fn = $_[0] . '/' . $orig . '-' . $$ . $ctr++ . '.output'
> } while -f $fn;
> return $fn;
> }
not understoud
$orig = s[^.*/][]
it is an infinite loop
From: john.swilting on 24 Feb 2007 06:50
john.swilting wrote:

> Anonymous via Panta Rhei wrote:
>
>> sub getFilename {
>> my $orig = $_[1];
>> $orig =~ s[^.*/][];
>> my $fn;
>> do {
>> $fn = $_[0] . '/' . $orig . '-' . $$ . $ctr++ . '.output'
>> } while -f $fn;
>> return $fn;
>> }
> not understoud
> $orig = s[^.*/][]
> it is an infinite loop
perl -e {{}};
From: Michele Dondi on 24 Feb 2007 09:19
On Sat, 24 Feb 2007 12:40:37 +0100, "john.swilting"
<john.swilting(a)wanadoo.fr> wrote:

>> $orig =~ s[^.*/][];
[snip]
>not understoud
>$orig = s[^.*/][]

Please do not retype, just copy and paste instead. If you retype, try
to do so accurately

$orig =~ s[^.*/][]; # and
$orig = s[^.*/][] # are VERY different!

>it is an infinite loop

No, it's not. Not infinite, let alone a loop.


Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
..'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
 | 
Pages: 1
Prev: Using Substr and Regular expressions.
Next: Help with search and replace