The Labs.Com Issue_11_Source_Filters

TPJ: Issue_11_Source_Filters

This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.

1. debug
2. debug~
3. More Samples on Source_Filters

Download debug

package Debug;

use strict;

use Filter::Util::Call ;

use constant TRUE  => 1 ;

use constant FALSE => 0 ;

sub import {

my ($type) = @_ ;

my (%context) = (

Enabled      => defined $ENV{DEBUG},

InTraceBlock => FALSE,

Filename          => (caller)[1],

LineNo          => 0,

LastBegin          => 0,

) ;

filter_add(bless \%context) ;

}

sub Die {

my ($self) = shift ;

my ($message) = shift ;

my ($line_no) = shift || $self->{LastBegin} ;

die "$message at $self->{Filename} line $line_no.\n";

}

sub filter {

my ($self) = @_ ;

my ($status) ;

$status = filter_read() ;

++ $self->{LineNo} ;

# deal with EOF/error first

if ($status <= 0) {

$self->Die("DEBUG_BEGIN has no DEBUG_END")

if $self->{InTraceBlock} ;

return $status ;

}

if ($self->{InTraceBlock}) {

if (/^\s*##\s*DEBUG_BEGIN/ ) {

$self->Die("Nested DEBUG_BEGIN", $self->{LineNo})

}

elsif (/^\s*##\s*DEBUG_END/) {

$self->{InTraceBlock} = FALSE

}

# comment out the debug lines when the filter is disabled

s/^/#/ if ! $self->{Enabled} ;

}

elsif ( /^\s*##\s*DEBUG_BEGIN/ ) {

$self->{InTraceBlock} = TRUE ;

$self->{LastBegin} = $self->{LineNo} ;

}

elsif ( /^\s*##\s*DEBUG_END/ ) {

$self->Die("DEBUG_END has no DEBUG_BEGIN", $self->{Li\

neNo});

}

return $status ;

}

1 ;

Issue_11_Source_Filters 2. debug~

Download debug~

package Debug;

use strict;

use Filter::Util::Call ;

use constant TRUE  => 1 ;

use constant FALSE => 0 ;

sub import

{

my ($type) = @_ ;

my (%context) = (

Enabled      => defined $ENV{DEBUG},

InTraceBlock => FALSE,

Filename          => (caller)[1],

LineNo          => 0,

LastBegin          => 0,

) ;

filter_add(bless \%context) ;

}

sub Die

{

my ($self) = shift ;

my ($message) = shift ;

my ($line_no) = shift || $self->{LastBegin} ;

die "$message at $self->{Filename} line $line_no.\n"

}

sub filter

{

my ($self) = @_ ;

my ($status) ;

$status = filter_read() ;

++ $self->{LineNo} ;

# deal with EOF/error first

if ($status <= 0) {

$self->Die("DEBUG_BEGIN has no DEBUG_END")

if $self->{InTraceBlock} ;

return $status ;

}

if ($self->{InTraceBlock}) {

if (/^\s*##\s*DEBUG_BEGIN/ ) {

$self->Die("Nested DEBUG_BEGIN", $self->{LineNo})

}

elsif (/^\s*##\s*DEBUG_END/) {

$self->{InTraceBlock} = FALSE

}

# comment out the debug lines when the filter is disabled

s/^/#/ if ! $self->{Enabled} ;

}

elsif ( /^\s*##\s*DEBUG_BEGIN/ ) {

$self->{InTraceBlock} = TRUE ;

$self->{LastBegin} = $self->{LineNo} ;

}

elsif ( /^\s*##\s*DEBUG_END/ ) {

$self->Die("DEBUG_END has no DEBUG_BEGIN", $self->{LineNo});

}

return $status ;

}

1 ;

Issue_11_Source_Filters 3. More Samples on Source_Filters

• Issue_11_Source_Filters