Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Comment

by smokemachine (Hermit)
on Dec 28, 2005 at 18:13 UTC ( [id://519616]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info smokemachine
Description: Comment your code
/usr/bin/comenta
#!/usr/bin/perl
our %parametros;
while($para=shift) {
        $parametros{$1}=$2 if $para =~ /^--(.+)=(.+)$/;
        $parametros{arquivo}=$para unless $para =~ /^--(.+)=(.+)$/;
}    
descobre_linguagem($arquivo) unless our $linguagem=$parametros{linguag
+em};
our $arquivo=$parametros{arquivo};
our $nivel=0 unless $nivel=$parametros{nivel};
comenta_codigo();

sub comenta_codigo() {
    open(ARQ, $arquivo) or die "Arquivo '$arquivo' não encontrado";
    for(<ARQ>){
        $linhas++;
        $teste=$_;
        chomp($teste);
        unless($teste =~ /^\s*#/) {
            open(RC, "/etc/comentarios") or die "Arquivo de configuraç
+ão '/etc/comentarios' não encontrado";
            for(<RC>){
                $_ =~ /<nivel=(\d)>/;
                $eni=$1;
                if($_ =~ /<$linguagem>/i and $eni >= $nivel) {
                    $_ =~ /<expr>(.+)<\/expr>/;
                    $expre=$1;
                    chomp($expre);
                    $_ =~ /<coment>(.+)<\/coment>/;
                    $comen=$1;
                    chomp($comen);
                    if($teste =~ /$expre/) {
                        @vetor=split(/\[|\]/, $comen);
                        $i=0;
                        while($vetor[$i]){
                            print $vetor[$i].${$vetor[$i+1]};
                            $i+=2;
                        }
                        print "\n";
                        $comentarios++;
                    }
                }
            }
        }
        close RC;
        print $teste."\n";
            open(RC, "/etc/comentarios") or die "Arquivo de configuraç
+ão '/etc/comentarios' não encontrado";
            for(<RC>){
                if($_ =~ /<$linguagem>/i and $_ =~ /<inicio>/i) {
                    $_ =~ /<expr>(.*)<\/expr>/;
                    $expre=$1;
                    chomp($expre);
                    $_ =~ /<coment>(.*)<\/coment>/;
                    $comen=$1;
                    chomp($comen);
                    if($teste =~ /$expre/) {
                        @vetor=split(/\[|\]/, $comen);
                        $i=0;
                        while($vetor[$i]){
                            print $vetor[$i].${$vetor[$i+1]};
                            $i+=2;
                        }
                        print "\n";
                        $comentarios++;
                    }
                }
            }
        close RC;
    }
    close ARQ;
}

sub descobre_linguagem() {
    ($arq)=@_;
    $arq=~/.*\.([a-z]{1,2})/;
    $ext=$1;
    open(LIN, "/etc/comenta.conf") or die "Arquivo de configuração '/e
+tc/comenta.conf' não encontrado";
    for(<LIN>) {
        $a=$_;
        chomp($a);
        our $linguagem=$1 if $a =~ /^(.*)=(\w{1,2},)*$ext,?(\w{1,2},?)
+*$/;
        return() if $a =~ /^(.*)=(\w{1,2},)*$ext,?(\w{1,2},?)*$/;
        $linguagem="" unless $a =~ /^(.*)=(\w{1,2},)*$ext,?(\w{1,2},?)
+*$/;
    }
    close LIN;
}
/etc/comenta.conf
Perl=pl,pm
C=c,h,o
Bash=sh
/etc/comentarios
<C><coment><nivel=1>    # Caso a formula '[1]' seja verdadeira, execut
+a os próximos comandos</coment> <expr>if\((.*)\)\ *\{</expr>
<Perl><inicio><coment></coment> <expr>#\!\/usr\/bin\/perl</expr>
<Perl><inicio><coment>    ############################################
+########### </coment> <expr>#\!\/usr\/bin\/perl</expr>
<Perl><inicio><coment>    #        Código comentado pelo script 'comen
+ta'       # </coment> <expr>#!/usr/bin/perl</expr>
<Perl><inicio><coment>    #        Feito por Fernando Corrêa de Olivei
+ra        # </coment> <expr>#!/usr/bin/perl</expr>
<Perl><inicio><coment>    ############################################
+########### </coment> <expr>#!/usr/bin/perl</expr>
<Perl><inicio><coment></coment> <expr>#!/usr/bin/perl</expr>
<Perl><nivel=1><coment># Caso a formula '[1]' seja verdadeira, executa
+ os próximos comandos</coment> <expr>^\s*if\s?\((.*)\)\s*\{?</expr>
<Perl><nivel=1><coment># Caso a formula '[2]' seja verdadeira, executa
+ o comando '[1]'</coment> <expr>^\s*(.*)\ if\ ?\(?(.*)\)?\s?;</expr>
<Perl><nivel=1><coment># A não ser que a formula '[1]' seja verdadeira
+, executa os próximos comandos</coment> <expr>^\s*unless\ ?\(?(.*)\)?
+\ *\{</expr>
<Perl><nivel=1><coment># A não ser que a formula '[2]' seja verdadeira
+, executa o comando '[1]'</coment> <expr>^\s*(.*)\ unless\ ?\(?(.*)\)
+?\ *;</expr>
<Perl><nivel=1><coment># Enquanto a expressão '[1]' for verdadeira...<
+/coment> <expr>while\s?\((.*)\)\s?\{?</expr>
<Perl><nivel=1><coment># Para a expressão '[1]'</coment> <expr>for\s?\
+((.*)\)\s?\{</expr>
<Perl><nivel=1><coment># '[1]' => o mesmo que: '[2] = [2] + [3]'</come
+nt> <expr>((\$\w)+\+=(\d+))</expr>
<Perl><nivel=2><coment># Abre o arquivo '[2]' com o titulo '[1]'</come
+nt> <expr>open\((.*)\ ?\,\ ?(.*)\)</expr>
<Perl><nivel=3><coment># Retira o '\n' do final da variavel [1]</comen
+t> <expr>chomp\((\$.*)\)</expr>
<Perl><nivel=2><coment># Fecha o arquivo com o titulo '[1]'</coment> <
+expr>close\(?\ ?(.*)\)?\ ?;</expr>
<Sistema><nivel=1><coment>    # Usuario [1] com UID [3] e home [6]</co
+ment> <expr>(.*):(x?):(.*):(.*):(.*):(.*):(.*)</expr>
<Perl><nivel=1><coment># Para a cada um dos argumentos de '[1]' faça</
+coment> <expr>foreach\ *\((.*)\)\ *{</expr>
<Perl><nivel=1><coment># Para [1] sendo igual a cada um dos argumentos
+ de '[2]' faça</coment> <expr>foreach\ *($.*)\ \((.*)\)\ ?{</expr>
<Perl><nivel=1><coment># '[1]' => de [2] até [3]</coment> <expr>(([0-9
+]+)\ ?\.\.\ ?([0-9]+))</expr>
<Perl><nivel=3><coment># '[1]' recebe o parametro passado na chamada d
+a função</coment> <expr>\((\$.*)\)=\@_</expr>
<Perl><nivel=3><coment># [1] => '[2]' recebe o 1º parametro passado na
+ chamada do programa excluindo-o</coment> <expr>((\$.*)=shift)</expr>
<Perl><nivel=1><coment># Declaração da variavel '[1]' local</coment> <
+expr>my\s*(\$\w*);</expr>
<Perl><nivel=1><coment># Declaração da variavel '[1]' global</coment> 
+<expr>our\s*(\$\w*);</expr>
<Perl><nivel=1><coment># [1] => Declaração da variavel '[2]' local con
+tendo '[3]'</coment> <expr>(my\s*(\$\w+)=(.*));</expr>
<Perl><nivel=1><coment># [1] => Declaração da variavel '[2]' global co
+ntendo '[3]'</coment> <expr>(our\s*(\$\w+)=(.*));</expr>
<Perl><nivel=1><coment># Declaração do hash '[1]' local</coment> <expr
+>my\s*(\%\w+);</expr>
<Perl><nivel=1><coment># Declaração do hash '[1]' global</coment> <exp
+r>our\s*(\%\w+);</expr>
<Perl><nivel=1><coment># [1] => Valor da posição '[3]' do hash %[2]</c
+oment> <expr>(\$(\w+)\{(.+)\})</expr>
<Perl><nivel=1><coment># return() => Sai da função</coment> <expr>retu
+rn\ ?\(?\ ?\)?</expr>
<Perl><nivel=1><coment># return([1]) => Sai da função com '[1]' como v
+alor de retorno</coment> <expr>return\ ?\(?\ (.*)\ ?\)?</expr>
<Perl><nivel=4><coment># Como a função já diz: Usa o módulo '[1]'</com
+ent> <expr>^use\s+(.+);</expr>
<Perl><nivel=5><coment>    ############################### Função '[1]
+' #######################</coment> <expr>^\s*sub (\w*\(?\)?)\ *\{?$</
+expr>
<Perl><nivel=3><coment># [1] => Testa a expressão regular '[3]' na var
+iavel '[2]'</coment> <expr>\s?((\$\w+)\s?=~\s?(\/.+\/))</expr>
<Perl><nivel=3><coment># [1] => Reconhece qq tipo de espaço, como bran
+co, tabulação ou quebra de linha</coment> <expr>\s?\$\w+\s?=~\s?\/.*(
+\\s).*\/</expr>
<Perl><nivel=3><coment># [1] => Reconhece qq letra</coment> <expr>\s?\
+$\w+\s?=~\s?\/.*(\\w).*\/</expr>
<Perl><nivel=3><coment># [1] => Reconhece qq palavra</coment> <expr>\s
+?\$\w+\s?=~\s?\/.*(\\W).*\/</expr>
<Perl><nivel=3><coment># [1] => Reconhece qq numero</coment> <expr>\s?
+\$\w+\s?=~\s?\/.*(\\d).*\/</expr>
<Perl><nivel=3><coment># [1] => Reconhece qq coisa entre '[2]' e '[3]'
+</coment> <expr>\s?\$\w+\s?=~\s?\/.*(\[(\w|\d)\-(\w|\d)\]).*\/</expr>
<Perl><nivel=3><coment># [1] => A expressão '[2]' deve aparecer entre 
+[3] e [4] vezes</coment> <expr>\s?\$\w+\s?=~\s?\/.*(([\[|\(].+[\]|\)]
+)\{(\d),(\d)\}).*\/</expr>
<Perl><nivel=3><coment># [1] => A expressão '[2]' deve aparecer entre 
+[3] e [4] vezes</coment> <expr>\s?\$\w+\s?=~\s?\/.*((\\.)\{(\d),(\d)\
+}).*\/</expr>
Replies are listed 'Best First'.
Re: Comment
by mk. (Friar) on Jan 06, 2006 at 13:39 UTC
    as smokemachine had asked, here's the translated code (so non-portuguese speakers can understand what's being printed as well)
    this code is actually for beginners who aim to understand better what's being done on each part of the code. also, soon, it'll also be available for c and shell programs (who knows, someday, for pascal too... hehe).


    /usr/bin/comenta
    #!/usr/bin/perl our %parameters; while($para=shift) { $parameters{$1}=$2 if $para =~ /^--(.+)=(.+)$/; $parameters{file}=$para unless $para =~ /^--(.+)=(.+)$/; } find_language($file) unless our $language=$parameters{language}; our $file=$parameters{file}; our $level=0 unless $level=$parameters{level}; comment_code(); sub comment_code() { open(ARQ, $file) or die "File '$file' not found"; for(<ARQ>){ $lines++; $test=$_; chomp($test); unless($test =~ /^\s*#/) { open(RC, "/etc/comentarios") or die "Configuration file '/ +etc/comments' not found"; for(<RC>){ $_ =~ /<level=(\d)>/; $eni=$1; if($_ =~ /<$language>/i and $eni >= $level) { $_ =~ /<expr>(.+)<\/expr>/; $expre=$1; chomp($expre); $_ =~ /<coment>(.+)<\/coment>/; $comen=$1; chomp($comen); if($test =~ /$expre/) { @vector=split(/\[|\]/, $comen); $i=0; while($vector[$i]){ print $vector[$i].${$vector[$i+1]}; $i+=2; } print "\n"; $comments++; } } } } close RC; print $test."\n"; open(RC, "/etc/comentarios") or die "Configuration file '/ +etc/comments' not found"; for(<RC>){ if($_ =~ /<$language>/i and $_ =~ /<beginning>/i) { $_ =~ /<expr>(.*)<\/expr>/; $expre=$1; chomp($expre); $_ =~ /<coment>(.*)<\/coment>/; $comen=$1; chomp($comen); if($test =~ /$expre/) { @vector=split(/\[|\]/, $comen); $i=0; while($vector[$i]){ print $vector[$i].${$vector[$i+1]}; $i+=2; } print "\n"; $comments++; } } } close RC; } close ARQ; } sub find_language() { ($arq)=@_; $arq=~/.*\.([a-z]{1,2})/; $ext=$1; open(LIN, "/etc/comenta.conf") or die "Configuration file '/etc/co +menta.conf' not found"; for(<LIN>) { $a=$_; chomp($a); our $language=$1 if $a =~ /^(.*)=(\w{1,2},)*$ext,?(\w{1,2},?)* +$/; return() if $a =~ /^(.*)=(\w{1,2},)*$ext,?(\w{1,2},?)*$/; $language="" unless $a =~ /^(.*)=(\w{1,2},)*$ext,?(\w{1,2},?)* +$/; } close LIN; }

    /etc/comentarios
    <C><coment><level=1> # If formula '[1]' is true, it executes the ne +xt commands</coment> <expr>if\((.*)\)\ *\{</expr> <Perl><beginning><coment></coment> <expr>#\!\/usr\/bin\/perl</expr> <Perl><beginning><coment> ######################################### +############## </coment> <expr>#\!\/usr\/bin\/perl</expr> <Perl><beginning><coment> # Code commented by the script 'co +menta' # </coment> <expr>#!/usr/bin/perl</expr> <Perl><beginning><coment> # by Fernando Correa de Olivei +ra # </coment> <expr>#!/usr/bin/perl</expr> <Perl><beginning><coment> ######################################### +############## </coment> <expr>#!/usr/bin/perl</expr> <Perl><beginning><coment></coment> <expr>#!/usr/bin/perl</expr> <Perl><level=1><coment># If formula '[1]' is true, it executes the nex +t commands</coment> <expr>^\s*if\s?\((.*)\)\s*\{?</expr> <Perl><level=1><coment># If formula '[2]' is true, it executes command + '[1]'</coment> <expr>^\s*(.*)\ if\ ?\(?(.*)\)?\s?;</expr> <Perl><level=1><coment># Unless formula '[1]' is true, it executes the + next commands</coment> <expr>^\s*unless\ ?\(?(.*)\)?\ *\{</expr> <Perl><level=1><coment># Unless formula '[2]' is true, it executes com +mand '[1]'</coment> <expr>^\s*(.*)\ unless\ ?\(?(.*)\)?\ *;</expr> <Perl><level=1><coment># While expression '[1]' is true...</coment> <e +xpr>while\s?\((.*)\)\s?\{?</expr> <Perl><level=1><coment># For expression '[1]'</coment> <expr>for\s?\(( +.*)\)\s?\{</expr> <Perl><level=1><coment># '[1]' => the same as: '[2] = [2] + [3]'</come +nt> <expr>((\$\w)+\+=(\d+))</expr> <Perl><level=2><coment># Opens file '[2]' with the handle '[1]'</comen +t> <expr>open\((.*)\ ?\,\ ?(.*)\)</expr> <Perl><level=3><coment># Removes '\n' from the end of variable [1]</co +ment> <expr>chomp\((\$.*)\)</expr> <Perl><level=2><coment># Closes file with the handle '[1]'</coment> <e +xpr>close\(?\ ?(.*)\)?\ ?;</expr> <Sistema><level=1><coment> # User [1] with UID [3] and home [6]</co +ment> <expr>(.*):(x?):(.*):(.*):(.*):(.*):(.*)</expr> <Perl><level=1><coment># For each of the arguments of '[1]' do</coment +> <expr>foreach\ *\((.*)\)\ *{</expr> <Perl><level=1><coment># For [1] being the same as each one of the arg +uments in '[2]' do</coment> <expr>foreach\ *($.*)\ \((.*)\)\ ?{</expr +> <Perl><level=1><coment># '[1]' => from [2] to [3]</coment> <expr>(([0- +9]+)\ ?\.\.\ ?([0-9]+))</expr> <Perl><level=3><coment># '[1]' receives parameter passed on function c +all</coment> <expr>\((\$.*)\)=\@_</expr> <Perl><level=3><coment># [1] => '[2]' receives the first parameter pas +sed on program call, deleting it.</coment> <expr>((\$.*)=shift)</expr +> <Perl><level=1><coment># Declaration of local variable '[1]'</coment> +<expr>my\s*(\$\w*);</expr> <Perl><level=1><coment># Declaration of global variable '[1]'</coment> + <expr>our\s*(\$\w*);</expr> <Perl><level=1><coment># [1] => Declaration of local variable '[2]' co +ntaining '[3]'</coment> <expr>(my\s*(\$\w+)=(.*));</expr> <Perl><level=1><coment># [1] => Declaration of global variable '[2]' c +ontaining '[3]'</coment> <expr>(our\s*(\$\w+)=(.*));</expr> <Perl><level=1><coment># Declaration of local hash '[1]' </coment> <ex +pr>my\s*(\%\w+);</expr> <Perl><level=1><coment># Declaration of global hash '[1]'</coment> <ex +pr>our\s*(\%\w+);</expr> <Perl><level=1><coment># [1] => Value of position '[3]' in hash %[2]</ +coment> <expr>(\$(\w+)\{(.+)\})</expr> <Perl><level=1><coment># return() => Leaves the function</coment> <exp +r>return\ ?\(?\ ?\)?</expr> <Perl><level=1><coment># return([1]) => Leaves the function with '[1]' + as return value</coment> <expr>return\ ?\(?\ (.*)\ ?\)?</expr> <Perl><level=4><coment># As the function already says: Uses module '[1 +]'</coment> <expr>^use\s+(.+);</expr> <Perl><level=5><coment> ############################### Function '[ +1]' #######################</coment> <expr>^\s*sub (\w*\(?\)?)\ *\{?$ +</expr> <Perl><level=3><coment># [1] => Tests regular expression '[3]' in vari +able '[2]'</coment> <expr>\s?((\$\w+)\s?=~\s?(\/.+\/))</expr> <Perl><level=3><coment># [1] => Recognises any type of space, as white +space, tab or line break</coment> <expr>\s?\$\w+\s?=~\s?\/.*(\\s).*\/ +</expr> <Perl><level=3><coment># [1] => Recognises any letter</coment> <expr>\ +s?\$\w+\s?=~\s?\/.*(\\w).*\/</expr> <Perl><level=3><coment># [1] => Recognises any word</coment> <expr>\s? +\$\w+\s?=~\s?\/.*(\\W).*\/</expr> <Perl><level=3><coment># [1] => Recognises any number</coment> <expr>\ +s?\$\w+\s?=~\s?\/.*(\\d).*\/</expr> <Perl><level=3><coment># [1] => Recognises anything between '[2]' and +'[3]'</coment> <expr>\s?\$\w+\s?=~\s?\/.*(\[(\w|\d)\-(\w|\d)\]).*\/</ +expr> <Perl><level=3><coment># [1] => The expression '[2]' must appear betwe +en [3] and [4] times</coment> <expr>\s?\$\w+\s?=~\s?\/.*(([\[|\(].+[\ +]|\)])\{(\d),(\d)\}).*\/</expr> <Perl><level=3><coment># [1] => The expression '[2]' must appear betwe +en [3] and [4] times</coment> <expr>\s?\$\w+\s?=~\s?\/.*((\\.)\{(\d), +(\d)\}).*\/</expr>
    (/etc/comenta.conf remains the same)
    =)


    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    grrr.... argh!
Re: Coment
by TedPride (Priest) on Dec 29, 2005 at 17:03 UTC
    Comment is spelled with two m's.
      Perhaps it's just short for comentário which does only have one m.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://519616]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others studying the Monastery: (7)
As of 2024-04-23 10:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found