1 package # hide from pause
7 # This is here instead of DBIx::Class because of load-order issues
9 # something is tripping up V::M on 5.8.1, leading to segfaults.
10 # A similar test in n::c itself is disabled on 5.8.1 for the same
11 # reason. There isn't much motivation to try to find why it happens
12 *DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN = ($] < 5.008005)
18 # load Carp early to prevent tickling of the ::Internal stash being
19 # interpreted as "Carp is already loaded" by some braindead loader
21 $Carp::Internal{ (__PACKAGE__) }++;
24 my ($skip_pattern, $class) = @_;
26 my $skip_class_data = $class->_skip_namespace_frames
27 if ($class and $class->can('_skip_namespace_frames'));
29 $skip_pattern = qr/$skip_pattern|$skip_class_data/
32 my $fr_num = 1; # skip us and the calling carp*
35 while (@f = caller($fr_num++)) {
38 ( $f[3] eq '(eval)' or $f[3] =~ /::__ANON__$/ );
41 $f[3] =~ /^ (.+) :: ([^\:]+) $/x
45 #############################
46 # Need a way to parameterize this for Carp::Skip
47 $1 !~ /^(?: DBIx::Class::Storage::BlockRunner | Context::Preserve | Try::Tiny | Class::Accessor::Grouped | Class::C3::Componentised | Module::Runtime )$/x
49 $2 !~ /^(?: throw_exception | carp | carp_unique | carp_once | dbh_do | txn_do | with_deferred_fk_checks)$/x
50 #############################
54 $f[0]->can('_skip_namespace_frames')
56 my $extra_skip = $f[0]->_skip_namespace_frames
58 $skip_pattern = qr/$skip_pattern|$extra_skip/;
61 last if $f[0] !~ $skip_pattern;
64 my $site = @f # if empty - nothing matched - full stack
65 ? "at $f[1] line $f[2]"
68 $origin ||= '{UNKNOWN}';
72 $origin =~ /::/ ? "$origin(): " : "$origin: ", # cargo-cult from Carp::Clan
78 @warn = "Warning: something's wrong" unless @warn;
80 # back-compat with Carp::Clan - a warning ending with \n does
81 # not include caller info
84 $warn[-1] =~ /\n$/ ? '' : " $ln\n"
89 my (undef, $skip_pattern) = @_;
92 $skip_pattern = $skip_pattern
93 ? qr/ ^ $into $ | $skip_pattern /x
99 *{"${into}::carp"} = sub {
101 __find_caller($skip_pattern, $into),
107 *{"${into}::carp_once"} = sub {
108 return if $fired->{$_[0]};
112 __find_caller($skip_pattern, $into),
118 *{"${into}::carp_unique"} = sub {
119 my ($ln, $calling) = __find_caller($skip_pattern, $into);
120 my $msg = join ('', $calling, @_);
122 # unique carping with a hidden caller makes no sense
125 return if $seen->{$ln}{$msg};
126 $seen->{$ln}{$msg} = 1;
134 # cleanup after ourselves
135 namespace::clean->import(-cleanee => $into, qw/carp carp_once carp_unique/)
136 ## FIXME FIXME FIXME - something is tripping up V::M on 5.8.1, leading
137 # to segfaults. When n::c/B::H::EndOfScope is rewritten in terms of tie()
138 # see if this starts working
139 unless DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN;
143 die (__PACKAGE__ . " does not implement unimport yet\n");
150 DBIx::Class::Carp - Provides advanced Carp::Clan-like warning functions for DBIx::Class internals
154 Documentation is lacking on purpose - this an experiment not yet fit for
155 mass consumption. If you use this do not count on any kind of stability,
156 in fact don't even count on this module's continuing existence (it has
157 been noindexed for a reason).
159 In addition to the classic interface:
161 use DBIx::Class::Carp '^DBIx::Class'
163 this module also supports a class-data based way to specify the exclusion
164 regex. A message is only carped from a callsite that matches neither the
165 closed over string, nor the value of L</_skip_namespace_frames> as declared
166 on any callframe already skipped due to the same mechanism. This is to ensure
167 that intermediate callsites can declare their own additional skip-namespaces.
169 =head1 CLASS ATTRIBUTES
171 =head2 _skip_namespace_frames
173 A classdata attribute holding the stringified regex matching callsites that
174 should be skipped by the carp methods below. An empty string C<q{}> is treated
175 like no setting/C<undef> (the distinction is necessary due to semantics of the
176 class data accessors provided by L<Class::Accessor::Grouped>)
178 =head1 EXPORTED FUNCTIONS
180 This module export the following 3 functions. Only warning related C<carp*>
181 is being handled here, for C<croak>-ing you must use
182 L<DBIx::Class::Schema/throw_exception> or L<DBIx::Class::Exception>.
186 Carps message with the file/line of the first callsite not matching
187 L</_skip_namespace_frames> nor the closed-over arguments to
188 C<use DBIx::Class::Carp>.
192 Like L</carp> but warns once for every distinct callsite (subject to the
193 same ruleset as L</carp>).
197 Like L</carp> but warns only once for the life of the perl interpreter
198 (regardless of callsite).