1package App::Yath::Plugin::SysInfo;
2use strict;
3use warnings;
4
5our $VERSION = '1.000082';
6
7use Sys::Hostname qw/hostname/;
8use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK CAN_FORK CAN_SIGSYS/;
9use Config qw/%Config/;
10
11use parent 'App::Yath::Plugin';
12use Test2::Harness::Util::HashBase qw/-host_short_pattern/;
13
14sub inject_run_data {
15    my $self  = shift;
16    my %params = @_;
17
18    my $meta   = $params{meta};
19    my $fields = $params{fields};
20
21    my %data = (
22        env => {
23            user  => $ENV{USER},
24            shell => $ENV{SHELL},
25            term  => $ENV{TERM},
26        },
27
28        ipc => {
29            can_fork        => CAN_FORK(),
30            can_really_fork => CAN_REALLY_FORK(),
31            can_thread      => CAN_THREAD(),
32            can_sigsys      => CAN_SIGSYS(),
33        },
34    );
35
36    my ($short, $raw) = ('sys', 'system info');
37
38    if (my $hostname = hostname()) {
39        $short = undef;
40        $data{hostname} = $hostname;
41        $raw = $hostname;
42
43        if (my $pattern = $self->{+HOST_SHORT_PATTERN}) {
44            if ($hostname =~ /($pattern)/) {
45                $short = $1;
46            }
47        }
48
49        unless ($short) {
50            $short = $hostname;
51            $short =~ s/\.[^\.]*$// while length($short) > 18 && $short =~ m/\./;
52        }
53    }
54
55    my @fields = qw/uselongdouble use64bitall version use64bitint usemultiplicity osname useperlio useithreads archname/;
56    @{$data{config}}{@fields} = @Config{@fields};
57
58    push @$fields => {
59        name    => 'sys',
60        details => $short,
61        raw     => $raw,
62        data    => \%data,
63    };
64}
65
66sub TO_JSON { ref($_[0]) }
67
681;
69
70__END__
71
72=pod
73
74=encoding UTF-8
75
76=head1 NAME
77
78App::Yath::Plugin::SysInfo - Plugin to attach system information to a run.
79
80=head1 DESCRIPTION
81
82This plugin attaches a lot of system information to the yath log. This is
83mainly useful if you intend to view the log in L<Test2::Harness::UI>.
84
85=head1 SOURCE
86
87The source code repository for Test2-Harness can be found at
88F<http://github.com/Test-More/Test2-Harness/>.
89
90=head1 MAINTAINERS
91
92=over 4
93
94=item Chad Granum E<lt>exodist@cpan.orgE<gt>
95
96=back
97
98=head1 AUTHORS
99
100=over 4
101
102=item Chad Granum E<lt>exodist@cpan.orgE<gt>
103
104=back
105
106=head1 COPYRIGHT
107
108Copyright 2020 Chad Granum E<lt>exodist7@gmail.comE<gt>.
109
110This program is free software; you can redistribute it and/or
111modify it under the same terms as Perl itself.
112
113See F<http://dev.perl.org/licenses/>
114
115=cut
116