Mercurial > forge
annotate admin/check_INDEX.pl @ 12720:52ca082757c2 octave-forge tip
Update copyright notices.
| author | i7tiol |
|---|---|
| date | Sat, 27 Feb 2016 11:21:29 +0000 |
| parents | 483dd1ed9500 |
| children |
| rev | line source |
|---|---|
| 8389 | 1 #!/usr/bin/perl |
| 2 ## Copyright (C) 2011 Carnë Draug <carandraug+dev@gmail.com> | |
| 3 ## | |
| 4 ## This program is free software; you can redistribute it and/or modify | |
| 5 ## it under the terms of the GNU General Public License as published by | |
| 6 ## the Free Software Foundation; either version 3 of the License, or | |
| 7 ## (at your option) any later version. | |
| 8 ## | |
| 9 ## This program is distributed in the hope that it will be useful, | |
| 10 ## but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 11 ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 12 ## GNU General Public License for more details. | |
| 13 ## | |
| 14 ## You should have received a copy of the GNU General Public License | |
| 15 ## along with this program; if not, see <http://www.gnu.org/licenses/>. | |
| 16 | |
| 17 use 5.010; # Use Perl 5.10 | |
| 18 use strict; # Enforce some good programming rules | |
| 19 use warnings; # Replacement for the -w flag, but lexically scoped | |
| 20 use File::Spec; # Perform operation on file names | |
| 21 | |
| 22 foreach my $package_dir (@ARGV) { | |
| 23 open (INDEX, "<", File::Spec->catfile ($package_dir, "INDEX") ) or die "Could not open INDEX file for read: $!"; | |
| 24 my %functions; | |
| 25 while (my $line = <INDEX>) { | |
| 26 if ($line =~ m/^ (.*)$/) { | |
| 27 my $line = $1; | |
| 28 ## some lines will have more than one function, separated by a space so get them too | |
| 29 my @list = split (/\s/, $line); | |
| 30 $functions{$_} = 1 foreach @list; | |
| 31 ## some lines will have extra whitespace (trailing whitespace) which could be removed | |
| 32 say "Line of '$line' has trailing whitespace" if $line =~ m/\s$/; | |
| 33 ## we only need a space at the start of the line | |
| 34 say "Line of '$line' has extra leading whitespace" if $line =~ m/^\s/; | |
| 35 ## use spaces, not tabs | |
| 36 say "Line of '$line' uses tabs instead of spaces" if $line =~ m/\t/; | |
| 37 } | |
| 38 } | |
| 39 close(INDEX); | |
| 40 my @files; | |
| 41 push (@files, get_files(File::Spec->catfile ($package_dir, 'inst')) ); | |
| 42 push (@files, get_files(File::Spec->catfile ($package_dir, 'src')) ); | |
| 43 clean_array(\@files); | |
| 44 foreach (@files) { | |
| 45 say "'$_' is missing on INDEX" unless delete $functions{$_}; | |
| 46 } | |
| 47 foreach (keys %functions) { | |
| 48 say "'$_' is in the INDEX but there's no file for it"; | |
| 49 } | |
| 50 } | |
| 51 | |
| 52 sub get_files { | |
| 53 my $dirname = $_[0]; | |
|
8415
483dd1ed9500
check_INDEX admin script: do not die when a directory does not exist
carandraug
parents:
8414
diff
changeset
|
54 unless (-e $dirname) { |
|
483dd1ed9500
check_INDEX admin script: do not die when a directory does not exist
carandraug
parents:
8414
diff
changeset
|
55 say "There is no dir $dirname. That may be ok..."; |
|
483dd1ed9500
check_INDEX admin script: do not die when a directory does not exist
carandraug
parents:
8414
diff
changeset
|
56 return; |
|
483dd1ed9500
check_INDEX admin script: do not die when a directory does not exist
carandraug
parents:
8414
diff
changeset
|
57 } |
| 8389 | 58 opendir (DIR, $dirname) or die "Could not opendir $dirname: $!"; |
| 59 my @files; | |
| 60 while (my $file = readdir(DIR)) { | |
| 61 next if $file =~ m/^\.\.?$/; | |
| 62 next if $file eq 'Makefile'; | |
| 63 next if $file =~ m/^\.svn(ignore)?$/; | |
|
8414
2fb8f9b37a1c
check_INDEX admin script: skip private directory
carandraug
parents:
8389
diff
changeset
|
64 next if ($file eq 'private' && -d File::Spec->catfile ($dirname, $file) ); |
| 8389 | 65 $file =~ s/\.m$// if $dirname =~ m/inst$/; |
| 66 $file =~ s/\.c(c)?$// if $dirname =~ m/src$/; | |
| 67 push (@files, $file); | |
| 68 } | |
| 69 closedir(DIR); | |
| 70 return @files; | |
| 71 } | |
| 72 | |
| 73 sub clean_array { | |
| 74 my %hash; | |
| 75 foreach (@{$_[0]}) { | |
| 76 if ($hash{$_}) { | |
| 77 say "Ups! It seems that the function '$_' is repeated (maybe in inst and again in src)"; | |
| 78 } else { | |
| 79 $hash{$_} = 1; | |
| 80 } | |
| 81 } | |
| 82 @{$_[0]} = keys %hash; | |
| 83 } |