lib/assertions/compat.pm

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