jolttz's blog #!/usr/bin/perl

18Mar/102

Annoyed of spam?

Most of us have complained about the spam landing on our inboxes. Spam is a huge problem for mailservers and actually for all of us but now let's have look back.
Have you ever set your e-mail visible on some forums or website you are registering to (in some cases it's even a default option)? Have you ever thought about unchecking the box that says, "Subscribe for weekly newsletter etc."? Have you ever posted your or your friends e-mail address on some forums, portal or even your own website?

These acts may sound very innocent but can actually be the main reason you get spam e-mails. There are 24/7 spiders/crawlers running around the web, searching for e-mails in the form of "you@mail.com" or more advanced crawlers even disguised e-mails like you[at]mail.com etc.
To pervent the crawlers adding your email to the "spam list" is to disguise it so it's easily understandable for human brain but can't be picked up by the crawlers. For example: you{at}mail{dot}com. Second solution would be adding an e-mail form so your e-mail won't be shown but people can still mail you. Also, if you have a company, stop having easily guessable e-mails like "info@yourcompany.com", instead use "information@yourcompany.com" or "cust-support@yourcompany.com" etc.

I wanted to know how easily the e-mails could be gathered so I wrote a small web crawler in Perl. It starts from some random page, gets all the e-mails on it and all the links refering to other pages/sites. Then it adds them to a MySQL database. After that it visits the links that are on the database next and does it all over again. It also filters the links that surely have no e-mails inside, like binary files (png, jpg, gif, exe, pdf etc.) and also pervents websites like google and yahoo that probably have no legit e-mails either. I ran it all night (about 10 hours). It went through 150000 websites and got over 5000 e-mails and I didn't even have to do anything. It's still far from advanced web crawlers but 5000+ e-mails shows how powerful it can be.

I'm not going to post the source here for your own good but if you e-mail me a really good reason, why I should give it to you, I might consider it :) .
If you knew all this, sorry for wasting your time but I hope I got someone thinking with this post.
tl;dr - gtfo.

12Feb/102

Convert all AVI’s from a directory to MP4 using ffmpeg and Perl

I recently bought a new iPod (nano 5G) and I couldn't find a script that converts multiple AVI's from a directory to MP4 quickly so I wrote one myself. It uses ffmpeg to convert so you need to have it installed. 170MB AVI should be like 80MB as MP4.

#!/usr/bin/perl
#           avi2mp4.pl
#  Sun Feb 12 22:41:46 2010
#  Copyright  2010  jolttz
#  jolttz{ät}gmail{dot}com
#
use strict;

my $dirname = $ARGV[$0];
my ($width, $height, $size);
my $bitrate = 409600;

opendir(DIR, $dirname) or die "Can't open directory $dirname: $!";
while (defined(my $file = readdir(DIR))) {
	if ($file =~ m/(.+)\.avi/i) {

		# Get the aspect ratio
		open(P, "ffmpeg -i '$dirname/$file' 2>&1 |") or die "$!\n";
		while(

) {
		    if (/Video:.+ (\d+)x(\d+)/) {
		        $width = $1;
		        $height = $2;
		    }
		}
		close(P);
		die "Failed finding the aspect ratio.\n" unless defined $width;

		my $aspect = $width/$height;
		if (abs($aspect - 16/9) < 0.02) {
		    $size = "320x180";
		} elsif (abs($aspect - 4/3) < 0.02) {
		    $size = "320x240";
		} else {
		    die "Weird aspect ratio: ${width}x${height} = $aspect\n";
		}
		print $size;
    	print "Converting '$dirname/$file'...\n";
		exec("ffmpeg", "-i", $dirname. "/" .$file, "-b", $bitrate, "-s", $size, "-vcodec", "mpeg4", "-ab", 128, "-acodec", "libfaac", "-r", 25, $dirname. "/" .$1. ".mp4");
	}
}
closedir(DIR);

Syntax:

b22stard@b22s-desktop ~ $ perl avi2mp4.pl /dir/to/the/avis/

Enjoy ;)

28Jan/100

Highlight logger for xChat in Perl

I haven't posted anything new for some time because I'm writing an IRC bot and I don't know when I'm going to release it. So I'm posting this old script I don't use any more cause I use Irssi now but some people think it's useful :) . I wrote this in October, 2009.

#!/usr/bin/perl
#           hilightlogger.pl
#  Tue Oct 13 10:21:03 2009
#  Copyright  2009  jolttz
#  jolttz{ät}gmail{dot}com
#  

# Visit http://loder.pri.ee/

use strict;
use warnings; 

my $away = 0; # Automatically on = 1
Xchat::register("Highlight Logger", "1.0", "Highlight Logger"); 

Xchat::hook_print("Channel Msg Hilight", "highlight");
Xchat::hook_print("Channel Action Hilight", "actionhighlight");
Xchat::hook_command("hilight_on", "hilight_on");
Xchat::hook_command("hilight_off", "hilight_off");

Xchat::print("Loaded: Perl Highlight logger script by B22stard.");

sub hilight_on {
    $away = 1;
    Xchat::print("Will now log Highlights");
    return 1;
}

sub hilight_off {
    $away = 0;
    Xchat::print("Will no longer log Highlights");
    return 1;
}

sub highlight {
    if ($away) {
        my $whom = $_[0][0];
        my $text = $_[0][1];
        my $chan = Xchat::get_info('channel');
        my $serv = Xchat::get_info('server'); 

        Xchat::command("query (HighLights)", "", "$serv");
        Xchat::print("$whom\t$text (7$chan, 7$serv)", "(HighLights)", "$serv");
        return Xchat::EAT_NONE;
    }
} 

sub actionhighlight {
    if ($away) {
        my $whom = $_[0][0];
        my $text = $_[0][1];
        my $chan = Xchat::get_info('channel');
        my $serv = Xchat::get_info('server'); 

        Xchat::command("query (HighLights)", "", "$serv");
        Xchat::print("$whom\t$text (7$chan, 7$serv)", "(HighLights)", "$serv");
        return Xchat::EAT_NONE;
    }
}
24Jan/101

Rhythmbox Now Playing script for Irssi [Perl]

Simple but cool script. Show the IRC people what you listen to ;)
Put the script to .irssi/scripts/autorun/ and load it from Irssi with "/run autorun/rhythm-np.pl".

#!/usr/bin/perl
#           rhythmbox-np.pl
#  Sun Jan 24 03:53:01 2010
#  Copyright  2010  jolttz
#  jolttz{ät}gmail{dot}com
#

use strict;
use Irssi;

Irssi::command_bind('np', 'np');

sub np {
	my ($data, $server, $witem) = @_;

    my $title = `rhythmbox-client --print-playing-format %tt`;
    my $artist = `rhythmbox-client --print-playing-format %ta`;
	my $duration = `rhythmbox-client --print-playing-format %td`;
	my $elapsed = `rhythmbox-client --print-playing-format %te`;

	if (defined $title) {
		$witem->command("me is listening to: $artist - $title ($elapsed/$duration)")
	} else {
		Irssi::print("Rhythmbox is not playing.");
	}
}
23Jan/100

Automated clipboard to pastebin poster in Perl

I'm a lazy person and I like making my life easier. That's probably why I like programming. I use Pastebin a lot and decided to write a script to automate the pasting process. The script takes your clipboard text, posts it to Pastebin and replaces clipboard with the link to the post. I binded the script to a key so it can be done even faster. If you get error about 'xclip' while running the script you may need to install xclip with your package manager. This should work on Windows machines too, haven't tested though. "Clipboard" and "LWP::UserAgent" modules are needed, use cpan to install them.

#!/usr/bin/perl
#           clip2pastebin.pl
#  Sat Jan 23 09:17:38 2010
#  Copyright  2010  jolttz
#  jolttz{ät}gmail{dot}com
#
# Pastebins your clipboard text and replaces
# your clipboard with link to the post.
 

use strict;
use Clipboard;
use LWP::UserAgent;

my $data = Clipboard->paste;

my $poster = ''; # Name it'll be poster under, leave blank for Anonymous.
my $expiry = 'm'; # d = a day; m = a month; f = forever;

my $posturl = pastebin($data, $poster, $expiry);

Clipboard->copy($posturl);

sub pastebin {
    my ($data, $poster, $expiry) = @_;

    # For posting to private pastebin just replace the URL
    my $url = "http://pastebin.com/pastebin.php"; 

    my $ua = LWP::UserAgent->new(
        agent => "B22stard FTW"
    );

    my %args = (
                code2 => $data,
                remember => "0", # Don't remember the user
                paste => 'Send',
                poster => $poster,
                expiry => $expiry,
            );

    my $response = $ua->post( $url,
        CONTENT => \%args
    );

    return $response->header("Location"); # Return link
}

If you need any help using this script or programming Perl hop into #perlbar in irc.malvager.com.

15Jan/101

Gmail checker for dwm menu

I've been using dwm for some time now. I'm really in love with it. It's a tiling window manager that is really minimal and lightweight. Perfect for my old laptop :) . Anyway, what I wanted to post is a simple but cool script written in Perl, by me. It gets the amount of new emails from your Gmail atom feed and prints it to dwm menu. The script can be remade for conky or whatever you want. Add the following to "~/.scripts/checkgmail.pl".

#!/usr/bin/perl
#           checkgmail.pl
#  Tue Jan 12 18:43:51 2010
#  Copyright  2010  jolttz
#  jolttz{ät}gmail{dot}com
#

my $username = "username"; # Your username here
my $password = "password"; # and password

my $data = `wget -O - https://$username:$password\@mail.google.com/mail/feed/atom --no-check-certificate`;

if ($data =~ m/<fullcount>(\n*)<\/fullcount>/) {
    print $1;
} else {
    print "Error";
}

You also have to add the following lines to your .xinitrc file.

while true
do
    xsetroot -name  "[$(perl ~/.scripts/checkgmail.pl) new Emails]"
    sleep 60s
done &

If you also want date & time on your menu your .xinitrc should be something like that:

while true
do
    xsetroot -name  "[$(perl ~/.scripts/checkgmail.pl) new Emails] $(date +'%a %b %d, %H:%M')"
    sleep 60s
done &