view release on metacpan or  search on metacpan

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

package Smart::Comments;
$Smart::Comments::VERSION = '1.06';
use 5.008;
use warnings;
use strict;
use Carp;

use List::Util qw(sum);

use Filter::Simple;

my $maxwidth           = 69;  # Maximum width of display
my $showwidth          = 35;  # How wide to make the indicator
my $showstarttime      = 6;   # How long before showing time-remaining estimate
my $showmaxtime        = 10;  # Don't start estimate if less than this to go
my $whilerate          = 30;  # Controls the rate at which while indicator grows
my $minfillwidth       = 5;   # Fill area must be at least this wide
my $average_over       = 5;   # Number of time-remaining estimates to average
my $minfillreps        = 2;   # Minimum size of a fill and fill cap indicator
my $forupdatequantum   = 0.01;  # Only update every 1% of elapsed distance

# Synonyms for asserts and requirements...
my $require = qr/require|ensure|assert|insist/;
my $check   = qr/check|verify|confirm/;

# Horizontal whitespace...
my $hws     = qr/[^\S\n]/;

# Optional colon...
my $optcolon = qr/$hws*;?/;

# Automagic debugging as well...
my $DBX = '$DB::single = $DB::single = 1;';

# Implement comments-to-code source filter...
FILTER {
    shift;        # Don't need the package name
    s/\r\n/\n/g;  # Handle win32 line endings

    # Default introducer pattern...
    my $intro = qr/#{3,}/;

    # Handle args...
    my @intros;
    while (@_) {
        my $arg = shift @_;

        if ($arg =~ m{\A -ENV \Z}xms) {
            my $env =  $ENV{Smart_Comments} || $ENV{SMART_COMMENTS}
                    || $ENV{SmartComments}  || $ENV{SMARTCOMMENTS}
                    ;

            return if !$env;   # i.e. if no filtering

            if ($env !~ m{\A \s* 1 \s* \Z}xms) {
                unshift @_, split m{\s+|\s*:\s*}xms, $env;
            }
        }
        else {
            push @intros, $arg;
        }
    }

    if (my @unknowns = grep {!/$intro/} @intros) {
        croak "Incomprehensible arguments: @unknowns\n",
              "in call to 'use Smart::Comments'";
    }

    # Make non-default introducer pattern...
    if (@intros) {
        $intro = '(?-x:'.join('|',@intros).')(?!\#)';
    }

    # Preserve DATA handle if any...
    if (s{ ^ __DATA__ \s* $ (.*) \z }{}xms) {
        no strict qw< refs >;
        my $DATA = $1;
        open *{caller(1).'::DATA'}, '<', \$DATA or die "Internal error: $!";
    }

    # Progress bar on a for loop...
    s{ ^ $hws* ( (?: [^\W\d]\w*: \s*)? for(?:each)? \s* (?:my)? \s* (?:\$ [^\W\d]\w*)? \s* ) \( ([^;\n]*?) \) \s* \{
            [ \t]* $intro \s (.*) \s* $
     }
     { _decode_for($1, $2, $3) }xgem;

    # Progress bar on a while loop...
    s{ ^ $hws* ( (?: [^\W\d]\w*: \s*)? (?:while|until) \s* \( .*? \) \s* ) \{
            [ \t]* $intro \s (.*) \s* $
     }
     { _decode_while($1, $2) }xgem;

    # Progress bar on a C-style for loop...
    s{ ^ $hws* ( (?: [^\W\d]\w*: \s*)? for \s* \( .*? ; .*? ; .*? \) \s* ) \{
            $hws* $intro $hws (.*) $hws* $
     }
     { _decode_while($1, $2) }xgem;

    # Requirements...
    s{ ^ $hws* $intro [ \t] $require : \s* (.*?) $optcolon $hws* $ }
     { _decode_assert($1,"fatal") }gemx;

    # Assertions...
    s{ ^ $hws* $intro [ \t] $check : \s* (.*?) $optcolon $hws* $ }
     { _decode_assert($1) }gemx;

    # Any other smart comment is a simple dump.
    # Dump a raw scalar (the varname is used as the label)...
    s{ ^ $hws* $intro [ \t]+ (\$ [\w:]* \w) $optcolon $hws* $ }
     {Smart::Comments::_Dump(pref=>q{$1:},var=>[$1]);$DBX}gmx;

    # Dump a labelled scalar...
    s{ ^ $hws* $intro [ \t] (.+ :) [ \t]* (\$ [\w:]* \w) $optcolon $hws* $ }
     {Smart::Comments::_Dump(pref=>q{$1},var=>[$2]);$DBX}gmx;

    # Dump a raw hash or array (the varname is used as the label)...