3 # Copyright (c) 2008 Silicon Graphics, Inc. All Rights Reserved.
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License as
7 # published by the Free Software Foundation.
9 # This program is distributed in the hope that it would 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.
14 # You should have received a copy of the GNU General Public License
15 # along with this program; if not, write the Free Software Foundation,
16 # Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19 # Print headers of given tests
20 # Accepted parameter types:
21 # - nothing - list all tests from all subdirectories in tests/*
22 # - tests/DIR - list all tests from DIR
23 # - tests/DIR/123 - show header from single test
36 ['--help|?', "Show this help message.",
38 ['--head|h', "Shows only the head of the QA test",
40 ['--body|b', "Shows only the body of the QA test.",
42 ['--one-line|1', "Output everything on a single line.",
47 GetOptions(map { @{$_}[0] => @{$_}[2] } @oa);
58 map { push @qatests,get_qa_tests("$d/$_") if -d "$d/$_" } readdir(DIR);
63 push @qatests,$_ if -f && /\d{3}$/;
64 push @qatests,get_qa_tests($_) if -d;
68 my @h = get_qa_header($_);
72 } elsif ($opt{'body'}) {
77 if ($opt{'oneline'}) {
78 print map {s/\n/ /; $_} @h;
84 print "--------------------------------------------------\n" unless (@qatests < 2);
90 # local $_ = @{$_}[0];
91 @{$_}[0] =~ s/=(.*)$//;
92 @{$_}[0] =~ s/\|/ \| -/;
94 @{$_}[0] =~ s/$/ \] /;
98 print "Usage: $0\t$sa\n";
100 $$_[0] =~ s/\|/\t\|/;
101 print "\t$$_[0]\t$$_[1]\n";
105 sub get_qa_header($) {
106 my $f = shift || die "need an argument";
109 open(my $FH, $f) || die "couldn't open '$f': $!";
112 m/^#\!/ and next; #shebang
113 m/^#\s*\-{10}/ and last; #dashed lines
114 m/^#\s*copyright/i and last; #copyright lines
125 my $d = shift || $ENV{'PWD'};
127 opendir(my $DIR, $d) || die "can't opendir $d: $!";
128 my @qa = sort grep { m/^\d\d\d$/ && -f "$d/$_" } readdir($DIR);
130 return map { $_ = "$d/$_" } @qa;