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