Commit 7f9a3f70074c5d4eb4e8260648f055b7556a7a4f - libdbix-class-perl

Standardize the Moo import block, move quote_sub/qsub into ::_Util This way we will have less boilerplate in subsequent commits where we will use quote_sub standalone Add yet another test to make absolutely sure quote_sub won't leak any of the strictures insanity Peter Rabbitson 9 years ago

5 changed file(s) with 82 addition(s) and 20 deletion(s). Raw diff Collapse all Expand all

+18

-14

lib/DBIx/Class/Storage/BlockRunner.pm less more

0	0	package # hide from pause until we figure it all out
1	1	DBIx::Class::Storage::BlockRunner;
2	2
	3	use warnings;
3	4	use strict;
	5
	6	# DO NOT edit away without talking to riba first, he will just put it back
	7	# BEGIN pre-Moo2 import block
	8	BEGIN {
	9	my $initial_fatal_bits = (${^WARNING_BITS}\|\|'') & $warnings::DeadBits{all};
	10	local $ENV{PERL_STRICTURES_EXTRA} = 0;
	11	require Moo; Moo->import;
	12	${^WARNING_BITS} &= ( $initial_fatal_bits \| ~ $warnings::DeadBits{all} );
	13	}
	14	# END pre-Moo2 import block
4	15
5	16	use DBIx::Class::Exception;
6	17	use DBIx::Class::Carp;
7	18	use Context::Preserve 'preserve_context';
8		use DBIx::Class::_Util 'is_exception';
	19	use DBIx::Class::_Util qw(is_exception qsub);
9	20	use Scalar::Util qw(weaken blessed reftype);
10	21	use Try::Tiny;
11	22
12		# DO NOT edit away without talking to riba first, he will just put it back
13		BEGIN {
14		local $ENV{PERL_STRICTURES_EXTRA} = 0;
15		require Moo; Moo->import;
16		require Sub::Quote; Sub::Quote->import('quote_sub');
17		}
18		use warnings NONFATAL => 'all';
19	23	use namespace::clean;
20	24
21	25	=head1 NAME

42	46	has retry_handler => (
43	47	is => 'ro',
44	48	required => 1,
45		isa => quote_sub( q{
	49	isa => qsub q{
46	50	(Scalar::Util::reftype($_[0])\|\|'') eq 'CODE'
47	51	or DBIx::Class::Exception->throw('retry_handler must be a CODE reference')
48		}),
	52	},
49	53	);
50	54
51	55	has retry_debug => (
52	56	is => 'rw',
53	57	# use a sub - to be evaluated on the spot lazily
54		default => quote_sub( '$ENV{DBIC_STORAGE_RETRY_DEBUG}' ),
	58	default => qsub '$ENV{DBIC_STORAGE_RETRY_DEBUG}',
55	59	lazy => 1,
56	60	);
57	61

66	70	writer => '_set_failed_attempt_count',
67	71	default => 0,
68	72	lazy => 1,
69		trigger => quote_sub(q{
	73	trigger => qsub q{
70	74	$_[0]->throw_exception( sprintf (
71	75	'Reached max_attempts amount of %d, latest exception: %s',
72	76	$_[0]->max_attempts, $_[0]->last_exception
73	77	)) if $_[0]->max_attempts <= ($_[1]\|\|0);
74		}),
	78	},
75	79	);
76	80
77	81	has exception_stack => (
78	82	is => 'ro',
79	83	init_arg => undef,
80	84	clearer => '_reset_exception_stack',
81		default => quote_sub(q{ [] }),
	85	default => qsub q{ [] },
82	86	lazy => 1,
83	87	);
84	88

-4

lib/DBIx/Class/Storage/Statistics.pm less more

0	0	package DBIx::Class::Storage::Statistics;
	1
1	2	use strict;
2	3	use warnings;
3	4
4	5	# DO NOT edit away without talking to riba first, he will just put it back
5	6	# BEGIN pre-Moo2 import block
6	7	BEGIN {
7		require warnings;
8	8	my $initial_fatal_bits = (${^WARNING_BITS}\|\|'') & $warnings::DeadBits{all};
9	9	local $ENV{PERL_STRICTURES_EXTRA} = 0;
10	10	require Moo; Moo->import;
11		require Sub::Quote; Sub::Quote->import('quote_sub');
12	11	${^WARNING_BITS} &= ( $initial_fatal_bits \| ~ $warnings::DeadBits{all} );
13	12	}
14	13	# END pre-Moo2 import block
15	14
16	15	extends 'DBIx::Class';
17		use DBIx::Class::_Util 'sigwarn_silencer';
	16	use DBIx::Class::_Util qw(sigwarn_silencer qsub);
18	17	use namespace::clean;
19	18
20	19	=head1 NAME

63	62	has _debugfh => (
64	63	is => 'rw',
65	64	lazy => 1,
66		trigger => quote_sub( '$_[0]->_defaulted_to_stderr(undef)' ),
	65	trigger => qsub '$_[0]->_defaulted_to_stderr(undef)',
67	66	builder => '_build_debugfh',
68	67	);
69	68

+12

-1

lib/DBIx/Class/_Util.pm less more

53	53	use Carp 'croak';
54	54	use Scalar::Util qw(weaken blessed reftype);
55	55	use List::Util qw(first);
	56
	57	# DO NOT edit away without talking to riba first, he will just put it back
	58	# BEGIN pre-Moo2 import block
	59	BEGIN {
	60	my $initial_fatal_bits = (${^WARNING_BITS}\|\|'') & $warnings::DeadBits{all};
	61	local $ENV{PERL_STRICTURES_EXTRA} = 0;
	62	require Sub::Quote; Sub::Quote->import('quote_sub');
	63	${^WARNING_BITS} &= ( $initial_fatal_bits \| ~ $warnings::DeadBits{all} );
	64	}
	65	sub qsub ($) { goto &quote_sub } # no point depping on new Moo just for this
	66	# END pre-Moo2 import block
56	67
57	68	use base 'Exporter';
58	69	our @EXPORT_OK = qw(
59	70	sigwarn_silencer modver_gt_or_eq
60	71	fail_on_internal_wantarray fail_on_internal_call
61	72	refdesc refcount hrefaddr is_exception
62		perlstring
	73	quote_sub qsub perlstring
63	74	UNRESOLVABLE_CONDITION
64	75	);
65	76

-1

t/53lean_startup.t less more

98	98	namespace::clean
99	99	Try::Tiny
100	100	Sub::Name
	101	Sub::Quote
101	102
102	103	Scalar::Util
103	104	List::Util

116	117	{
117	118	register_lazy_loadable_requires(qw(
118	119	Moo
119		Sub::Quote
120	120	Context::Preserve
121	121	));
122	122

+48

-0

xt/quote_sub.t less more

	0	use warnings;
	1	use strict;
	2
	3	use Test::More;
	4	use Test::Warn;
	5
	6	use DBIx::Class::_Util 'quote_sub';
	7
	8	my $q = do {
	9	no strict 'vars';
	10	quote_sub '$x = $x . "buh"; $x += 42';
	11	};
	12
	13	warnings_exist {
	14	is $q->(), 42, 'Expected result after uninit and string/num conversion'
	15	} [
	16	qr/Use of uninitialized value/i,
	17	qr/isn't numeric in addition/,
	18	], 'Expected warnings, strict did not leak inside the qsub'
	19	or do {
	20	require B::Deparse;
	21	diag( B::Deparse->new->coderef2text( Sub::Quote::unquote_sub($q) ) )
	22	}
	23	;
	24
	25	my $no_nothing_q = do {
	26	no strict;
	27	no warnings;
	28	quote_sub <<'EOC';
	29	my $n = "Test::Warn::warnings_exist";
	30	warn "-->@{[ *{$n}{CODE} ]}<--\n";
	31	warn "-->@{[ ${^WARNING_BITS} \|\| '' ]}<--\n";
	32	EOC
	33	};
	34
	35	my $we_cref = Test::Warn->can('warnings_exist');
	36
	37	warnings_exist { $no_nothing_q->() } [
	38	qr/^\Q-->$we_cref<--\E$/m,
	39	qr/^\-\-\>\0*\<\-\-$/m, # some perls have a string of nulls, some just an empty string
	40	], 'Expected warnings, strict did not leak inside the qsub'
	41	or do {
	42	require B::Deparse;
	43	diag( B::Deparse->new->coderef2text( Sub::Quote::unquote_sub($no_nothing_q) ) )
	44	}
	45	;
	46
	47	done_testing;