Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Perl script commenting assistant

by Wafel (Novice)
on Jul 06, 2003 at 20:13 UTC ( [id://271815]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info Walter Flaat (wafel@wafel.net)
Description: Seeks out interesting tidbits of code and interactively assists in commenting them. The code is ugly though it might come in hande for commenting those old scripts that you've got lying around..
#!/bin/perl -W
##
## Perl script commenting assistant
## Walter Flaat -- wafel@wafel.net (2003)
##
## PURPOSE:
## To assist commenting various tidbits of Perl code. Accounts for ind
+ents.
##
## Arguments:            filein [fileout]
## Expects on STDIN:     answers etc
## Returns to STDOUT:    questions and feedback
## Debug implementation: n/a
## --


# File to proces.. 2nd argument is fileout but defaults to filein
my ($filein, $fileout) = (@ARGV);
die("No file to process") unless $filein;
$fileout ||= $filein;

# Read the script into an array
open (INSCRIPT, "<". $filein) or die $!;
my @line = <INSCRIPT>;
close(INSCRIPT);


# Protect from data-loss.. buffer first
my $output;

# This ignoreNext toggle is needed so we don't comment 
# already commented items
my $ignoreNext;
my $i = 0;
for (@line) {

        # Houston.. we have encountered a perl bangline
        $bang = 1 if /^#!.*perl/;
        # Ignore the next trigger after a comment line.. 
        if (/^##\s+/) {
                $ignoreNext = 1;
                $bang = 0;
        }

        # We don't call the commentors when the trigger is in a commen
+t
        # or when it's been forced into ignorance
        unless ($ignoreNext || /^#/) {
                # Call the commentors
                $output .= scriptcom() if /^\s*$/ && $bang;
                $output .= subcom($i) if /sub\s*\b?\w*\b?\s*\{/;
                $output .= packagecom($i) if /package\s+\b\w+:*\w*\b\s
+*/;
        }
        # After a possible comment run we print out the original line 
+again
        $output .= $_;

        # Below are all the triggers we notice, when one is passed we 
+can 
        # toggle ignoreNext again.. as this was the next.. obviously
        $ignoreNext = 0 if /package|sub|## --/;
        
        $i++;
}

# We're still here... print the output
open (SCRIPT, ">". $fileout) or die $!;
print SCRIPT $output;
close SCRIPT;

## subcom() -- Assist commenting of subroutines
##   Arguments: line nr of infile [n/a]
##   Returns:   scalar comment block
##   Prints:    Max. 10 lines of the sub in question
sub subcom {
        my ($i) = (@_);         # Array item nr that was passed on
        my $ln = $line[$i];     # The scalar in there
        chomp($ln);
        my ($subnm)  = $ln =~ /\s*sub\s+(\w*)/; # Get the name of the 
+sub
        my ($spaces) = $ln =~ /^(\s*).*/;       # Get spaces 
        $subnm ||= "anonymous";
        my $level = 0;
        my $ic = $i;                                       # copy coun
+ter
        print "\n\nSUBROUTINE\n";
        # Show the sub, but no more than 10 lines of it..
        # and don't go past the end of the sub.. EVER
        while ( (@line > $ic) &&  ($i + 10 > $ic) ) {
                $level++ if $line[$ic] =~ /{/;
                $level-- if $line[$ic] =~ /}/;
                print 1+ $ic - $i, " -- ", $line[$ic];
                last unless $level;
                $ic++;
        }
        my $purpose = ask("Purpose of subroutine ". $subnm, 1);
        my $argman =  ask("Mandatory arguments");
        my $argopt =  ask("Optional arguments");
        my $retval =  ask("Return values");
        my $prints =  ask("Prints what");
        return <<EOSUBCOM;
$spaces## $subnm\(\) -- $purpose
$spaces##   Arguments: $argman [$argopt]
$spaces##   Returns:   $retval
$spaces##   Prints:    $prints
EOSUBCOM
}

## scriptcom() -- Assist commenting of Perl script files
##   Arguments: n/a [n/a]
##   Returns:   scalar comment block
##   Prints:    n/a
sub scriptcom {
        $bang = 0;
        my $scriptname = ask("What do you call this script", 1);
        my $purpose    = ask("What purpose does the script have", 1);
        my $argman     = ask("Needs mandatory arguments");
        my $argopt     = ask("Accepts optional arguments");
        my $stdin      = ask("Accepts what from STDIN");
        my $stdout     = ask("Sends what to STDOUT");
        my $debug      = ask("How is debug implemented");
        my $copy       = ask("Who has copyright");
        my $copyyear   = ask("Copyright year(range)");
        return <<EOSCRIPTCOM;
##
## $scriptname
## Copyright $copy ($copyyear)
##
## PURPOSE:
## $purpose
##
## Arguments:            $argman [$argopt]
## Expects on STDIN:     $stdin
## Returns to STDOUT:    $stdout
## Debug implementation: $debug
## --

EOSCRIPTCOM
}

sub packagecom {
        my ($i) = (@_);
        my $ln  = $line[$i];
        chomp($ln);

        my ($packnm) = $ln =~ /package\s+(.*);/;
        print "\n\nPACKAGE: ", $packnm, "\n";
        my $purpose = ask("Summary of purpose", 1);
        my $super   = ask("Superclasses (IS-A)");
        my $sub     = ask("Subclasses");
        my $respon  = ask("Module responsibilities");
        my $collab  = ask("Module collaborates with");
        return <<EOPACKCOM;
## PACKAGE: $packnm
## $purpose
##
## Superclasses (IS-A): $super
## Subclasses:          $sub
## Responsibilities:    $respon
## Collaborations:      $collab
EOPACKCOM
}

## ask() -- Ask questions
##   Arguments: scalar question [mandatory flag]
##   Returns:   scalar answer
##   Prints:    question
sub ask {
        # Question + flag
        my ($q, $mand) = (@_);
        # I hate blocks but they're so damn convenient
        {
                # Non mandatory questions default to [n/a]
                my $na = "";
                $na = " [n/a]" unless $mand;
                print $q, $na, "? ";  # Show me the money! uhh... ques
+tion
                my $ans = <STDIN>;    # Get answer
                chomp($ans);

                # Be annoying..  Re-ask question if no answer came in.
                redo if $mand && $ans =~ /^\s*$/;
                # Return the result
                return "n/a" if $ans =~ /^\s*$/;
                return $ans;
        }
}
Replies are listed 'Best First'.
Re: Perl script commenting assistant
by Limbic~Region (Chancellor) on Jul 06, 2003 at 23:32 UTC
    Wafel,
    I didn't get a chance to review much of your code, but I did see something right at the top that really bothered me. By default, you wipe out the original file prior to completion of the program. If the user aborts the script prematurely or it receives a signal to terminate - their code is mangled.

    As a general piece of advice, you should code as much for input you don't expect as you do for what you do expect. Some people intentionally try to mess things up and other times you are just dealing with "dumb" users. I quoted dumb as it is relative. You know what your code is supposed to do since you wrote it.

    Again, I was busy with other things and didn't get a chance to look at what you have here, but wanted to point this one thing out to you. I am sure someone would be quite upset if they lost their code because they were trying to comment it using your script.

    Cheers - L~R

      You're right of course, guess that's the problem with offering code you wrote for your own use only. It now buffers output first, thanks for the feedback
(jeffa) Re: Perl script commenting assistant
by jeffa (Bishop) on Jul 07, 2003 at 15:10 UTC
    A long time ago, i too used a similar commenting style. Then i started programming in Perl and discovered POD. Sorry, but your code was deprecated long before you posted it ... i recommend you get into POD, it does a much better job of documenting your code. These days i only use single line comments (via #) as minor notes to myself as to why i chose a particular style/solution. Everything else (what the client needs to know) is implemented in POD. Period. That way i can use existing tools to assist.
    use POD or die $!;
    ;)

    jeffa

    L-LL-L--L-LL-L--L-LL-L--
    -R--R-RR-R--R-RR-R--R-RR
    B--B--B--B--B--B--B--B--
    H---H---H---H---H---H---
    (the triplet paradiddle with high-hat)
    

      hehe I do use POD, but not for very small meaningless stuff and POD is ugly when it's scattered throughout your code, If you cluster all the POD, you have to skip back and forward, so I include # blocks with the most vital info, and the POD has the real documentation.

      I suggest you substitute die for warn :-p

        No sweat. Me? i don't scatter pod. I 'cluster' it in one spot - i like mine at the very end. When i need to modify the POD, i use a split-screen mode in my text editor. That way i can see the method i am documenting easily. Remember, you are not suppose to be reading the POD while you are reading the code (i.e., in your text editor), you are suppose be reading POD via a POD viewer (perldoc). Second, small meaningless stuff is not even worthy of comments in the first place, IMHO. I will use a single # comment to put an author's name in if i grab code from the Monastery, but other than that, i don't bother. It is a waste of time. It's hard enough to keep the POD current with the code, why add another layer? (see Re (tilly) 2 (disagree): Another commenting question, for more on that.)

        And while your suggestion of substituting in warn has been duly noted, that final blurb was an 'inside joke', a reference to the infamous use CGI or die; write up. I'll leave it intact, thank you. ;)

        use POD or die $!;

        UPDATE:
        I almost forgot about using POD as multi-line comments. Personally, i think that # comments are the uglier of the two:

        # function: foo # input : bar baz # output : qux # precond : bar and baz are defined # postcond: qux is defined sub foo { }
        versus
        =for comment function: foo input : bar baz output : qux precond : bar and baz are defined postcond: qux is defined =cut sub foo { }
        Two extra lines, but you don't have to worry about prepending #'s. You don't have to have 'valid' POD to create a multi-line comment, by the way. Just a simple =for token to start and =cut to end.

        UPDATE2
        sigh ... you missed my points completely ... did you even read tilly's post?

        jeffa

        L-LL-L--L-LL-L--L-LL-L--
        -R--R-RR-R--R-RR-R--R-RR
        B--B--B--B--B--B--B--B--
        H---H---H---H---H---H---
        (the triplet paradiddle with high-hat)
        

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (7)
As of 2024-03-28 18:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found