#!/usr/bin/perl -w
#
# coderanker - rate a program by it's difficulty. (Rough estimation).
#              Written in Perl. Currently ranks perl, sh, ksh.
#
# Need to learn a new language but can't understand the broken program your
# boss gave you to fix? Maybe you should start with an easier program,
# but since you are learning the language to begin with it can be hard
# to judge what is easy and what is hard. coderanker can help.
#
# 25-Mar-2004, ver 0.65        (check for newer versions)
#
# USAGE:    coderanker [-h] | language filename [filename...]
#    eg,
#           coderanker perl dailyreport.pl         # rank this perl program
#           coderanker sh network.sh               # rank this shell script
#
# The percent rating roughly reflects how much of that language is in that 
# one program. If you are learning a new language you want this to be
# around 10%. A program that scores around 50% is very difficult.
# For example if you were learning a foreign language you wouldn't want
# to start by reading material that contained 50% of their vocabulary.
#
# LANGUAGES: 
#           perl        # Perl programming
#           sh          # Bourne shell scripting
#           ksh         # Korn shell scripting
#
# RATINGS:
#           easy
#           intermediate
#           moderate
#           difficult
#           advanced
#           challenging
#           expert
#           wizard
#           guru
#           insane
#
# COPYRIGHT: Copyright (c) 2006 Brendan Gregg.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2
#  of the License, or (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software Foundation,
#  Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
#  (http://www.gnu.org/copyleft/gpl.html)
#
# Author: Brendan Gregg  [Sydney, Australia]
#
# ToDo:
#  * Add more languages.
#
# 24-Mar-2004    Brendan Gregg    Created this.
# 25-Jan-2006       "      "      Tweaked style.

use strict;

### Arguments
usage() if @ARGV < 2 or $ARGV[0] eq "-h" or $ARGV[0] eq "--help";
my $filelang = shift(@ARGV);
my @Filenames = @ARGV;

### Variables
my @Db = <DATA>;
my $VERBOSE = 0;
my $DEBUG = 0;
my @Ranking;
my %Modifier;
my %Languages;
setRankings();

### Check language
if (! defined $Languages{$filelang}) {
    print STDERR "ERROR1: Unknown language, $filelang.\n\n";
    printLangs();
    exit 1;
}
    
#
#  Main
#
foreach my $filename (@Filenames) {
    my $max = 0;
    my $points = 0;

    ### Load program
    open FILE, $filename or die "ERROR2: Can't open $filename: $!\n";
    my @File = <FILE>;
    my $file = join "", @File;
    close FILE;

    ### RE checks
    foreach (@Db) {
        my ($lang, $re, $num, $notes) = split /:/;
        next if $lang ne $filelang;
        $re =~ s/COLON/:/g;
        $max += $num;
        if ($file =~ /$re/) {
            $notes = "" unless defined $notes;
            chomp $notes;
            printf "Found: %-35s $notes\n", $re if $DEBUG;
            $points += $num;
        }
    }
    
    ### Size checks
    $points += 1 if length($file) > 2048;
    $points += 1 if length($file) > 8196;
    $points += 3 if length($file) > 32768;
    $max += 5;
    
    ### Rating and Ranking calculations
    print "Scored $points points out of $max\n" if $VERBOSE;
    my $rating  = 100 * $points / $max;
    $rating     = 100 if $rating > 100;
    my $level   = int($#Ranking * $points/($max - $Modifier{$filelang}));
    $level      = $#Ranking if $level > $#Ranking;
    my $ranking = $Ranking[$level];
    
    printf "Rating, $filename: \t%.0f%% ($ranking)\n", $rating;
}
    
#
#  Subroutines
#
sub setRankings {
    # The rating labels,
    @Ranking = ("easy", "intermediate", "moderate", "difficult", "advanced",
                "challenging", "expert", "wizard", "guru", "insane");

    # The following adjusts the maximum for certain languages to provide
    # realism (less likely in sh to use the whole vocabulary).
    %Modifier = qw(perl 0 sh 15 ksh 10);

    # Known languages
    %Languages = qw(perl 1 sh 1 ksh 1);
}

sub printLangs {
    print "Known languages are,\n";
    print "\t$_\n" foreach (sort keys %Languages);
}

sub usage {
    print STDERR "USAGE: $0 [-h] | language filename [filename ...]\n";
    print STDERR "   eg, $0 perl daily.pl       # rank this perl program\n";
    print STDERR "       $0 sh network.sh       # rank this shell script\n";
    exit 1;
}


### Database
#
# format is,  language:RE:points:notes
#
# the notes are for debug.
#

__DATA__
perl:\n\s*print\b:1
perl:\n\s*printf\b:1
perl:\n\s*die\b:1
perl:\n\s*pack\b:2
perl:\n\s*unpack\b:2
perl:\n\s*read\b:5
perl:\n\s*open\b:1
perl:\n\s*close\b:1
perl:\n\s*binmode\b:1
perl:\n\s*my\b:3
perl:\n\s*local\b:3
perl:\n\s*return\b:1
perl:\n\s*next\b:1
perl:\n\s*last\b:1
perl:\n\s*while\b:1
perl:\n\s*foreach\b:1
perl:\n\s*sub\b:1
perl:\n\s*use\b:2
perl:\n\s*require\b:2
perl:\n\s*system\b:2
perl:\n[^#]*\bdefined\b:2
perl:\n[^#]*\bexists\b:2
perl:\n[^#]*\bscalar\b:2
perl:\n[^#]*\bsplit\b:2
perl:\n[^#]*(pop|push)\b:1
perl:\s\$:1:scalar
perl:\s\@:1:array
perl:\s\%:2:hash
perl:\s\&:2:subroutine
perl:\s\${?\$:3:pointer
perl:\s\@{?\$:3:pointer
perl:\s\%{?\$:3:pointer
perl:\s\&{?\$:3:pointer
perl:\s\$\w*{:2:hash value
perl:}->{:3:complex data type
perl:\$\w*{\S*}{\S*}{\S*}:5:complex data type
perl:=~\s*\/:1:RE
perl:\(\S*\)\s*=\s*\S*\s*=~\s*\/\S*\(:8:back refs
perl:=~\s*s:1:sed
perl:=~\s*tr:2:translate
perl:\bqq\/:1:qq's
perl:\bqw\(:1:qw's
perl:\`.*\`:1:command
perl:\n\s*if\b:1
perl:\n\s*unless\b:1
perl:\S\s*if\b:1:statement modifier
perl:\S\s*unless\b:1:statement modifier
perl:= shift:1
perl:\$SIG{:3:signals
perl:\$ENV{:1:environment
perl:if\s*\(\s*\(:1:complex if
perl:\belsif\b:1
perl:\s*=\s*<\w:1:file handles
perl:=.*->new;\n:3:OO
perl:getopts\b:2
sh:\n\s*echo\b:1
sh:\n\s*read\b:1
sh:\n\s*if\b:1
sh:\n\s*for\b:1
sh:\n\s*while\b:1
sh:\n\s*case\b:1
sh:\n\s*trap\b:3
sh:\n\s*exec\b:4
sh:\n\s*return\b:2
sh:\n\s*COLON:2:null
sh:\n\s*set -[xvf]\b:1:debug
sh:\n\s*set (-- |- |)(\`|\$)\b:2:pos params
sh:\belif\b:1
sh:\bgrep\b:1
sh:\bsed\b:2
sh:\bawk\b:3
sh:\beval\b:3
sh:\n[^#]*export\b:1
sh:basename\b|dirname\b:1
sh:\s\$:1:scalar
sh:\s\${:1:scalar
sh:\s\$\*:1:list
sh:\s\$\@:1:list
sh:\s\$[123]:1:pos param
sh:\s\$\$:1:pid
sh:\s\$\?:1:exit status
sh:\s\$\!:1:child
sh:\s\|:1:pipe
sh:\s\|.*\|:1:multiple pipe
sh:\\\n:1:continuation
sh:\`:1:back quotes
sh:\':1:forward quotes
sh:\":1:double quotes
sh:\n\s*\S*=\`.*\`:1:command
sh:\s&\n:1:background
sh:\s<:1:redirection
sh:\s>:1:redirection
sh:\s>>:1:redirection
sh:<<\s*\S*\n:2:here doc
sh:\s2>&1:2:pipe join
sh:\s>&[3..9]:5:custom FH
sh:\s(<|>)&-:2:close FH
sh:\n\s*\S*=\S*\s\S*:1:var dec and cmd
sh:\${\w*(-|=|\?)\S*}:3:param sub
sh:\n\s*\w*\s*\(\)\s*({|\n):2:subroutine
sh:\n\s*.\s+\S:2:sourcing
ksh:\n\s*echo\b:1
ksh:\n\s*read\b:1
ksh:\n\s*if\b:1
ksh:\n\s*for\b:1
ksh:\n\s*while\b:1
ksh:\n\s*case\b:1
ksh:\n\s*trap\b:3
ksh:\n\s*exec\b:4
ksh:\n\s*return\b:2
ksh:\n\s*COLON:2:null
ksh:\n\s*set -[xvf]\b:1:debug
ksh:\n\s*set (-- |- |)(\`|\$)\b:2:pos params
ksh:\belif\b:1
ksh:\bgrep\b:1
ksh:\bsed\b:2
ksh:\bawk\b:3
ksh:\beval\b:3
ksh:\n[^#]*export\b:1
ksh:basename\b|dirname\b:1
ksh:\s\$:1:scalar
ksh:\s\${:1:scalar
ksh:\s\$\*:1:list
ksh:\s\$\@:1:list
ksh:\s\$[123]:1:pos param
ksh:\s\$\$:1:pid
ksh:\s\$\?:1:exit status
ksh:\s\$\!:1:child
ksh:\s\|:1:pipe
ksh:\s\|.*\|:1:multiple pipe
ksh:\\\n:1:continuation
ksh:\':1:forward quotes
ksh:\":1:double quotes
ksh:\n\s*\S*=\`.*\`:1:command
ksh:\s&\n:1:background
ksh:\s<:1:redirection
ksh:\s>:1:redirection
ksh:\s>>:1:redirection
ksh:<<\s*\S*\n:2:here doc
ksh:\s2>&1:2:pipe join
ksh:\s>&[3..9]:5:custom FH
ksh:\s(<|>)&-:2:close FH
ksh:\n\s*\S*=\S*\s\S*:1:var dec and cmd
ksh:\${\w*(-|=|\?)\S*}:3:param sub
ksh:\n\s*\w*\s*\(\)\s*({|\n):1:subroutine
ksh:\n\s*.\s+\S:2:sourcing
ksh:\n\s*print\b:1
ksh:\${\w*(\%|#):2:var sub
ksh:(\`|\$\():1:back quotes
ksh:\s\${\w*\[:2:array
ksh:\n\s*select\b:2
ksh:\n\s*typeset\b:3
ksh:FPATH=:2:autoloading
ksh:\n\s*function:2:subroutine
ksh:\n\s*read\s*-u:2:custom FH
ksh:\|&\s*\n:4:co-process