view release on metacpan or  search on metacpan

lib/Devel/Comments.pm  view on Meta::CPAN

# Purpose  : Deal with environment variables
# Params   : *none*
# Reads    : %ENV
# Returns  : nothing => no environment variable set
#          : array ref => a list of things to put onto 
#            the "intros" array. 
sub _handle_env {
    # First look to see if the Devel_Comments variable is set, if so
    # process it and return.
    my $dc_env = $ENV{Devel_Comments};
    if ($dc_env) {
        return _handle_dc_env($dc_env);
    }
    # Now check the multitude of smart comments environment variables.
    my $sc_env =
         $ENV{Smart_Comments}
      || $ENV{SMART_COMMENTS}
      || $ENV{SmartComments}
      || $ENV{SMARTCOMMENTS};
    if ($sc_env) {
        return _handle_sc_env($sc_env);
    }

    return;
}
######## /_handle_env ########

######## INTERNAL ROUTINE ########
# _handle_dc_env
#
# Purpose  : To process the devel comments environment variable.
# Params   : A scalar containing the value of the environment variable
# Returns  : An array ref containing 0 or more ???s
#            - if the env var just contains a 1 a ref to an empty
#              array is returned.
#            - otherwise the variable is split on space or (space
#              surrounded) colons.
sub _handle_dc_env {
    my $env = shift;
    # For now we can just do the same thing as for a smart comments 
    # env variable.  In future it would be possible to handle devel
    # comments environment variables differently.
    return _handle_sc_env($env);
}

######## /_handle_dc_env ########

######## INTERNAL ROUTINE ########
# _handle_sc_env
#
# Purpose  : To process the devel comments environment variable.
# Params   : A scalar containing the value of the environment variable
# Returns  : An array ref containing 0 or more ???s
#            - if the env var just contains a 1 a ref to an empty
#              array is returned.
#            - otherwise the variable is split on space or (space
#              surrounded) colons.
sub _handle_sc_env {
    my $env = shift;
    if ( $env !~ m{\A \s* 1 \s* \Z}xms ) {
        return [ split m{\s+|\s*:\s*}xms, $env ];
    }
    return [];
}

######## /_handle_sc_env ########

sub import;     # FORWARD

######## EXTERNAL SUB CALL ########
#
# Purpose  : Rewrite caller's smart comments into code
# Parms    : @_     : The split use line, with $_[0] being *this* package
#          : $_     : Caller's entire source code to be filtered
# Reads    : %ENV, %state_of
# Returns  : $_     : Filtered code
# Writes   : %state_of
# Throws   : never
# See also : Filter::Simple, _prefilter()
# 
# Implement comments-to-code source filter. 
#
# This is not a subroutine but a call to Filter::Simple::FILTER
#   with its single argument being its following block. 
# 
# The block may be thought of as an import routine 
#   which is passed @_ and $_ and must return the filtered code in $_
#
# Note (if our module is invoked properly via use): 
# From caller's viewpoint, use operates as a BEGIN block, 
#   including all our-module inline code and this call to FILTER;
#       while filtered-in calls to our-module subs take place at run time. 
# From our viewpoint, our inline code, including FILTER, 
#   is run after any BEGIN or use in our module;
#       and filtered-in subs may be viewed 
#       as if they were externally called subs in a normal module. 
# Because FILTER is called as part of a constructed import routine, 
#   it executes every time our module is use()-ed, 
#   although other inline code in our module only executes one time only, 
#   when first use()-ed. 
# 
# See "How it works" in Filter::Simple's POD. 
# 
sub FILTERx {}; # dummy sub only to appear in editor's symbol table
#
FILTER {
    ##### |--- Start of filter ---|
    ##### @_
    ##### $_
#~ say "---| Source to be filtered:\n", $_, '|--- END SOURCE CODE';         #~

    my $prefilter       = _prefilter(@_);       # Handle arguments to FILTER
    return 0 if !$prefilter;                    # i.e. if no filtering ABORT
    
    my $intro           = $prefilter->{-intro};         # introducer pattern
    my $caller_id       = $prefilter->{-caller_id};     # unique per-use

    # Preserve DATA handle if any...
    if (s{ ^ __DATA__ \s* $ (.*) \z }{}xms) {
        no strict qw< refs >;
        my $DATA = $1;