Add GPL license plate to SGI's files.
[xfstests-dev.git] / lsqa.pl
1 #!/usr/bin/perl -w
2 #
3 # Copyright (c) 2008 Silicon Graphics, Inc.  All Rights Reserved.
4 #
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.
8 #
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.
13 #
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
17 #
18 use strict;
19
20 use Getopt::Long;
21
22 sub help();
23 sub get_qa_header($);
24 sub get_qa_tests();
25
26 my %opt;
27
28 my @oa = (
29     ['--help|?',     "Show this help message.",
30      \$opt{'help'}],
31     ['--head|h',     "Shows only the head of the QA test",
32     \$opt{'head'}],
33     ['--body|b',     "Shows only the body of the QA test.",
34     \$opt{'body'}],
35     ['--one-line|1', "Output everything on a single line.",
36     \$opt{'oneline'}],
37     );
38
39 # black magic
40 GetOptions(map { @{$_}[0] => @{$_}[2] } @oa);
41
42 if ($opt{'help'}) {
43     die help();
44 }
45
46 my @qatests = map {sprintf("%03d", $_)} @ARGV;
47 @qatests = get_qa_tests() unless (@qatests);
48
49 foreach (@qatests) {
50     my @h = get_qa_header($_);
51
52     if ($opt{'head'}) {
53         @h = shift @h;
54     } elsif ($opt{'body'}) {
55         shift @h;
56         shift @h
57     }
58
59     if ($opt{'oneline'}) {
60         print map {s/\n/ /; $_} @h;
61         print "\n";
62     } else {
63         print @h;
64     }
65
66     print "--------------------------------------------------\n" unless (@qatests < 2);
67 }
68
69 sub help() {
70     my $sa = '';
71     foreach (@oa) {
72         #       local $_ = @{$_}[0];
73         @{$_}[0] =~ s/=(.*)$//;
74         @{$_}[0] =~ s/\|/ \| -/;
75         @{$_}[0] =~ s/^/\[ /;
76         @{$_}[0] =~ s/$/ \] /;
77         $sa .= @{$_}[0];
78     }
79
80     print "Usage: $0\t$sa\n";
81     foreach (@oa) {
82         $$_[0] =~ s/\|/\t\|/;
83         print "\t$$_[0]\t$$_[1]\n";
84     }
85 }
86
87 sub get_qa_header($) {
88     my $f = shift || die "need an argument";
89     my @l;
90
91     open(my $FH, $f) || die "couldn't open '$f': $!";
92     while (<$FH>) {
93         #ignore.
94         m/^#\!/                 and next; #shebang
95         m/^#\s*\-{10}/          and last; #dashed lines
96         m/^#\s*copyright/i      and last; #copyright lines
97
98         s/^# *//;
99
100         push @l, $_;
101     }
102     close($FH);
103     return @l;
104 }
105
106 sub get_qa_tests() {
107     my $d = shift || $ENV{'PWD'};
108
109     opendir(my $DIR, $d) || die "can't opendir $d: $!";
110     my @qa = grep {m/^\d\d\d$/ && -f "$d/$_" } readdir($DIR);
111     closedir($DIR);
112
113     return @qa;
114 }
115