File: TestReport.pm

package info (click to toggle)
libapache2-mod-perl2 2.0.13-2
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 12,016 kB
  • sloc: perl: 97,771; ansic: 14,493; makefile: 51; sh: 18
file content (104 lines) | stat: -rw-r--r-- 2,865 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
package ModPerl::TestReport;

use strict;
use warnings FATAL => 'all';

use base qw(Apache::TestReportPerl);

use ExtUtils::MakeMaker ();

my @interesting_packages = qw(
    CGI
    ExtUtils::MakeMaker
    Apache2::Request
    mod_perl2
    LWP
    Apache2
    mod_perl
);

# we want to see only already installed packages, so skip over
# modules that are about to be installed
my @skip_dirs = qw(
    blib/lib
    blib/arch
    lib
);
my $skip_dir_str = join '|', map { s|/|[/\\\\]|g; $_ } @skip_dirs;
my $skip_dir_pat = qr|[/\\]($skip_dir_str)[/\\]*$|;

sub packages {

    my @inc = grep !/$skip_dir_pat/, @INC;

    my %packages = ();
    my $max_len = 0;
    for my $package (sort @interesting_packages ) {
        $max_len = length $package if length $package > $max_len;
        my $filename = package2filename($package);
        my @ver = ();
        for my $dir (@inc) {
            my $path = "$dir/$filename";
            if (-e $path) {
                my $ver = MM->parse_version($path);
                # two versions could be installed (one under Apache2/)
                push @{ $packages{$package} }, $ver if $ver;
            }
        }
    }

    my @lines = "*** Packages of interest status:\n";

    for my $package (sort @interesting_packages) {
        my $vers = exists $packages{$package}
            ? join ", ", sort @{ $packages{$package} }
            : "-";
        push @lines, sprintf "%-${max_len}s: %s", $package, $vers;
    }

    return join "\n", @lines, '';
}

sub config {
    my $self = shift;

    my @report = ();

    # core config
    push @report, ModPerl::Config::as_string();

    # installed packages
    push @report, $self->packages;

    # this report is generated by user/group

    return join "\n", @report;
}

sub package2filename {
    my $package = shift;
    $package =~ s|::|/|g;
    $package .= ".pm";
    return $package;
}

sub report_to { 'modperl@perl.apache.org' }


1;