lib/assertions/compat.pm

   1 package assertions::compat;
   2
   3 require assertions;
   4 our @ISA = qw(assertions);
   5
   6 sub _on () { 1 }
   7 sub _off () { 0 }
   8
   9 sub import {
  10     my $class = shift;
  11     my $name = @_ ? shift : 'asserting';
  12     my $pkg = caller;
  13     $name =~ /::/ or $name = "${pkg}::${name}";
  14     @_ = $pkg unless @_;
  15     $class->SUPER::import(@_);
  16     my $enabled = assertions::enabled();
  17     {
  18         no strict 'vars';
  19         no warnings;
  20         undef &{$name};
  21         *{$name} = $enabled ? \&_on : \&_off;
  22     }
  23 }
  24
  25 sub _compat_assertion_handler {
  26     shift; shift;
  27     grep $_ ne 'assertion', @_
  28 }
  29
  30 sub _do_nothing_handler {}
  31
  32 # test if 'assertion' attribute is natively supported
  33 my $assertion_ok=eval q{
  34     sub _my_asserting_test : assertion { 1 }
  35     _my_asserting_test()
  36 };
  37
  38 *MODIFY_CODE_ATTRIBUTES =
  39     defined($assertion_ok)
  40     ? \&_do_nothing_handler
  41     : \&_compat_assertion_handler;
  42
  43 1;
  44
  45 __END__
  46
  47 =head1 NAME
  48
  49 assertions::compat - assertions for pre-5.9 versions of perl
  50
  51 =head1 SYNOPSIS
  52
  53   # add support for 'assertion' attribute:
  54   use base 'assertions::compat';
  55   sub assert_foo : assertion { ... };
  56
  57   # then, maybe in another module:
  58   package Foo::Bar;
  59
  60   # define sub 'asserting' with the assertion status:
  61   use assertions::compat;
  62   asserting and assert_foo(1,2,3,4);
  63
  64   # or
  65   use assertions::compat ASST => 'Foo::Bar::doz';
  66   ASST and assert_foo('dozpera');
  67
  68 =head1 DESCRIPTION
  69
  70 C<assertions::compat> allows to use assertions on perl versions prior
  71 to 5.9.0 (that is the first one to natively support them). Though,
  72 it's not magic, do not expect it to allow for conditional executed
  73 subroutines.
  74
  75 This module provides support for two different functionalities:
  76
  77 =head2 The C<assertion> attribute handler
  78
  79 The subroutine attribute C<assertion> is not recognised on perls
  80 without assertion support. This module provides a
  81 C<MODIFY_CODE_ATTRIBUTES> handler for this attribute. It must be used
  82 via inheritance:
  83
  84   use base 'assertions::compat';
  85
  86   sub assert_foo : assertion { ... }
  87
  88 Be aware that the handler just discards the attribute, so subroutines
  89 declared as assertions will be B<unconditionally> called on perl without
  90 native support for them.
  91
  92 =head2 Assertion execution status as a constant
  93
  94 C<assertions::compat> also allows to create constant subs which value
  95 is the assertion execution status. That allows checking explicitly and
  96 efficiently if assertions have to be executed on perls without native
  97 assertion support.
  98
  99 For instance...
 100
 101   use assertions::compat ASST => 'Foo::Bar';
 102
 103 exports constant subroutine C<ASST>. Its value is true when assertions
 104 tagged as C<Foo::Bar> has been activated via L<assertions::activate>;
 105 usually done with the -A switch from the command line on perls
 106 supporting it...
 107
 108   perl -A=Foo::Bar my_script.pl
 109
 110 or alternatively with...
 111
 112   perl -Massertions::activate=Foo::Bar my_script.pl
 113
 114 on pre-5.9.0 versions of perl.
 115
 116 The constant sub defined can be used following this idiom:
 117
 118   use assertions::compat ASST => 'Foo::Bar';
 119   ...
 120   ASST and assert_foo();
 121
 122 When ASST is false, the perl interpreter optimizes away the rest of
 123 the C<and> statement at compile time.
 124
 125
 126 When no assertion selection tags are passed to C<use
 127 assertions::compat>, the current module name is used as the selection
 128 tag, so...
 129
 130   use assertions::compat 'ASST';
 131
 132 is equivalent to...
 133
 134   use assertions::compat ASST => __PACKAGE__;
 135
 136 If the name of the constant subroutine is also omitted, C<asserting>
 137 is used.
 138
 139 This module will not emit a warning when the constant is redefined.
 140 this is done on purpose to allow for code like that:
 141
 142   use assertions::compat ASST => 'Foo';
 143   ASST and assert_foo();
 144
 145   use assertions::compat ASST => 'Bar';
 146   ASST and assert_bar();
 147
 148 Finally, be aware that while assertion execution status is lexical
 149 scoped, defined constants are not. You should be careful on that to
 150 not write inconsistent code. For instance...
 151
 152   package Foo;
 153
 154   use MyAssertions qw(assert_foo);
 155
 156   use assertions::compat ASST => 'Foo::Out'
 157   {
 158     use assertions::compat ASST => 'Foo::In';
 159     ASST and assert_foo(); # ok!
 160   }
 161
 162   ASST and assert_foo()   # bad usage!
 163   # ASST refers to tag Foo::In while assert_foo() is
 164   # called only when Foo::Out has been activated.
 165   # This is not what you want!!!
 166
 167
 168 =head1 SEE ALSO
 169
 170 L<perlrun>, L<assertions>, L<assertions::activate>, L<attributes>.
 171
 172 =head1 AUTHOR
 173
 174 Salvador FandiE<ntilde>o, E<lt>sfandino@yahoo.comE<gt>
 175
 176 =head1 COPYRIGHT AND LICENSE
 177
 178 Copyright 2005 by Salvador FandiE<ntilde>o
 179
 180 This library is free software; you can redistribute it and/or modify
 181 it under the same terms as Perl itself.
 182
 183 =cut