The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

RJBS / IPC-Run3-0.049 / lib / IPC / Run3 / ProfLogger.pm 

            

              
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
—
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

              
use strict;
use warnings;
package IPC::Run3::ProfLogger;
our $VERSION = 0.049;
=head1 NAME
IPC::Run3::ProfLogger - write profiling data to a log file
=head1 SYNOPSIS
 use IPC::Run3::ProfLogger;
 my $logger = IPC::Run3::ProfLogger->new;  ## write to "run3.out"
 my $logger = IPC::Run3::ProfLogger->new( Destination => $fn );
 $logger->app_call( \@cmd, $time );
 $logger->run_exit( \@cmd1, @times1 );
 $logger->run_exit( \@cmd1, @times1 );
 $logger->app_exit( $time );
=head1 DESCRIPTION
Used by IPC::Run3 to write a profiling log file.  Does not
generate reports or maintain statistics; its meant to have minimal
overhead.
Its API is compatible with a tiny subset of the other IPC::Run profiling
classes.
=cut
=head1 METHODS
=head2 C<< IPC::Run3::ProfLogger->new( ... ) >>
=cut
sub new {
    my $class = ref $_[0] ? ref shift : shift;
    my $self = bless { @_ }, $class;
    $self->{Destination} = "run3.out"
        unless defined $self->{Destination} && length $self->{Destination};
    open PROFILE, ">$self->{Destination}"
        or die "$!: $self->{Destination}\n";
    binmode PROFILE;
    $self->{FH} = *PROFILE{IO};
    $self->{times} = [];
    return $self;
}
=head2 C<< $logger->run_exit( ... ) >>
=cut
sub run_exit {
    my $self = shift;
    my $fh = $self->{FH};
    print( $fh
        join(
            " ",
            (
                map {
                    my $s = $_;
                    $s =~ s/\\/\\\\/g;
                    $s =~ s/ /_/g;
                    $s;
                } @{shift()}
            ),
            join(
                ",",
                @{$self->{times}},
                @_,
            ),
        ),
        "\n"
    );
}
=head2 C<< $logger->app_exit( $arg ) >>
=cut
sub app_exit {
    my $self = shift;
    my $fh = $self->{FH};
    print $fh "\\app_exit ", shift, "\n";
}
=head2 C<< $logger->app_call( $t, @args) >>
=cut
sub app_call {
    my $self = shift;
    my $fh = $self->{FH};
    my $t = shift;
    print( $fh
        join(
            " ",
            "\\app_call",
            (
                map {
                    my $s = $_;
                    $s =~ s/\\\\/\\/g;
                    $s =~ s/ /\\_/g;
                    $s;
                } @_
            ),
            $t,
        ),
        "\n"
    );
}
=head1 LIMITATIONS
=head1 COPYRIGHT
Copyright 2003, R. Barrie Slaymaker, Jr., All Rights Reserved
=head1 LICENSE
You may use this module under the terms of the BSD, Artistic, or GPL licenses,
any version.
=head1 AUTHOR
Barrie Slaymaker E<lt>barries@slaysys.comE<gt>
=cut
1;