1 package DBIx::Class::Carp;
7 use namespace::clean ();
10 my ($skip_pattern, $class) = @_;
12 my $skip_class_data = $class->_skip_namespace_frames
13 if ($class and $class->can('_skip_namespace_frames'));
15 $skip_pattern = qr/$skip_pattern|$skip_class_data/
18 my $fr_num = 1; # skip us and the calling carp*
20 while (@f = caller($fr_num++)) {
21 last unless $f[0] =~ $skip_pattern;
24 my ($ln, $calling) = @f # if empty - nothing matched - full stack
25 ? ( "at $f[1] line $f[2]", $f[3] )
26 : ( Carp::longmess(), '{UNKNOWN}' )
31 $calling =~ /::/ ? "$calling(): " : "$calling: ", # cargo-cult from Carp::Clan
37 @warn = "Warning: something's wrong" unless @warn;
39 # back-compat with Carp::Clan - a warning ending with \n does
40 # not include caller info
43 $warn[-1] =~ /\n$/ ? '' : " $ln\n"
49 *__BROKEN_NC = ($] < 5.008003)
55 my (undef, $skip_pattern) = @_;
58 $skip_pattern = $skip_pattern
59 ? qr/ ^ $into $ | $skip_pattern /xo
65 *{"${into}::carp"} = sub {
67 __find_caller($skip_pattern, $into),
73 *{"${into}::carp_once"} = sub {
78 __find_caller($skip_pattern, $into),
84 *{"${into}::carp_unique"} = sub {
85 my ($ln, $calling) = __find_caller($skip_pattern, $into);
86 my $msg = join ('', $calling, @_);
88 # unique carping with a hidden caller makes no sense
91 return if $seen->{$ln}{$msg};
92 $seen->{$ln}{$msg} = 1;
100 # cleanup after ourselves
101 namespace::clean->import(-cleanee => $into, qw/carp carp_once carp_unique/)
102 ## FIXME FIXME FIXME - something is tripping up V::M on 5.8.1, leading
103 # to segfaults. When n::c/B::H::EndOfScope is rewritten in terms of tie()
104 # see if this starts working
105 unless __BROKEN_NC();
109 die (__PACKAGE__ . " does not implement unimport yet\n");
116 DBIx::Class::Carp - Provides advanced Carp::Clan-like warning functions for DBIx::Class internals
120 Documentation is lacking on purpose - this an experiment not yet fit for
121 mass consumption. If you use this do not count on any kind of stability,
122 in fact don't even count on this module's continuing existence (it has
123 been noindexed for a reason).
125 In addition to the classic interface:
127 use DBIx::Class::Carp '^DBIx::Class'
129 this module also supports a class-data based way to specify the exclusion
130 regex. A message is only carped from a callsite that matches neither the
131 closed over string, nor the value of L</_skip_namespace_frames> as declared
132 on the B<first> callframe origin.
134 =head1 CLASS ATTRIBUTES
136 =head2 _skip_namespace_frames
138 A classdata attribute holding the stringified regex matching callsites that
139 should be skipped by the carp methods below. An empty string C<q{}> is treated
140 like no setting/C<undef> (the distinction is necessary due to semantics of the
141 class data accessors provided by L<Class::Accessor::Grouped>)
143 =head1 EXPORTED FUNCTIONS
145 This module export the following 3 functions. Only warning related C<carp*>
146 is being handled here, for C<croak>-ing you must use
147 L<DBIx::Class::Schema/throw_exception> or L<DBIx::Class::Exception>.
151 Carps message with the file/line of the first callsite not matching
152 L</_skip_namespace_frames> nor the closed-over arguments to
153 C<use DBIx::Class::Carp>.
157 Like L</carp> but warns once for every distinct callsite (subject to the
158 same ruleset as L</carp>).
162 Like L</carp> but warns only once for the life of the perl interpreter
163 (regardless of callsite).