#!/usr/bin/perl -w
use strict;

#------------------------------------------------- perl -------------------------------------------------------------

# Tableau des mots à colorer en perl
my @perl_word_to_color = ('BEGIN', 'CORE', 'DESTROY', 'END', 'EQ', 'GE', 'GT', 'INIT', 'LE', 'LT', 'NE', 'CHECK', 'abs', 'accept', \
'alarm', 'and', 'atan2', 'bind', 'binmode', 'bless', 'caller', 'chdir', 'chmod', 'chomp', 'chop', \
'chown', 'chr', 'chroot', 'close', 'closedir', 'cmp', 'connect', 'continue', 'cos', 'crypt', \
'dbmclose', 'dbmopen', 'defined', 'delete', 'die', 'do', 'dump', 'each', 'else', 'elsif', 'endgrent', \
'endhostent', 'endnetent', 'endprotoent', 'endpwent', 'endservent', 'eof', 'eq', 'eval', \
'exec', 'exists', 'exit', 'exp', 'fcntl', 'fileno', 'flock', 'for', 'foreach', 'fork', 'format', \
'formline', 'ge', 'getc', 'getgrent', 'getgrgid', 'getgrnam', 'gethostbyaddr', 'gethostbyname', \
'gethostent', 'getlogin', 'getnetbyaddr', 'getnetbyname', 'getnetent', 'getpeername', \
'getpgrp', 'getppid', 'getpriority', 'getprotobyname', 'getprotobynumber', 'getprotoent', \
'getpwent', 'getpwnam', 'getpwuid', 'getservbyname', 'getservbyport', 'getservent', \
'getsockname', 'getsockopt', 'glob', 'gmtime', 'goto', 'grep', 'gt', 'hex', 'if', 'index', \
'int', 'ioctl', 'join', 'keys', 'kill', 'last', 'lc', 'lcfirst', 'le', 'length', 'link', 'listen', \
'local', 'localtime', 'lock', 'log', 'lstat', 'lt', 'map', 'mkdir', 'msgctl', 'msgget', 'msgrcv', \
'msgsnd', 'my', 'ne', 'next', 'no', 'not', 'oct', 'open', 'opendir', 'or', 'ord', 'our', 'pack', 'package', \
'pipe', 'pop', 'pos', 'print', 'printf', 'prototype', 'push', 'quotemeta', 'qu', \
'rand', 'read', 'readdir', 'readline', 'readlink', 'readpipe', 'recv', 'redo', \
'ref', 'rename', 'require', 'reset', 'return', 'reverse', 'rewinddir', 'rindex', 'rmdir', \
'scalar', 'seek', 'seekdir', 'select', 'semctl', 'semget', 'semop', 'send', 'setgrent', \
'sethostent', 'setnetent', 'setpgrp', 'setpriority', 'setprotoent', 'setpwent', \
'setservent', 'setsockopt', 'shift', 'shmctl', 'shmget', 'shmread', 'shmwrite', 'shutdown', \
'sin', 'sleep', 'socket', 'socketpair', 'sort', 'splice', 'split', 'sprintf', 'sqrt', 'srand', \
'stat', 'study', 'sub', 'substr', 'symlink', 'syscall', 'sysopen', 'sysread', 'sysseek', \
'system', 'syswrite', 'tell', 'telldir', 'tie', 'tied', 'time', 'times', 'truncate', \
'uc', 'ucfirst', 'umask', 'undef', 'unless', 'unlink', 'unpack', 'use', 'unshift', 'untie', 'until', \
'use', 'utime', 'values', 'vec', 'wait', 'waitpid', 'wantarray', 'warn', 'while', 'write', 'xor');
#----------------------------------------------------------------------------------------------------------------------

#------------------------------------------------- bash -------------------------------------------------------------

# Tableau des mots à colorer en bash
my @bash_word_to_color = ('ar', 'asa', 'awk', 'banner', 'basename', 'bash', 'bc', 'bdiff', 'break', \
'bunzip2', 'bzip2', 'cal', 'calendar', 'case', 'cat', 'cc', 'cd', 'chmod', 'cksum', \
'clear', 'cmp', 'col', 'comm', 'compress', 'continue', 'cp', 'cpio', 'crypt', \
'csplit', 'ctags', 'cut', 'date', 'dc', 'dd', 'declare', 'deroff', 'dev', 'df', 'diff', 'diff3', \
'dircmp', 'dirname', 'do', 'done', 'du', 'echo', 'ed', 'egrep', 'elif', 'else', 'env', \
'esac', 'eval', 'ex', 'exec', 'exit', 'expand', 'export', 'expr', 'false', 'fc', \
'fgrep', 'fi', 'file', 'find', 'fmt', 'fold', 'for', 'function', 'functions', \
'getconf', 'getopt', 'getopts', 'grep', 'gres', 'hash', 'head', 'help', \
'history', 'iconv', 'id', 'if', 'in', 'integer', 'jobs', 'join', 'kill', 'local', 'lc', \
'let', 'line', 'ln', 'logname', 'look', 'ls', 'm4', 'mail', 'mailx', 'make', \
'man', 'mkdir', 'more', 'mt', 'mv', 'newgrp', 'nl', 'nm', 'nohup', 'ntps', 'od', \
'pack', 'paste', 'patch', 'pathchk', 'pax', 'pcat', 'perl', 'pg', 'pr', 'print', \
'printf', 'ps', 'pwd', 'read', 'readonly', 'red', 'return', 'rev', 'rm', 'rmdir', \
'sed', 'select', 'set', 'sh', 'shift', 'size', 'sleep', 'sort', 'spell', \
'split', 'start', 'stop', 'strings', 'strip', 'stty', 'sum', 'suspend', \
'sync', 'tail', 'tar', 'tee', 'test', 'then', 'time', 'times', 'touch', 'tr', \
'trap', 'true', 'tsort', 'tty', 'type', 'typeset', 'ulimit', 'umask', 'unalias', \
'uname', 'uncompress', 'unexpand', 'uniq', 'unpack', 'unset', 'until', \
'uudecode', 'uuencode', 'vi', 'vim', 'vpax', 'wait', 'wc', 'whence', 'which', \
'while', 'who', 'wpaste', 'wstart', 'xargs', 'zcat', 'chgrp', 'chown', 'chroot', 'dir', 'dircolors', \
'factor', 'groups', 'hostid', 'install', 'link', 'md5sum', 'mkfifo', \
'mknod', 'nice', 'pinky', 'printenv', 'ptx', 'readlink', 'seq', \
'sha1sum', 'shred', 'stat', 'su', 'tac', 'unlink', 'users', 'vdir', 'whoami', 'yes');
#----------------------------------------------------------------------------------------------------------------------


if ($#ARGV == -1 or scalar(@ARGV) >3) {
print "Usage: colour_code.pl fichier_source fichier_destination langage\n";
print "langage disponible: perl, bash\n";
}
else
{
# Ajouts des valeurs passer en argument au variable correspondante
my $fichier_source = $ARGV[0];
my $fichier_destinataire = $ARGV[1];
my $programme = $ARGV[2];

# Attribution de la table de langage aproprié
my @langage = '';

if ($programme eq 'perl')
{
@langage = @perl_word_to_color;
}
elsif ($programme eq 'bash')
{
@langage = @bash_word_to_color;
}
else
{
print "Usage: colour_code.pl fichier_source fichier_destination langage\n";
print "langage disponible: perl, bash\n";
}

# Ouverture en lecture du fichier source
open (SOURCE ,"< $fichier_source") or die "$!";

# Copie de l'ensemble des lignes dans le tableau
my @lignes = <SOURCE>;

# Fermeture du fichier source
close (SOURCE);

# Modification du code source avec marqueur de coloration
my $ligne = '';
my $motif = '';
my @nouvelle_lignes = '';
my $commentaire ='';

foreach $ligne (@lignes) {

# print "Avant: $ligne\n";

# Vérification si présence comentaire dans la ligne
if ($ligne =~ m/(?<!\$|=)#.*/) {
$ligne = $`;
$commentaire = $&;
# Coloration des commentaires
$commentaire =~ s/.*/[color=#008080]$&[\/color]/;
}

# Coloration des mots clés (bleu)
foreach $motif (@langage) {
$ligne =~ s/^$motif(?=\s|()/[color=#0000FF]$&[\/color]/; # Si le motif est en début de ligne
$ligne =~ s/(?<=\s|()$motif(?=\s|()/[color=#0000FF]$&[\/color]/g; # Sinon vérifier qu'il soit séparé par un espace avant et après
}

# Coloration des scalaires (vert): $ma_var, $ma_var, $_, $&, $`
$ligne =~ s/\$\w+|[color=#008000]$&[/color]|[color=#008000]$`[/color]|[color=#008000]$'[/color]|[color=#008000]$&[/color]/[color=#008000]$&[\/color]/g;

# Coloration des tableaux et des hash (rouge): @mon_tableau, @_, %mon_hash
$ligne =~ s/@\w+|%[0-9a-zA-Z_-]+/[color=#FF0000]$&[\/color]/g;

# print "Après: $ligne\n";

if ($commentaire ne "") {
$ligne .= $commentaire."\n";
}

$commentaire = "";

# Ajout de la nouvelle ligne dans le tableau
push(@nouvelle_lignes,$ligne);

}

# Ouverture en écriture du fichier destinataire
open (DESTINATAIRE ,"> $fichier_destinataire") or die "$!";

# Écriture du code source avec marqueur de coloration
print DESTINATAIRE @nouvelle_lignes;

# Fermeture du fichier
close (DESTINATAIRE);

}

=head1 colour_code.pl

=head2 BUT

Colorer les codes sources