lib/Assert.pm
changeset 0 414e01d06fd5
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 package Assert;
       
     2 use base 'Exporter';
       
     3 require 5.006;
       
     4 
       
     5 # Derived from Carp::Assert
       
     6 # Copyright 2004 Crawford Currie
       
     7 # Copyright 2002 by Michael G Schwern <schwern@pobox.com
       
     8 # Slightly simplified derived version of Assert
       
     9 # Differences are:
       
    10 #  1. ASSERT instead of assert
       
    11 #  2. has to be _explicitly enabled_ using the $ENV{ASSERT}
       
    12 #  3. should and shouldnt have been removed
       
    13 #  4. Added UNTAINTED
       
    14 #
       
    15 # Usage is as for Carp::Assert except that you have to explicitly
       
    16 # enable asserts using the environment variable "TWIKI_ASSERTS"
       
    17 # add ENV{TWIKI_ASSERTS} = 1; to you bin/setlib.cfg or bin/LocalLib.cfg
       
    18 
       
    19 use strict;
       
    20 
       
    21 use vars qw(@ISA $VERSION %EXPORT_TAGS);
       
    22 
       
    23 BEGIN {
       
    24     $VERSION = '0.01';
       
    25 
       
    26     $EXPORT_TAGS{NDEBUG} = [qw(ASSERT UNTAINTED DEBUG)];
       
    27     $EXPORT_TAGS{DEBUG} = $EXPORT_TAGS{NDEBUG};
       
    28     Exporter::export_tags(qw(NDEBUG DEBUG));
       
    29 }
       
    30 
       
    31 # constant.pm, alas, adds too much load time (yes, I benchmarked it)
       
    32 sub ASSERTS_ON()  { 1 }       # CONSTANT
       
    33 sub ASSERTS_OFF() { 0 }       # CONSTANT
       
    34 
       
    35 # Export the proper DEBUG flag if TWIKI_ASSERTS is set,
       
    36 # otherwise export noop versions of our routines
       
    37 sub noop {}
       
    38 
       
    39 sub import {
       
    40     no warnings 'redefine';
       
    41     no strict 'refs';
       
    42     if( $ENV{TWIKI_ASSERTS} ) {
       
    43         *DEBUG = *ASSERTS_ON;
       
    44         Assert->export_to_level(1, @_);
       
    45     } else {
       
    46         my $caller = caller;
       
    47         *{$caller.'::ASSERT'} = \&noop;
       
    48         *{$caller.'::UNTAINTED'} = \&ASSERTS_OFF;
       
    49         *{$caller.'::DEBUG'} = \&ASSERTS_OFF;
       
    50     }
       
    51     use strict 'refs';
       
    52     use warnings 'redefine';
       
    53 }
       
    54 
       
    55 sub ASSERT ($;$) {
       
    56     unless ($_[0]) {
       
    57         require Carp;
       
    58         my $msg = 'Assertion';
       
    59         $msg .= " ($_[1])" if defined $_[1];
       
    60         $msg .= " failed!\n";
       
    61         Carp::confess($msg);
       
    62     }
       
    63     return undef;
       
    64 }
       
    65 
       
    66 sub UNTAINTED($) {
       
    67     local (@_, $@, $^W) = @_;
       
    68     my $x;
       
    69     return eval { $x = $_[0], kill 0; 1 };
       
    70 }
       
    71 
       
    72 1;