Apr 24 2009 NukeZone Programming

Here's the nukezone top 100 irssi IRC perl script.
This could be used to find sweet targets with a little modification.  

I've done that myself already for another game.
Unfortunately, I never found a nice group of people to play with that made we want to work on that.
The variable width fields and colors make the output very nice and readable. The error checking is pretty nice too.
Recently people are turning up with lame province names with characters @,+,/.
Since I didn't explicity allow those chars in the input, they're being dropped from the output.
I don't know if I'll get around to changing that.

#!/usr/bin/perl
# e dziewa november 2008

use warnings;
use strict;

use vars qw($VERSION %IRSSI);
use Irssi qw(command_bind);

$VERSION = '1';
%IRSSI = (
    authors        => 'E. Dziewa',
    contact        => 'eric@dziewa.com',
    name       => 'Nukezone Top 100 Statistics IRC bOt',
    description    => 'Watches the top lists',
    license        => 'GNU GPL 3',
    restriction => 'Open Source operating systems only',
    url            => 'http://eric.dziewa.com'
);

our $PrimaryToggle = 1;
our ( $stopprimary, $timestamp, $offsettime );
our @color = ( '8', '9', '11', '12', '13');
our @newcolor;

sub color_func {
    if ( ($newcolor[0]) ) {
        return shift @newcolor;
    }
    else {
        push( @newcolor, '4', '8', '9', '11', '12', '13' );
        return shift @newcolor;
    }
}

sub get_it { ### give me filename, type, offset, searchtype, and numbers or names to search for
             ### type and offset are just passed along
             ### send  numbers in order to optimize speed
             ### format_it($type, $offset, $Stype, @retval);
    my @retval; my $file = shift; my $type = shift; my $offset = shift; my $Stype = shift;
    if ( $_[0] =~ /^LAST$/ ) { ; } # do something to find last
    foreach my $pattern ( @_ ) {
        if ( $pattern =~ /^\d+$/ ) {
            open( FH, "<", $file ) or return "wtf get_it";
            while ( <FH> ) {
                #next unless ( /^.+?\..+\)\.$pattern\..+$/ );
                next unless ( /^.+?\..+\)\.$pattern\..+?\..+?\..+?\..+?\..+?\..+$/ );
                chomp; push( @retval, $_); #last;
            }
        }
        else { ### escape [ and ] for the regex matches later on \x5b =[ , \x5d = ], \x5c = \
            (my $newpattern = $pattern ) =~ s/\x5b/\x5c\x5b/;  ( $newpattern = $pattern ) =~ s/\x5d/\x5c\x5d/;
            open( FH, "<", $file ) or return "wtf get_it";
            while ( <FH> ) {
                next unless ( /^$pattern/i );  
                chomp; push( @retval, $_); last;
            }
        }
    }
    close FH;
    return @retval;
}

sub format_it { ### give me type, offset, and sorttype ### my $retval3 = format_it($type, $hour, $Atype, @retval2);
    my $type = shift; my $offset = shift; my $Stype = shift;
    my @retarray = ();
    my @w = qw/0 0 0 0 0 0 0 0 0/;
    foreach ( @_ ) { ### find max length
        my @array = split( /\./, $_ );
        for my $i ( 0..8 ) {
            $w[$i] = length($array[$i]) if ( length($array[$i]) > $w[$i] );  
        }
    }

    my $prestring;
    if ( $Stype =~ /rev/ ) {
        if ( $type =~ /cb/ ) {
            $prestring = "Bottom of the List Combo ".int($offset/24)." Day ->";
        }
        elsif ( $type =~ /pr/ ) {
            $prestring = "Bottom of the List Province Networth $offset Hour ->";
        }
        elsif ( $type =~ /nw/ ) {
            $prestring = "Bottom of the List Clan Networth $offset Hour ->";
        }
        else { ### pt
            $prestring = "Bottom of the List Clan Points $offset Hour ->";
        }
    }
    elsif ( $Stype =~ /abs/ ) {
        if ( $type =~ /cb/ ) {
            $prestring = "Most Active Combo ".int($offset/24)." Day ->";
        }
        elsif ( $type =~ /pr/ ) {
            $prestring = "Most Active Province Networth $offset Hour ->";
        }
        elsif ( $type =~ /nw/ ) {
            $prestring = "Most Active Clan Networth $offset Hour ->";
        }
        else { ### pt
            $prestring = "Most Active Points Clans $offset Hour ->";
        }
    }
    else { ### standard
        if ( $type =~ /cb/ ) {
            $prestring = "Top Combo Clans ".int($offset/24)." Day ->";
        }
        elsif ( $type =~ /pr/ ) {
            $prestring = "Top Province Networth Gains $offset hour ->";
        }
        elsif ( $type =~ /nw/ ) {
            $prestring = "Top Clan Networth Gains $offset Hour ->";
        }
        else { ### pt
            $prestring = "Top Points Gains $offset Hour ->";
        }
    }

push( @retarray, $prestring );

    foreach( @_ ) {
        my @array = split( /\./, $_ ); my $inset;
        my $rand = color_func();
        if ( $type =~ /cb/ ) { $inset = '('. int($offset/24) .')'; }
        else { $inset = "($offset)"; }        
            my $string = sprintf(" \003%02d%-${w[0]}s\003 %-${w[1]}s $inset \003%02d%${w[2]}s\003 Total -> \cB%${w[4]}s\co %${w[5]}s %${w[3]}s Rank -> \cB%${w[6]}s\co %${w[7]}s %${w[8]}s",
            $rand,
            $array[0],
            $array[1],
            $rand,
            $array[2],
            $array[4],
            $array[5],
            $array[3],
            $array[6],
            $array[7],
            $array[8] );
            push( @retarray, $string );
    }
    return @retarray;
}

sub create_it { ### feed me type [pr cb pt nw], offset, and optionally a sort type
                ### returns 0 on error, 1 otherwise, and a filename
                ### creates the difference from past to present in points, networth, or combo

    my $Stype = $_[2] || 'standard';
    my $presentfile = "/home/armorbot/nukezonetop10/final/${timestamp}--${_[0]}.final";
    if ( ! -e $presentfile ) { return [ 0, $presentfile ]; }
    my $pastfile = "/home/armorbot/nukezonetop10/final/${offsettime}--${_[0]}.final";
    if ( ! -e $pastfile ) { return [ 0, $pastfile ]; }
    my $createfile = "/home/armorbot/nukezonetop10/creations/${timestamp}--${_[1]}--${_[0]}.${Stype}.file";

    if ( -e $createfile ) { return [ 1, $createfile ]; }
    else {
        my ( %ranks, @offlist, %arrayrefs );
        open( FH, "<", $presentfile ) or return [ 0, $presentfile ];
        while (<FH>) {
            if (  /^(\d+)\.([A-Za-z0-9 \[\]]+)(\(#\d+\))\$?(\d+)/ ) {
                $ranks{$2} = [ $3, $1, $4 ]; ### id rank TOTALscore
            }
            else {
                print "something awry parsing $presentfile data was ->\n $_\n" unless ( $_ =~ /^$/ );
            }
        }
        close FH;

        open( FH, "<", $pastfile ) or return [ 0, $pastfile ];
        while (<FH>) {
            if (  /^(\d+)\.([A-Za-z0-9 \[\]]+)(\(#\d+\))\$?(\d+)/ ) {
                ( $ranks{$2} )
                    ? push( @{$ranks{$2}}, $1, $4, ( $ranks{$2}[2] - $4 ) ) # rank TOTALscore TOTALdifference
                    : push( @offlist, [ $1, $2, $3, $4 ] );
            }
            else {
                print "something awry parsing $pastfile data was ->\n $_\n" unless ( $_ =~ /^$/ );
            }
        }
        close FH;

        foreach ( keys %ranks ) { delete $ranks{$_} unless ( ($ranks{$_}[5]) ); }
        my @array;

        if ( $Stype =~ /abs/ ) {
            @array = sort { abs($ranks{$b}[5]) <=> abs($ranks{$a}[5]) } keys %ranks;
        }
        elsif ( $Stype =~ /rev/ ) {
            @array = sort { $ranks{$a}[5] <=> $ranks{$b}[5] } keys %ranks;
        }
        else {
            @array = sort { $ranks{$b}[5] <=> $ranks{$a}[5] } keys %ranks;
        }

        open( FH, ">", $createfile ) or return [ 0, $createfile ];
        my $i = 1;

        if ( $_[0] =~ /(?:pr|nw)/ ) {
            foreach ( @array ) {
                if ( $ranks{$_}[5] < 0 ) {
                    substr($ranks{$_}[5], 0, 1 ) = "";
                    $ranks{$_}[5] = commie($ranks{$_}[5]);
                    $ranks{$_}[5] = sprintf("\003%02d$ranks{$_}[5]\003", "5");
                    substr($ranks{$_}[5], 0, 0 ) = '-$';
                }
                elsif ( $ranks{$_}[5] > 0 ) {
                    $ranks{$_}[5] = commie($ranks{$_}[5]);
                    $ranks{$_}[5] = sprintf("\003%02d$ranks{$_}[5]\003", "3");
                    substr($ranks{$_}[5], 0, 0 ) = '+$';
                }
                else {
                    $ranks{$_}[5] = commie($ranks{$_}[5]);
                    $ranks{$_}[5] = sprintf("\003%02d$ranks{$_}[5]\003", "15");
                }

                my $signedmove = $ranks{$_}[3] - $ranks{$_}[1];
                if ( $signedmove > 0 ) {
                    $signedmove = sprintf("\003%02d$signedmove\003", "3");
                    substr($signedmove, 0, 0 ) = '+';
                }
                elsif ( $signedmove < 0 ) {
                    substr($signedmove, 0, 1 ) = "";
                    $signedmove = sprintf("\003%02d$signedmove\003", "5");
                    substr($signedmove, 0, 0 ) = '-';
                }
                else { $signedmove = sprintf("\003%02d$signedmove\003", "15"); }

                print FH "$_.${ranks{$_}[0]}.$i.", $ranks{$_}[5], ".\$", commie($ranks{$_}[2]), ".(\$", commie($ranks{$_}[4]), ").", $ranks{$_}[1], ".(", $ranks{$_}[3], ").", $signedmove, "\n";
                $i++;
                ### Name Id DurRank PointDiff PointNow PointPast RankNow RankPast RankDiff AbsValue
            }
        }
        else {
            foreach ( @array ) {
                if ( $ranks{$_}[5] > 0 ) {
                    $ranks{$_}[5] = commie($ranks{$_}[5]);
                    $ranks{$_}[5] = sprintf("\003%02d$ranks{$_}[5]\003", "3");
                    substr($ranks{$_}[5], 0, 0 ) = '+';
                }
                elsif( $ranks{$_}[5] < 0 ) {
                    $ranks{$_}[5] = commie($ranks{$_}[5]);
                    substr($ranks{$_}[5], 0, 1 ) = "";
                    $ranks{$_}[5] = sprintf("\003%02d$ranks{$_}[5]\003", "5");
                    substr($ranks{$_}[5], 0, 0 ) = '-';
                }
                else {
                    $ranks{$_}[5] = commie($ranks{$_}[5]);
                    $ranks{$_}[5] = sprintf("\003%02d$ranks{$_}[5]\003", "15");
                }

                my $signedmove = $ranks{$_}[3] - $ranks{$_}[1];
                if ( $signedmove > 0 ) {
                    $signedmove = sprintf("\003%02d$signedmove\003", "3");
                    substr($signedmove, 0, 0 ) = '+';
                }
                elsif ( $signedmove < 0 ) {
                    substr($signedmove, 0, 1 ) = "";
                    $signedmove = sprintf("\003%02d$signedmove\003", "5");
                    substr($signedmove, 0, 0 ) = '-';
                }
                else { $signedmove = sprintf("\003%02d$signedmove\003", "15"); }

                print FH "$_.${ranks{$_}[0]}.$i.", $ranks{$_}[5], ".", commie($ranks{$_}[2]), ".(", commie($ranks{$_}[4]), ").", $ranks{$_}[1], ".(", $ranks{$_}[3], ").", $signedmove,  "\n";
                $i++;
                ### Name Id DurRank PointDiff PointNow PointPast RankNow RankPast RankDiff
            }
        }
        close FH;
        ### for ( 0..$#offlist ) { print "offlist -> $offlist[@$_]\n"; } ### do something with these?
        if ( -z $createfile ) { ### check file isn't zero length.
            unlink $createfile; # stops the second call
            return [ 0, 0 ]
        }
        else {
            return [ 1, $createfile ]
        }
    }
}

sub commie {
    my $txt = reverse $_[0];
    $txt =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
    return scalar reverse $txt;
}

our %primaryfunction2 = ( ### all random
    'allrandom' => sub {
        my $server = Irssi::server_find_tag('quakenet');
        $timestamp = int(time()/3600);

        my @Atype = ( 'abs', 'rev', 'standard', 'standard', 'abs' );
        my $Atype = $Atype[int(rand(scalar(@Atype)))];

        my @type = ( 'pr', 'cb', 'nw', 'pt', 'pt', 'pt' );
        my $type = $type[int(rand(scalar(@type)))];

        my $hour;
        if ( $type !~ /cb/ ) {
            my @hour = ( '1', '6', '12', '24', '24', '24', '48', '168' );
            $hour = $hour[int(rand(scalar(@hour)))];
        }
        else {
            my @hour = ( '24', '48', '72', '96', '120', '144', '168' );
            $hour = $hour[int(rand(scalar(@hour)))];
        }

        $offsettime = $timestamp - $hour;

        my $retval = create_it( $type, $hour, $Atype ); ### type, offset, sorttype

        if ( $retval->['0'] == 1 ) {
            my @retval2 = get_it( $retval->['1'], $type, $hour, $Atype, 1, 2, 3, 4, 5 );

            my @retval3 = format_it($type, $hour, $Atype, @retval2);
            ### filename type, offset, searchtype, - what to search
            foreach ( @retval3 ) {
                # print "$_";
                $server->command("msg #armorbot $_");
            }
        }
        else {
            if ( $retval->['1'] =~ /$timestamp/ ) {
                print "No file yet";
            }
            elsif ( $retval->['1'] =~ /$offsettime/ ) {
                print "Old file doesn't exist";
            }
            elsif ( $retval->['1'] == 0 ) {
                print "Empty file";
            }
            else { print "You have problems" }
        }
});

sub toggleprimary2 {
        if ( $PrimaryToggle == 1 ) {
        $stopprimary = Irssi::timeout_add('1800001', $primaryfunction2{'allrandom'}, undef);
        $primaryfunction2{'allrandom'}();
        print "prime started";
        $PrimaryToggle = 0;
    }
    else {
        Irssi::timeout_remove("$stopprimary");
        print "prime stopped";
        $PrimaryToggle = 1;
    }
}

Irssi::command_bind('prime', 'toggleprimary2');


Download
Screenshot

   
Comments
No comments.
Comments for this entry available via RSS.
Comment Area
Your Name
Your Email (will not be published)
Your Website
Your Comment
Profanity is Prohibited
eric.dziewa.com is running WordPress.
WhiteSpace theme designed by E. Dziewa.
All content © E. Dziewa.
Thanks for stopping by.