linux/extract-comments

   1 #!/store/bin/perl
   2
   3 ##
   4 # Lager en tekstlig oppsummering over mange perl-skript basert på
   5 # kommentarer i filene.
   6 # Kjenner igjen følgende variabler: @project, @module, @status,
   7 # @author, @version, @made, @params, @param, @return og @see.
   8 #
   9 # @author  Petter Reinholdtsen <pere@td.org.uit.no>
  10 # @made    1996-07-17
  11 # @version $Id: extract-comments,v 1.1 2003/06/02 13:01:37 pere Exp $
  12 # @project Origo
  13 # @params  [-p <project>] [-m <module>] <files>
  14 # @return  Oppsummering for alle filene
  15 # @module  Utviklingsverktøy
  16 sub about {}
  17
  18 # require "getopts.pl";  # GNU getopts lib
  19
  20 use Getopt::Std;
  21
  22 $debug = "1";
  23
  24 format HEAD =
  25 ~~  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  26     $intro
  27 .
  28
  29 format SUBROUTINE =
  30 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  31 $subroutine
  32 .
  33 format VERSION =
  34   Versjon:     @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  35                $version
  36 .
  37 format PARAMS =
  38   Parametre:   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  39                $params
  40 .
  41 format PARAM =
  42     @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  43     $paramline
  44 .
  45 format RETVAL =
  46   Returnerer:  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  47                $retval
  48 .
  49 format AUTHOR =
  50   Forfatter(e):^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  51 $author
  52 ~              ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  53 $author
  54 .
  55 format DESCRIPTION =
  56 ~~   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  57      $intro
  58 .
  59
  60 format HEADER =
  61 ========================================================================
  62
  63 Fil: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  64      $file
  65   Prosjekt: @<<<<<<<<<<<<<<<<<<<< Modul: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  66             $project,                   $module
  67    Require: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  68             $require
  69       Uses: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  70             $use
  71 .
  72
  73 # &Getopts("pm");
  74 getopts('p:m:f');
  75
  76 @files = @ARGV;
  77
  78 if ($opt_p) {
  79     $def_project = $opt_p;
  80 }
  81 if ($opt_m) {
  82     $def_module = $opt_m;
  83 }
  84
  85
  86 undef %info;
  87 foreach $file (@files) {
  88     if (-f $file && !( $file =~ m%CVS/%)) {
  89         $exec = &parse_perl_file($file);
  90         $exec_status{$file} = $exec;
  91     }
  92 }
  93 &output_info();
  94
  95 ##
  96 # Skriver ut alle filene sortert alfabetisk på prosjekt, modul og
  97 # metode.
  98 sub output_info {
  99     foreach $subroutine (sort keys %info) {
 100         ($project, $module, $file, $method) = split(/;/, $subroutine);
 101         if ($project ne $lastproject || $module ne $lastmodule ||
 102             $file ne $lastfile) {
 103
 104             $lastfile = $file;
 105             $lastproject = $project;
 106             $lastmodule = $module;
 107
 108             $use = $use{$file};
 109             $use =~ s/;/, /g;
 110             $require = $require{$file};
 111             $require =~ s/;/, /g;
 112             $exec = $exec_status{$file};
 113             $file .= " ($exec)" if ($exec);
 114             $~ = "HEADER";
 115             write;
 116             $file = $lastfile;
 117
 118             if ($info{"$project;$module;$file;about"}) {
 119                 ($intro, $authors, $version, $params, $param, $retval)
 120                     =split("\t", delete $info{"$project;$module;$file;about"});
 121                 $~ = "AUTHOR"; # XXX skriver ikke ut noenting
 122                 write if ($authors);
 123
 124                 $~ = "VERSION";
 125                 write if ($version);
 126
 127                 print "\n";
 128                 $~ = "HEAD";
 129                 write;
 130
 131             }
 132             print "\n";
 133         }
 134         next if ( $opt_f || $subroutine =~ m/about$/ );
 135         ($intro, $authors, $version, $params, $param, $retval)
 136             = split("\t", $info{$subroutine});
 137         $subroutine = "$method()";
 138         @authorlist = split(";", $authors);
 139         @author = ();
 140         foreach (@authorlist) {
 141             push(@author, m/([^,]+)/);
 142              }
 143         $author = join(", ", @author);
 144
 145         $~ = "SUBROUTINE";
 146         write;
 147
 148         $~ = "VERSION";
 149         write if ($version);
 150
 151         $~ = "AUTHOR";
 152         write if ($author);
 153
 154         $~ = "DESCRIPTION";
 155         write if ($intro);
 156
 157         $~ = "PARAMS";
 158         write if ($params);
 159
 160         $~ = "PARAM";
 161         foreach $paramline (split(/;/, $param)) {
 162             write;
 163         }
 164
 165         $~ = "RETVAL";
 166         write if ($retval);
 167         print "\n";
 168     }
 169
 170 }
 171
 172 ##
 173 # Leser gjennom en perl-fil og leser ut info fra kommentarene om hver
 174 # enkelt subrutine.  Returnerer %info der nøkkel er
 175 # "prosjekt;modul;subrutinene" og innhold er intro,
 176 # forfatterliste(;-delt) og versjon.
 177 # @return "X" if script is executable - "" if not.
 178
 179 sub parse_perl_file {
 180     &clear_parse_vars();
 181     $project = ($def_project? $def_project: "");
 182     $module  = ($def_module? $def_module: "");
 183     ($file) = @_;
 184     open(FILE, "<$file");
 185     undef $first_line;
 186     undef $subs;
 187     while (<FILE>) {
 188         $first_line = $_ unless ($first_line);
 189         if ( /^##+\s*/ || $running_descrtiption ) {
 190             $running_descrtiption = "1";
 191             if ( ! /^##*\s*\@[^\s,.:]+\s+/  && /^#/ ) {
 192                 ($text) = m/^#+\s*([^#\s]+.*)$/;
 193                 $text =~ s/\t/ /g;
 194                 $intro .= $text." ";
 195             } else {
 196                 $running_descrtiption = "";
 197             }
 198         }
 199         if (! /^#/ ) {
 200             if (/^\s*sub\s+([^\{ ]*)\s*\{*/) {
 201                 $subroutine = $1;
 202                 $subs++;
 203                 if ($intro =~ m/^\s+$/) {
 204                     undef $intro;
 205                 }
 206                 $info{"$project;$module;$file;$subroutine"}
 207                  = join("\t", $intro, join(";",@authors),
 208                         $version,$params,$param,$retval);
 209                 &clear_parse_vars();
 210             }
 211             if (/^\s*require\s+(.*);.*$/) {
 212                 $require{$file} = ($require{$file} ? "$require{$file};$1" : $1);
 213             }
 214             if (/^\s*use\s+(.*);.*$/) {
 215                 $use{$file} = ($use{$file} ? "$use{$file};$1" : $1);
 216             }
 217             next;
 218         }
 219         # Look in all the comments
 220         if (/^#\s*\@author\s+(.*)$/) {
 221             push(@authors, $1);
 222         }
 223         if (/^#\s*\@version\s+(.*)$/) {
 224             $version =  $1;
 225         }
 226         if (/^#\s*\@params\s+(.*)$/) {
 227             $params =  $1;
 228         }
 229         if (/^#\s*\@param\s+(.*)$/) {
 230             $param = ($param ? "$param;$1" : "$1");
 231         }
 232         if (/^#\s*\@return\s*(.*)$/) {
 233             $retval =  $1;
 234         }
 235         if (/^#\s*\@module\s+(.*)$/) {
 236             $module =  $1;
 237         }
 238         if (/^#\s*\@project\s+(.*)$/) {
 239             $project =  $1;
 240         }
 241
 242
 243     }
 244     if (! $subs) {
 245         $info{"$project;$module;$file;about"} = "\t";
 246
 247     }
 248     return ($first_line =~ m%#!/.*/bin/perl%) ? "X" : "";
 249 }
 250 ##
 251 # Blanker ut alle nødvendige variabler mellom hver subrutine.  Kalles
 252 # fra parse_perl_file()
 253 # @see parse_perl_file
 254 sub clear_parse_vars {
 255     undef @authors;
 256     undef $intro;
 257     undef $version;
 258     undef $params;
 259     undef $param;
 260     undef $retval;
 261     undef $running_descrtiption;
 262 }
 263