#
# (C) 2018 Hirohisa Aman <aman@computer.org>
#
# This is an implementation of "Samurai" algorithm for 
# automatically splitting identifiers.
#
# The algorithm is proposed by Eric Enslen, Emily Hill, 
# Lori Pollock and K. Vijay-Shanker, in thier paper
# "Mining source code to automatically split identifiers 
#  for software analysis"
# in Proc. 6th IEEE International Working Conf. Mining Software
# Repositories (MSR2009), pp. 71-80, May 2009.
#

package samurai_clone;

use strict;

#############################################################
# parameter
$samurai_clone::DICT_DIR = "/var/www/html/tool/Samurai-clone/dict/";
$samurai_clone::DICT = $samurai_clone::DICT_DIR . "dict.csv";
$samurai_clone::PREFIX = $samurai_clone::DICT_DIR . "prefixes.txt";
$samurai_clone::SUFFIX = $samurai_clone::DICT_DIR . "suffixes.txt";
#############################################################

#############################################################
# main 
#############################################################

print STDERR "This is a clone of \"Samurai\" for Java programs.\n";

$samurai_clone::PROGRAM = $ARGV[0];
my $opt = @ARGV[1];
my @inputs = ();
if ( $opt eq "-s" ){
    push(@inputs, $ARGV[2]);
}
elsif ( $opt eq "-f" ){
    open(TARGET, $ARGV[2]) or die("*** Error: failed to open " . $ARGV[2]);
    while ( my $line = <TARGET> ){
	chomp($line);
	next if $line =~ /^\s*$/;
	push(@inputs, $line);
    }
    close(TARGET);
}
else{
    print STDERR "*** Error: wrong arguments! ***\n";
    print STDERR "perl samurai.pl src.java (-s|-f) xxx\n";
    print STDERR "    src.java: the source file in which the target identifier appears\n";
    print STDERR "    -s xxx: xxx is the identifier (string)\n";
    print STDERR "    -f xxx: xxx is the file including identifiers where one line presents one identifier\n";
    exit;
}

&setup();

for my $token ( @inputs ){
    print $token . ":" . &mixedCaseSplit($token), "\n";
}


#############################################################
# subroutines 
#############################################################
# dictionary setup
sub setup {
    print STDERR "now loading dictionaries ... ";

    %samurai_clone::DICT = ();
    open(DICT, $samurai_clone::DICT) or die("*** Error: failed to open " . $samurai_clone::DICT);
    while ( my $line = <DICT> ){
	chomp($line);
	my ( $s, $cnt ) = split(/,/, $line);
	$samurai_clone::DICT{$s} = $cnt;
    }
    close(DICT);

    %samurai_clone::PREFIX = ();
    open(PREFIX_FILE, $samurai_clone::PREFIX) or die("*** Error: failed to open " . $samurai_clone::PREFIX);
    while ( my $line = <PREFIX_FILE> ){
	chomp($line);
	$samurai_clone::PREFIX{$line} = 1;
    }
    close(PREFIX_FILE);

    %samurai_clone::SUFFIX = ();
    open(SUFFIX_FILE, $samurai_clone::SUFFIX) or die("*** Error: failed to open " . $samurai_clone::SUFFIX);
    while ( my $line = <SUFFIX_FILE> ){
	chomp($line);
	$samurai_clone::SUFFIX{$line} = 1;
    }
    close(SUFFIX_FILE);
    
    $samurai_clone::allStrsFreq = 0;
    %samurai_clone::LOCAL_DICT = ();
    open(PROG, $samurai_clone::PROGRAM) or die("*** Error: failed to open " . $samurai_clone::PROGRAM);
    while ( my $line = <PROG> ){
	chomp($line);
	my @tokens = split(/[^a-zA-Z_0-9]/, $line);
	foreach my $t ( @tokens ){
	    next if length($t) == 0;
	    if ( !exists($samurai_clone::LOCAL_DICT{$t}) ){
		$samurai_clone::LOCAL_DICT{$t} = 1;
	    }
	    else{
		$samurai_clone::LOCAL_DICT{$t}++;
	    }
	    $samurai_clone::allStrsFreq++;
	}
    }
    close(PROG);

    print STDERR "done.\n";
}


# Algorithm1: mixedCaseSplit
sub mixedCaseSplit {
    my $token = $_[0];
    $token = &splitOnSpecialCharsAndDigits($token);
    $token = &splitOnLowercaseToUppercase($token);
    my $sToken = "";
    
    my @tokens = split(/ /, $token);
    foreach my $s ( @tokens ){
	if ( $s =~ /[A-Z][a-z]/ ){
	    my $i = index($s, $&);
	    
	    my $camelScore = 0;
	    if ( $i > 0 ){
		$camelScore = &score(substr($s, $i));
	    }
	    else{
		$camelScore = &score($s);
	    }
	    
	    my $altScore = &score(substr($s, $i+1));
	    
	    if ( $camelScore > sqrt($altScore) ){
		if ( $i > 0 ){
		    substr($s, $i, 0) = " ";
		}
	    }
	    else{
		substr($s, $i+1, 0) = " ";
	    }
	}
	
	$sToken .= " $s";
    }
    
    $token = $sToken;
    $sToken = "";
    @tokens = split(/ /, $token);
    foreach my $s ( @tokens ){
	next if length($s) == 0;
	$sToken .= " " . &sameCaseSplit($s, &score($s));
    }

    return $sToken;
}

# Algorighm2: sameCaseSplit
sub sameCaseSplit {
    my $s = $_[0];
    my $score_ns = $_[1];

    my $splitS = $s;
    my $n = length($s) - 1;
    my $maxScore = -1;
    my $max_score_s_ns = &score($s);
    if ( $max_score_s_ns < $score_ns ){
	$max_score_s_ns = $score_ns;
    }

    for ( my $i = 0; $i < $n; $i++ ){
	my $s_left = substr($s, 0, $i+1);
	my $s_right = substr($s, $i+1);
	my $score_l = &score($s_left);
	my $score_r = &score($s_right);
	my $prefix = ( &isPrefix($s_left) || &isSuffix($s_right) ) ? 1 : 0;
	my $toSplit_l = ( sqrt($score_l) > $max_score_s_ns ) ? 1 : 0;
	my $toSplit_r = ( sqrt($score_r) > $max_score_s_ns ) ? 1 : 0;
	if ( !$prefix && $toSplit_l && $toSplit_r ){
	    if ( ($score_l + $score_r) > $maxScore ){
		$maxScore = $score_l + $score_r;
		$splitS = $s_left . " " . $s_right;
	    }
	}
	elsif ( !$prefix && $toSplit_l ){
	    my $temp = &sameCaseSplit($s_right, $score_ns);
	    if ( $temp ne $s_right ){
		$splitS = $s_left . " " . $temp;
	    }
	}
    }

    return $splitS;
}


sub splitOnSpecialCharsAndDigits {
    my $token = $_[0];

    $token =~ s/[^a-zA-Z0-9]/ /g;
    $token =~ s/\d+/ $& /g;

    return $token;
}

sub splitOnLowercaseToUppercase {
    my $token = $_[0];

    while ( $token =~ /[a-z][A-Z]/ ){
	my $target = $&;
	my @target_letters = split(//, $target);
	$target = $target_letters[0] . " " . $target_letters[1];
	$token =~ s/[a-z][A-Z]/$target/;
    }

    return $token;
}

sub Freq {
    my $str = $_[0];
    my $freq = 0;
    if ( exists($samurai_clone::LOCAL_DICT{$str}) ){
	$freq = $samurai_clone::LOCAL_DICT{$str};
    }

    return $freq;
}

sub globalFreq {
    my $str = $_[0];
    my $freq = 0;
    if ( exists($samurai_clone::DICT{$str}) ){
	$freq = $samurai_clone::DICT{$str};
    }

    return $freq;
}

sub score {
    my $s = $_[0];
    my $log = log($samurai_clone::allStrsFreq)/log(10);
    return &Freq($s) + &globalFreq($s)/$log;
}

sub isPrefix {
    my $str = $_[0];
    $str =~ tr/[A-Z]/[a-z]/;
    return exists($samurai_clone::PREFIX{$str}) ? 1 : 0;
}

sub isSuffix {
    my $str = $_[0];
    $str =~ tr/[A-Z]/[a-z]/;
    return exists($samurai_clone::SUFFIX{$str}) ? 1 : 0;
}