Hits : 9852

Perl Tips


Contents

Search & Replace and Write 


perl -p -i -e 's/Nov/Dec/g' file

sed -i 's/blue/red/g' file

Delete line from a file matching regular expression 


perl -i -ne 'print unless /SOMETHING/' file

Split an mbox into numbered individual message files
( from http://www.perlmonks.org/?node_id=152279 ) 


perl -ne 'if(/°From /){open F,">msg".++$m}print F' mbox

Convert a mbox to maildir


filehttp://batleth.sapienti-sat.or[..]2md/mb2md-3.20.pl.gz

find_badblocks


http://www.orcaware.com/svn/re[..]nk/find_badblocks.pl


top

How to remove a specific mail from a mbox 


#!/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 


#!/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 


#!/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