{{anchor href="top"}}
Hits : **{{hits}}**
== Perl Tips ==
{{ToC from="h2" to="h3"}}
=== Search & Replace and Write ===
%%(perl)
perl -p -i -e 's/Nov/Dec/g' file
%%
%%(bash)
sed -i 's/blue/red/g' file
%%
=== Delete line from a file matching regular expression ===
%%(perl)
perl -i -ne 'print unless /SOMETHING/' file
%%
Split an mbox into numbered individual message files
( from http://www.perlmonks.org/?node_id=152279 )
%%(perl)
perl -ne 'if(/^From /){open F,">msg".++$m}print F' mbox
%%
=== Convert a mbox to maildir ===
http://batleth.sapienti-sat.org/projects/mb2md/mb2md-3.20.pl.gz
=== find_badblocks ===
http://www.orcaware.com/svn/repos/find_badblocks/trunk/find_badblocks.pl
((#top))
-----------
=== How to remove a specific mail from a mbox ===
%%(perl)
#!/usr/bin/perl -w
use strict;
use Mail::MboxParser;
die $0 =~ /([^\/]+)$/, " <mbox> \n" unless @ARGV == 1;
my $mb = Mail::MboxParser->new( $ARGV[0], decode => 'HEADER' );
my @subjects = (
"automatically rejected mail",
"delivery delayed",
"delivery failure",
"delivery notification: delivery has failed",
"delivery status notification",
"delivery status notification (failure)",
"etl application error",
"failure notice",
"mail delivery failed",
"mail delivery failure notification",
"mail system error",
"motion detected",
"motion-trigger",
"nondeliverable",
"rejected: ",
"returned mail",
"returned mail: see transcript for details",
"undeliverable",
"undelivered",
"undelivered mail returned to sender",
"warning: could not send message for past"
);
while ( my $msg = $mb->next_message ) {
my $s = lc( $msg->header->{subject} );
$s ||= "empty_subject";
my $flag = 0 ;
foreach (@subjects) {
if ( $s =~ $_ ) {
$flag = 1;
last;
}
}
print $msg."\n" unless $flag;
}
%%
((#top))
-----------
=== Remove duplicate mails from mailbox ===
%%(perl)
#!/usr/bin/perl -w
use strict;
use Mail::MboxParser;
die $0 =~ /([^\/]+)$/, " <mbox> > <newmbox> \n" unless @ARGV == 1;
my $mb = Mail::MboxParser->new($ARGV[0]);
my $field = "message-id";
my @MessageIds = ();
while ( my $msg = $mb->next_message ) {
my $msgid = $msg->header->{$field};
if ( grep(/$msgid/, @MessageIds ) ) {
warn "Duplicate Message-ID: " . $msgid . ", already exists ! \n" ;
} else {
push( @MessageIds, $msgid );
print $msg."\n" ;
}
}
%%
((#top))
-----------
=== DSL PERL GENERATOR ===
%%
#!/usr/bin/perl -w
my $class_a = "2";
foreach ( 84 .. 85) {
my $cl_b = $_;
foreach ( 0 .. 255 ) {
my $cl_c = $_;
foreach ( 0 .. 255 ) {
print "$class_a.$cl_b.$cl_c.$_\n";
}
}
}
%%
((#top))
-----------
=== Decode any subject encoding to utf8 with perl ===
%%(perl)
#!/usr/bin/env perl
die $0 =~ /([^\/]+)$/, " <mail_subject> \n" unless @ARGV == 1;
use Encode;
use MIME::Base64 qw(decode_base64);
my @values = split ( '\?', $ARGV[0] );
binmode STDOUT, ":utf8";
print decode ( $values[1] , decode_base64( $values[3] ) . "\n" );
%%
((#top))
-----------
%%
#!/bin/sh
/usr/bin/perl -w \
-M'Encode' \
-M'Mail::MboxParser' \
-M'MIME::Base64 qw(decode_base64)' \
-e 'BEGIN {
$mb = Mail::MboxParser->new( $ARGV[0] );
}' \
-ne ' my $s = $mb->next_message->header->{subject} || "( empty subject )" ;
if ( $s =~ /^\=\?/ ) {
my @values = split ("\?", $s ) ;
$s = decode ( $values[1] , decode_base64( $values[3] ) ) ;
}
binmode STDOUT, ":utf8";
print $s . "\n" ;
' mbox
%%