Mercurial > hg > octave-nkf

comparison scripts/mkdoc.pl @ 19129:b0960d4afe5f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
scripts/mkdoc.pl: improve perl code portability. * scripts/mkdoc.pl: make use of File::Spec and Cwd core modules to split and add parts of filepath rather than manually use "/". Use strict and warnings pragma. Have subroutine get_help return empty array instead of empty string. Do not assign to $_.
author Carnë Draug <carandraug@octave.org>
date Thu, 17 Jul 2014 21:53:31 +0100
parents 18e46285a608
children 29fc1736a6be
comparison
equal deleted inserted replaced
19128:18e46285a608 19129:b0960d4afe5f
1 #! /usr/bin/perl -w 1 #! /usr/bin/perl
2 # 2 use utf8;
3
3 # Copyright (C) 2012-2013 Rik Wehbring 4 # Copyright (C) 2012-2013 Rik Wehbring
4 # 5 #
5 # This file is part of Octave. 6 # This file is part of Octave.
6 # 7 #
7 # Octave is free software; you can redistribute it and/or modify it 8 # Octave is free software; you can redistribute it and/or modify it
16 # 17 #
17 # You should have received a copy of the GNU General Public License 18 # You should have received a copy of the GNU General Public License
18 # along with Octave; see the file COPYING. If not, see 19 # along with Octave; see the file COPYING. If not, see
19 # <http://www.gnu.org/licenses/>. 20 # <http://www.gnu.org/licenses/>.
20 21
22 use strict;
23 use warnings;
24 use File::Spec;
25 use Cwd;
26
21 ## Expecting arguments in this order: 27 ## Expecting arguments in this order:
22 ## 28 ##
23 ## SRCDIR SRCDIR-FILES ... -- LOCAL-FILES ... 29 ## SRCDIR SRCDIR-FILES ... -- LOCAL-FILES ...
24 use File::Spec;
25 30
26 unless (@ARGV >= 2) { die "Usage: $0 srcdir m_filename1 ..." ; } 31 unless (@ARGV >= 2) { die "Usage: $0 srcdir m_filename1 ..." ; }
27 32
28 $srcdir = shift (@ARGV) . '/'; 33 my $srcdir = shift (@ARGV);
29 34
30 print <<__END_OF_MSG__; 35 print <<__END_OF_MSG__;
31 ### DO NOT EDIT! 36 ### DO NOT EDIT!
32 ### 37 ###
33 ### This file is generated automatically from Octave source files. 38 ### This file is generated automatically from Octave source files.
34 ### Edit source files directly and run make to update this file. 39 ### Edit source files directly and run make to update this file.
35 40
36 __END_OF_MSG__ 41 __END_OF_MSG__
37 42
38 MFILE: foreach $m_fname (@ARGV) 43 foreach my $m_fname (@ARGV)
39 { 44 {
40 if ($m_fname eq "--") 45 if ($m_fname eq "--")
41 { 46 {
42 $srcdir = "./"; 47 $srcdir = getcwd ();
43 next MFILE; 48 next;
44 } 49 }
45 50
46 $full_fname = $srcdir . $m_fname; 51 my $full_fname = File::Spec->catfile ($srcdir, $m_fname);
47 next MFILE if ((File::Spec->splitdir($full_fname))[-2] eq "private"); 52 my @paths = File::Spec->splitdir ($full_fname);
48 next MFILE unless ( $full_fname =~ m{(.*)/(@|)([^/]*)/(.*)\.m} ); 53 next if @paths < 3
49 if ($2) 54 || $paths[-2] eq "private" # skip private directories
50 { $fcn = "$2$3/$4"; } 55 || $paths[-1] !~ s/\.m$//i; # skip non m files and remove extension
51 else
52 { $fcn = $4; }
53 56
54 @help_txt = gethelp ($fcn, $full_fname); 57 ## @classes will have @class/method as their function name
55 next MFILE if ($help_txt[0] eq ""); 58 my $fcn = $paths[-2] =~ m/^@/ ? File::Spec->catfile (@paths[-2, -1])
59 : $paths[-1];
60
61 my @help_txt = gethelp ($fcn, $full_fname);
62 next unless @help_txt;
56 63
57 print "\x{1d}$fcn\n"; 64 print "\x{1d}$fcn\n";
58 print "\@c $fcn scripts/$m_fname\n"; 65 print "\@c $fcn " . File::Spec->catfile ("scripts", $m_fname) . "\n";
59 66
60 foreach $_ (@help_txt) 67 foreach (@help_txt)
61 { 68 {
62 s/^\s+\@/\@/ unless $in_example; 69 my $in_example = (m/\s*\@example\b/ .. m/\s*\@end\s+example\b/);
63 s/^\s+\@group/\@group/; 70 s/^\s+\@/\@/ unless $in_example;
64 s/^\s+\@end\s+group/\@end group/; 71 s/^\s+(\@(?:end)\s+group)/$1/;
65 $in_example = (/\s*\@example\b/ .. /\s*\@end\s+example\b/); 72 print $_;
66 print $_; 73 }
67 }
68 } 74 }
69 75
70 ################################################################################ 76 ################################################################################
71 # Subroutines 77 # Subroutines
72 ################################################################################ 78 ################################################################################
73 sub gethelp 79 sub gethelp
74 { 80 {
75 ($fcn, $fname) = @_[0..1]; 81 my $fcn = shift;
76 open (FH, $fname) or return ""; 82 my $fname = shift;
83 open (my $fh, "<", $fname) or return;
77 84
78 do 85 my @help_txt;
79 { 86 while (my $line = <$fh>)
80 @help_txt = (); 87 {
88 next if $line =~ m/^\s*$/; # skip empty lines
89 last if $line !~ m/^\s*(#|%)/; # out of here once code starts
81 90
82 ## Advance to non-blank line 91 my $reading_block = sub {defined ($line = <$fh>) && $line !~ m/^\s*$/};
83 while (defined ($_ = <FH>) and /^\s*$/) {;}
84 92
85 if (! /^\s*(?:#|%)/ or eof (FH)) 93 ## Skip this block
86 { 94 if ($line =~ /(Copyright|Author)/)
87 ## No comment block found. Return empty string 95 { while (&$reading_block ()) {} }
88 close (FH); 96 else
89 return ""; 97 {
98 do
99 {
100 $line =~ s/^\s*(%|#)+ ?//;
101 push (@help_txt, $line);
102 } while (&$reading_block ());
103 last;
104 }
90 } 105 }
91 106
92 ## Extract help text stopping when comment block ends 107 close ($fh);
93 do
94 {
95 ## Remove comment characters at start of line
96 s/^\s*(?:#|%){1,2} ?//;
97 push (@help_txt, $_);
98 } until (! defined ($_ = <FH>) or ! /^\s*(?:#|%)/);
99
100 } until ($help_txt[0] !~ /^(?:Copyright|Author)/);
101
102 close (FH);
103
104 return @help_txt; 108 return @help_txt;
105 } 109 }