view release on metacpan or  search on metacpan

lib/Acme/Sub/Parms.pm  view on Meta::CPAN

package Acme::Sub::Parms;

use strict;
use warnings;
use Filter::Util::Call;

BEGIN {
    $Acme::Sub::Parms::VERSION  = '1.03';
    %Acme::Sub::Parms::args     = ();
    %Acme::Sub::Parms::raw_args = ();
    $Acme::Sub::Parms::line_counter   = 0;
}

sub _NORMALIZE    ()   { return ':normalize';    };
sub _NO_VALIDATION  () { return ':no_validation';  };
sub _DUMP           () { return ':dump_to_stdout'; };
sub _DEBUG          () { 0; };

sub _legal_option {
    return {
        _NORMALIZE()     => 1,
        _NO_VALIDATION() => 1,
        _DUMP()          => 1,
    }->{$_[0]};
}

####

sub import {
    my $class = shift;
    my $options = {
           _NORMALIZE()      => 0,
           _NO_VALIDATION()  => 0,
           _DUMP()           => 0,
           };
    foreach my $item (@_) {
        if (not _legal_option($item)) {
            my $package = __PACKAGE__;
            require Carp;
            Carp::croak("'$item' not a valid option for 'use $package'\n");
        }
        $options->{$item} = 1;
    }
    $Acme::Sub::Parms::line_counter = 0;
    my $ref   = {'options' => $options, 'bind_block' => 0 };
    filter_add(bless $ref); # imported from Filter::Util::Call
}

####

sub _parse_bind_spec {
    my ($self, $raw_spec) = @_;

    my $spec = $raw_spec;

    my $spec_tokens = {
        'is_defined' => 0,
        'required'   => 1,
        'optional'   => 0,
    };
    while ($spec ne '') {
        if ($spec =~ s/^required(\s*,\s*|$)//) { # 'required' flag
            $spec_tokens->{'required'} = 1;
            $spec_tokens->{'optional'} = 0;

        } elsif ($spec =~ s/^optional(\s*,\s*|$)//) { # 'optional' flag
            $spec_tokens->{'required'} = 0;
            $spec_tokens->{'optional'} = 1;

        } elsif ($spec =~ s/^is_defined(\s*,\s*|$)//) { # 'is_defined' flag
            $spec_tokens->{'is_defined'} = 1;

        } elsif ($spec =~ s/^(can|isa|type|callback|default)\s*=\s*//) { # 'something="somevalue"'
            my $spec_key = $1;

            # Simple unquoted text with no embedded ws
            if ($spec =~ s/^([^\s"',]+)(\s*,\s*|$)//) {
                $spec_tokens->{$spec_key} = $1;

            # Single quoted text with no embedded quotes
            } elsif ($spec =~ s/^'([^'\/]+)'\s*,\s*//) {
                $spec_tokens->{$spec_key} = "'$1'";

            # Double quoted text with no embedded quotes or escapes
            } elsif ($spec =~ s/^"([^"\/]+)"\s*,\s*//) {
                $spec_tokens->{$spec_key} = '"' . $1 . '"';

            # It is a tricky case with quoted characters. One character at a time it is.
            } elsif ($spec =~ s/^(['"])//) {
                my $quote = $1;
                my $upend_spec  = reverse $spec;
                my $block_done  = 0;
                my $escape_next = 0;
                my $token       = $quote;
                until ($block_done || ($upend_spec eq '')) {
                    my $ch = chop $upend_spec;
                    if ($escape_next) {
                        $token      .= $ch;
                        $escape_next = 0;

                    } elsif (($ch eq "\\") && (not $escape_next)) {
                        $token      .= $ch;
                        $escape_next = 1;

                    } elsif ($ch eq $quote) {
                        $block_done = 1;