5978321176

Committed 25 Aug 2023 04:39PM UTC coverage: 91.902% (-0.3%) from 92.179%

Build # 5978321176

Build Type

push

github

Committed by

jjatria

Commit Message

Avoid setting undefined attributes from DBI integration

Run Details

5 of 5 new or added lines in 1 file covered. (100.0%)

715 of 778 relevant lines covered (91.9%)

6.0 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

47.25

/lib/OpenTelemetry/Integration/namespace.pm

package OpenTelemetry::Integration::namespace;
# ABSTRACT: OpenTelemetry integration for a namespace

our $VERSION = '0.001';

use strict;
use warnings;
use experimental 'signatures';

use Carp 'croak';
use Class::Inspector;
use Class::Method::Modifiers 'install_modifier';
use Feature::Compat::Defer;
use List::Util 'any';
use OpenTelemetry::Constants qw( SPAN_KIND_CLIENT SPAN_STATUS_ERROR SPAN_STATUS_OK );
use OpenTelemetry;
use Ref::Util 'is_arrayref';
use Module::Load;
use Devel::Peek;

use parent 'OpenTelemetry::Integration';

use constant {
    IS_TRACE => 0,
    IS_DEBUG => 0,
};

my ( %INSTALLED, $loaded );
sub uninstall ( $class ) {
    return unless $loaded;
    no strict 'refs';
    no warnings 'redefine';
    for my $package ( keys %INSTALLED ) {
        for my $sub ( keys %{ $INSTALLED{ $package } // {} } ) {
            delete $Class::Method::Modifiers::MODIFIER_CACHE{$package}{$sub};
            *{ $package . '::' . $sub } = delete $INSTALLED{$package}{$sub};
        }
    }
    undef $loaded;
    return;
}

my $parse_rules = sub ( $config ) {
    my ( $paths, $subroutines, $subpackages );

    if ( my @list = @{ $config->{paths} // [] } ) {
        $paths = '^(:?' . join( '|', map quotemeta, @list ) . ')';
        $paths = qr/$paths/;

        if ( IS_DEBUG ) {
            warn "Paths:\n";
            warn "- $_\n" for @list;
        }
    }

    if ( my %map = %{ $config->{subroutines} // {} } ) {
        while ( my ( $k, $v ) = each %map ) {
            @{ $subroutines->{$k} }{ @$v } = 1;
        }

        if ( IS_DEBUG ) {
            warn "Subroutines:\n";
            for my $k ( sort keys %{ $subroutines } ) {
                warn "- ${k}::$_\n" for sort keys %{ $subroutines->{$k} };
            }
        }
    }

    if ( my %map = %{ $config->{subpackages} // {} } ) {
        while ( my ( $k, $v ) = each %map ) {
            @{ $subpackages->{$k} }{ @$v } = 1;
        }

        if ( IS_DEBUG ) {
            warn "Subpackages:\n";
            for my $k ( sort keys %{ $subpackages } ) {
                warn "- ${k}:\n";
                warn "  - $_\n" for sort keys %{ $subpackages->{$k} };
            }
        }
    }

    ( paths => $paths, subroutines => $subroutines, subpackages => $subpackages )
};

sub install ( $class, %config ) {
    return if $loaded;

    my $package = $config{package};
    #     or croak 'Cannot automatically instrument OpenTelemetry without a package name';

    my %include = $parse_rules->( $config{include} );
    my %exclude = $parse_rules->( $config{exclude} );

    my $install_wrappers = sub ($package) {
        my $subs = namespace::clean->get_functions($package);

        while ( my ( $subname, $coderef ) = each %$subs ) {
            my $fullname = "${package}::$subname";

            # Skip functions we've already wrapped
            next if $INSTALLED{$package}{$subname};

            # If we are explicitly including this subroutine
            # none of the other checks matter
            if ( $include{subroutines}{$package}{$subname} ) {
                warn "Including $fullname explicitly" if IS_TRACE;
            }
            else {
                # Otherwise, perform all other additional checks
                next
                    # Skip packages we only included for some subs
                    if %{ $include{subroutines}{$package} // {} }
                    # Skip import and unimport
                    || $subname =~ /^(?:un)?import$/
                    # Skip uppercase functions
                    || uc($subname) eq $subname
                    # Skip "private" functions
                    || $subname =~ /^_/
                    # Skip subroutines we are explicitly excluding
                    || $exclude{subroutines}{$package}{$subname};

                # Skip imported functions.
                # See https://stackoverflow.com/a/3685262/807650
                if ( my $gv = Devel::Peek::CvGV($coderef) ) {
                    if ( *$gv{PACKAGE} ne $package ) {
                        warn "$package has dirty namespace ($subname)\n" if IS_TRACE;
                        next;
                    }
                }

                if ( defined prototype $coderef ) {
                    warn "Not wrapping $fullname because it has a prototype\n" if IS_TRACE;
                    next;
                }
            }

            $INSTALLED{$package}{$subname} = 1;

            install_modifier $package => around => $subname => sub {
                my ( $orig, $self, @rest ) = @_;
                OpenTelemetry->tracer_provider->tracer(
                    name    => __PACKAGE__,
                    version => $VERSION,
                )->in_span(
                    "${package}::$subname" => (
                        attributes => {
                            'code.function'  => $subname,
                            'code.namespace' => $package,
                        },
                    ),
                    sub { $self->$orig(@rest) },
                );
            };

            warn "Wrapped ${package}::$subname\n" if IS_TRACE;
        }
    };

    my $wrap = sub ($module) {
        return if
            lc $module eq $module   # pragma
            || $module =~ /^[0-9]/; # version

        my $filename = $INC{$module} or return;

        my $package = $module =~ s/\//::/gr;
        $package =~ s/\.p[ml]$//;

        return if exists $INSTALLED{$package};
        $INSTALLED{$package} = {};

        if ( my $data = $include{subpackages}{$package} ) {
            # If this package has any subpackages that we are interested
            # in wrapping, wrap those as well
            $install_wrappers->($_) for keys %$data;
        }

        # If we are specifically including any subroutine in this
        # package, then we cannot skip it wholesale
        unless ( $include{subroutines}{$package} ) {
            $package =~ /^::/ and do {
                warn "Skipping $package because it is not a package\n" if IS_TRACE;
                return;
            };

            $package =~ /^OpenTelemetry/ and do {
                warn "Skipping $package because it is ourselves\n" if IS_TRACE;
                return;
            };

            # TODO
            $package =~ /^(?:B|Exporter|Test2|Plack|XSLoader)(?:::|$)/ and do {
                warn "Skipping $package because it is not currently supported\n" if IS_TRACE;
                return;
            };

            $include{paths} && $filename !~ $include{paths} and do {
                warn "Skipping $package because it is not in include paths\n" if IS_TRACE;
                return;
            };

            $exclude{paths} && $filename =~ $exclude{paths} and do {
                warn "Skipping $package because it is in exclude paths\n" if IS_TRACE;
                return;
            };
        }

        $install_wrappers->($package);
    };

    $wrap->($_) for keys %INC;

    my $old_hook = ${^HOOK}{require__before};
    ${^HOOK}{require__before} = sub {
        my ($name) = @_;

        my $return;
        $return = $old_hook->($name) if $old_hook;

        return sub {
            $return->() if ref $return && reftype $return eq 'CODE';
            $wrap->($name);
        };
    };

    return $loaded = 1;
}

1;

__END__

=encoding utf8

=head1 NAME

OpenTelemetry::Integration::namespace - OpenTelemetry integration for a namespace

=head1 SYNOPSIS

    # This integration is EXPERIMENTAL

    use OpenTelemetry::Integration 'namespace' => {
        include => {
            paths => [(
                lib/Local
            )],
        },
        exclude => {
            paths => [qw(
                lib/Local/Secret
            )],
            subroutines => {
                'Some::Package' => [qw(
                    low_level
                )],
            },
        },
    };

=head1 DESCRIPTION

See L<OpenTelemetry::Integration> for more details.

Since this is a core module, it's included in the L<OpenTelemetry> core
distribution as well.

=head1 CONFIGURATION

=head2 include / exclude

The C<include> and C<exclude> sections control the package and subroutines
that are considered to be relevant by the monitoring code. Fields in the
C<exclude> section take precedence.

=head3 paths

This field should be set to list of literal paths or path segments. Any code
that is loaded from those paths will be included or excluded depending on what
section this was under.

For example:

    include => {
        paths => [qw(
            lib/Local
            lib/Test
        )],
    },
    exclude => {
        paths => [qw(
            lib/Local/Secret
        )],
    },

would make all the code that is loaded from C<lib/Local> and C<lib/Test>,
except the code loaded from C<lib/Local/Secret>, relevant for monitoring.

=head3 subpackages

Perl allows multiple packages to be defined inside the same file, so that
importing one file makes all of those packages available, without the
subpackages ever being explicitly loaded. Under normal circumstances, this
makes these packages invisible to the approach in this integration.

This key makes it possible to specify packages that should be wrapped for
monitoring whenever we detect another packages being loaded.

This field should be set to a hash where the keys are package names and
the values are lists of packages to be wrapped whenever the parent is.

For example:

    include => {
        subpackages => {
            'Local::Foo' => [qw(
                Local::Foo::Bar
            )],
        },
    },

This mapping has no meaning under C<exclude>, and is ignored in that case.

=head3 subroutines

In some cases, some specific subroutines are of interest even though they
are defined in packages that would otherwise not be eligible for reporting.

This field makes it possible to mark those subroutines as explicitly
relevant or irrelevant depending on the section this is under. If under
C<include>, these subroutines will always be wrapped; while under C<exclude>
they will I<never> be.

This field should be set to a hash where the keys are package names and
the values are lists of subroutine names.

For example:

    include => {
        subroutines => {
            'Local::Splines' => [qw(
                reticulate
            )],
        },
    },
    exclude => {
        subroutines => {
            'Local::Splines' => [qw(
                frobligate
            )],
        },
    },

This would make C<Local::Splines::reticulate> I<always> be wrapped, even
if C<Local::Splines> was loaded from a path that was not otherwise
specified as relevant. Likewise, C<Local::Splines::frobligate> would never
be wrapped, even if C<Local::Splines> was marked as relevant through some
other method.

=head1 COPYRIGHT

...

1	package OpenTelemetry::Integration::namespace;
2	# ABSTRACT: OpenTelemetry integration for a namespace
3
4	our $VERSION = '0.001';
5
6	use strict;	1✔
7	use warnings;	1✔
8	use experimental 'signatures';	1✔
9
10	use Carp 'croak';	1✔
11	use Class::Inspector;	1✔
12	use Class::Method::Modifiers 'install_modifier';	1✔
13	use Feature::Compat::Defer;	1✔
14	use List::Util 'any';	1✔
15	use OpenTelemetry::Constants qw( SPAN_KIND_CLIENT SPAN_STATUS_ERROR SPAN_STATUS_OK );	1✔
16	use OpenTelemetry;	1✔
17	use Ref::Util 'is_arrayref';	1✔
18	use Module::Load;	1✔
19	use Devel::Peek;	1✔
20
21	use parent 'OpenTelemetry::Integration';	1✔
22
23	use constant {
24	IS_TRACE => 0,	1✔
25	IS_DEBUG => 0,
26	};	1✔
27
28	my ( %INSTALLED, $loaded );
29	sub uninstall ( $class ) {	×
30	return unless $loaded;	×
31	no strict 'refs';	1✔
32	no warnings 'redefine';	1✔
33	for my $package ( keys %INSTALLED ) {	×
34	for my $sub ( keys %{ $INSTALLED{ $package } // {} } ) {	×
35	delete $Class::Method::Modifiers::MODIFIER_CACHE{$package}{$sub};	×
36	*{ $package . '::' . $sub } = delete $INSTALLED{$package}{$sub};	×
37	}
38	}
39	undef $loaded;	×
40	return;	×
41	}
42
43	my $parse_rules = sub ( $config ) {
44	my ( $paths, $subroutines, $subpackages );
45
46	if ( my @list = @{ $config->{paths} // [] } ) {
47	$paths = '^(:?' . join( '\|', map quotemeta, @list ) . ')';
48	$paths = qr/$paths/;
49
50	if ( IS_DEBUG ) {
51	warn "Paths:\n";
52	warn "- $_\n" for @list;
53	}
54	}
55
56	if ( my %map = %{ $config->{subroutines} // {} } ) {
57	while ( my ( $k, $v ) = each %map ) {
58	@{ $subroutines->{$k} }{ @$v } = 1;
59	}
60
61	if ( IS_DEBUG ) {
62	warn "Subroutines:\n";
63	for my $k ( sort keys %{ $subroutines } ) {
64	warn "- ${k}::$_\n" for sort keys %{ $subroutines->{$k} };
65	}
66	}
67	}
68
69	if ( my %map = %{ $config->{subpackages} // {} } ) {
70	while ( my ( $k, $v ) = each %map ) {
71	@{ $subpackages->{$k} }{ @$v } = 1;
72	}
73
74	if ( IS_DEBUG ) {
75	warn "Subpackages:\n";
76	for my $k ( sort keys %{ $subpackages } ) {
77	warn "- ${k}:\n";
78	warn " - $_\n" for sort keys %{ $subpackages->{$k} };
79	}
80	}
81	}
82
83	( paths => $paths, subroutines => $subroutines, subpackages => $subpackages )
84	};
85
86	sub install ( $class, %config ) {	1✔
87	return if $loaded;	1✔
88
89	my $package = $config{package};	1✔
90	# or croak 'Cannot automatically instrument OpenTelemetry without a package name';
91
92	my %include = $parse_rules->( $config{include} );	1✔
93	my %exclude = $parse_rules->( $config{exclude} );	1✔
94
95	my $install_wrappers = sub ($package) {	1✔
96	my $subs = namespace::clean->get_functions($package);	1✔
97
98	while ( my ( $subname, $coderef ) = each %$subs ) {	×
99	my $fullname = "${package}::$subname";	×
100
101	# Skip functions we've already wrapped
102	next if $INSTALLED{$package}{$subname};	×
103
104	# If we are explicitly including this subroutine
105	# none of the other checks matter
106	if ( $include{subroutines}{$package}{$subname} ) {	×
107	warn "Including $fullname explicitly" if IS_TRACE;	×
108	}
109	else {
110	# Otherwise, perform all other additional checks
111	next
112	# Skip packages we only included for some subs
113	if %{ $include{subroutines}{$package} // {} }	×
114	# Skip import and unimport
115	\|\| $subname =~ /^(?:un)?import$/
116	# Skip uppercase functions
117	\|\| uc($subname) eq $subname
118	# Skip "private" functions
119	\|\| $subname =~ /^_/
120	# Skip subroutines we are explicitly excluding
121	\|\| $exclude{subroutines}{$package}{$subname};	×
122
123	# Skip imported functions.
124	# See https://stackoverflow.com/a/3685262/807650
125	if ( my $gv = Devel::Peek::CvGV($coderef) ) {	×
126	if ( *$gv{PACKAGE} ne $package ) {	×
127	warn "$package has dirty namespace ($subname)\n" if IS_TRACE;	×
128	next;	×
129	}
130	}
131
132	if ( defined prototype $coderef ) {	×
133	warn "Not wrapping $fullname because it has a prototype\n" if IS_TRACE;	×
134	next;	×
135	}
136	}
137
138	$INSTALLED{$package}{$subname} = 1;	×
139
140	install_modifier $package => around => $subname => sub {
141	my ( $orig, $self, @rest ) = @_;	×
142	OpenTelemetry->tracer_provider->tracer(
143	name => __PACKAGE__,
144	version => $VERSION,
145	)->in_span(
146	"${package}::$subname" => (
147	attributes => {
148	'code.function' => $subname,
149	'code.namespace' => $package,
150	},
151	),
152	sub { $self->$orig(@rest) },	×
153	);	×
154	};	×
155
156	warn "Wrapped ${package}::$subname\n" if IS_TRACE;	×
157	}
158	};	1✔
159
160	my $wrap = sub ($module) {	1✔
161	return if
162	lc $module eq $module # pragma	1✔
163	\|\| $module =~ /^[0-9]/; # version
164
165	my $filename = $INC{$module} or return;	1✔
166
167	my $package = $module =~ s/\//::/gr;	1✔
168	$package =~ s/\.p[ml]$//;	1✔
169
170	return if exists $INSTALLED{$package};	1✔
171	$INSTALLED{$package} = {};	1✔
172
173	if ( my $data = $include{subpackages}{$package} ) {	1✔
174	# If this package has any subpackages that we are interested
175	# in wrapping, wrap those as well
176	$install_wrappers->($_) for keys %$data;	×
177	}
178
179	# If we are specifically including any subroutine in this
180	# package, then we cannot skip it wholesale
181	unless ( $include{subroutines}{$package} ) {	1✔
182	$package =~ /^::/ and do {	1✔
183	warn "Skipping $package because it is not a package\n" if IS_TRACE;	×
184	return;	×
185	};
186
187	$package =~ /^OpenTelemetry/ and do {	1✔
188	warn "Skipping $package because it is ourselves\n" if IS_TRACE;	×
189	return;	×
190	};
191
192	# TODO
193	$package =~ /^(?:B\|Exporter\|Test2\|Plack\|XSLoader)(?:::\|$)/ and do {	1✔
194	warn "Skipping $package because it is not currently supported\n" if IS_TRACE;	×
195	return;	×
196	};
197
198	$include{paths} && $filename !~ $include{paths} and do {	1✔
199	warn "Skipping $package because it is not in include paths\n" if IS_TRACE;	×
200	return;	×
201	};
202
203	$exclude{paths} && $filename =~ $exclude{paths} and do {	1✔
204	warn "Skipping $package because it is in exclude paths\n" if IS_TRACE;	×
205	return;	×
206	};
207	}
208
209	$install_wrappers->($package);	1✔
210	};	1✔
211
212	$wrap->($_) for keys %INC;	1✔
213
214	my $old_hook = ${^HOOK}{require__before};	×
215	${^HOOK}{require__before} = sub {
216	my ($name) = @_;	×
217
218	my $return;	×
219	$return = $old_hook->($name) if $old_hook;	×
220
221	return sub {
222	$return->() if ref $return && reftype $return eq 'CODE';	×
223	$wrap->($name);	×
224	};	×
225	};	×
226
227	return $loaded = 1;	×
228	}
229
230	1;
231
232	__END__
233
234	=encoding utf8
235
236	=head1 NAME
237
238	OpenTelemetry::Integration::namespace - OpenTelemetry integration for a namespace
239
240	=head1 SYNOPSIS
241
242	# This integration is EXPERIMENTAL
243
244	use OpenTelemetry::Integration 'namespace' => {
245	include => {
246	paths => [(
247	lib/Local
248	)],
249	},
250	exclude => {
251	paths => [qw(
252	lib/Local/Secret
253	)],
254	subroutines => {
255	'Some::Package' => [qw(
256	low_level
257	)],
258	},
259	},
260	};
261
262	=head1 DESCRIPTION
263
264	See L<OpenTelemetry::Integration> for more details.
265
266	Since this is a core module, it's included in the L<OpenTelemetry> core
267	distribution as well.
268
269	=head1 CONFIGURATION
270
271	=head2 include / exclude
272
273	The C<include> and C<exclude> sections control the package and subroutines
274	that are considered to be relevant by the monitoring code. Fields in the
275	C<exclude> section take precedence.
276
277	=head3 paths
278
279	This field should be set to list of literal paths or path segments. Any code
280	that is loaded from those paths will be included or excluded depending on what
281	section this was under.
282
283	For example:
284
285	include => {
286	paths => [qw(
287	lib/Local
288	lib/Test
289	)],
290	},
291	exclude => {
292	paths => [qw(
293	lib/Local/Secret
294	)],
295	},
296
297	would make all the code that is loaded from C<lib/Local> and C<lib/Test>,
298	except the code loaded from C<lib/Local/Secret>, relevant for monitoring.
299
300	=head3 subpackages
301
302	Perl allows multiple packages to be defined inside the same file, so that
303	importing one file makes all of those packages available, without the
304	subpackages ever being explicitly loaded. Under normal circumstances, this
305	makes these packages invisible to the approach in this integration.
306
307	This key makes it possible to specify packages that should be wrapped for
308	monitoring whenever we detect another packages being loaded.
309
310	This field should be set to a hash where the keys are package names and
311	the values are lists of packages to be wrapped whenever the parent is.
312
313	For example:
314
315	include => {
316	subpackages => {
317	'Local::Foo' => [qw(
318	Local::Foo::Bar
319	)],
320	},
321	},
322
323	This mapping has no meaning under C<exclude>, and is ignored in that case.
324
325	=head3 subroutines
326
327	In some cases, some specific subroutines are of interest even though they
328	are defined in packages that would otherwise not be eligible for reporting.
329
330	This field makes it possible to mark those subroutines as explicitly
331	relevant or irrelevant depending on the section this is under. If under
332	C<include>, these subroutines will always be wrapped; while under C<exclude>
333	they will I<never> be.
334
335	This field should be set to a hash where the keys are package names and
336	the values are lists of subroutine names.
337
338	For example:
339
340	include => {
341	subroutines => {
342	'Local::Splines' => [qw(
343	reticulate
344	)],
345	},
346	},
347	exclude => {
348	subroutines => {
349	'Local::Splines' => [qw(
350	frobligate
351	)],
352	},
353	},
354
355	This would make C<Local::Splines::reticulate> I<always> be wrapped, even
356	if C<Local::Splines> was loaded from a path that was not otherwise
357	specified as relevant. Likewise, C<Local::Splines::frobligate> would never
358	be wrapped, even if C<Local::Splines> was marked as relevant through some
359	other method.
360
361	=head1 COPYRIGHT
362
363	...

jjatria / perl-opentelemetry / 5978321176

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous