view release on metacpan or  search on metacpan

lib/Catmandu/Fix/Parser.pm  view on Meta::CPAN

}

sub parse_double_quoted_string {
    my ($self) = @_;

    my $str = $self->generic_token(string => qr/"(?:\\?+.)*?"/);
    $str = substr($str, 1, length($str) - 2);

    if (index($str, '\\') != -1) {
        $str =~ s/\\u([0-9A-Fa-f]{4})/chr(hex($1))/egxms;
        $str =~ s/\\n/\n/gxms;
        $str =~ s/\\r/\r/gxms;
        $str =~ s/\\b/\b/gxms;
        $str =~ s/\\f/\f/gxms;
        $str =~ s/\\t/\t/gxms;
        $str =~ s/\\\\/\\/gxms;
        $str =~ s{\\/}{/}gxms;
        $str =~ s{\\"}{"}gxms;
    }

    $str;
}

sub _build_condition {
    my ($self, $name, $args, $pass, $fixes) = @_;
    $fixes = [$fixes] unless is_array_ref($fixes);
    my $cond = $self->_build_fix($name, $args, 'Condition');
    if ($pass) {
        $cond->pass_fixes($fixes);
    }
    else {
        $cond->fail_fixes($fixes);
    }
    $cond;
}

sub _build_bind {
    my ($self, $name, $args, $return, $fixes) = @_;
    $fixes = [$fixes] unless is_array_ref($fixes);
    my $bind = $self->_build_fix($name, $args, 'Bind');
    $bind->__return__($return);
    $bind->__fixes__($fixes);
    $bind;
}

sub _build_fix {
    my ($self, $name, $args, $type) = @_;
    my @name_parts = split(/\./, $name);
    my $fix_name   = pop @name_parts;
    my $ns_name    = join('.', @name_parts);
    my $ns         = $self->get_ns($ns_name)
        // Catmandu::FixParseError->throw("Unknown namespace: $ns_name");
    $ns->load($fix_name, $args, $type);
}

sub _build_ns {
    my ($self, $name) = @_;
    my @name_parts = split(/:/, $name);
    $name = pop @name_parts;
    my $pkg_name = $name_parts[0] // 'perl';
    my $pkg      = require_package($pkg_name, 'Catmandu::Fix::Namespace');
    $pkg->new(name => $name);
}

1;

__END__

=pod

=head1 NAME

Catmandu::Fix::Parser - the parser of the Catmandu::Fix language

=head1 SYNOPSIS

    use Catmandu::Sane;
    use Catmandu::Fix::Parser;
    use Catmandu::Fix;

    use Data::Dumper;

    my $parser = Catmandu::Fix::Parser->new;

    my $fixes;

    try {
        $fixes = $parser->parse(<<EOF);
    add_field(test,123)
    EOF
    }
    catch {
        printf "[%s]\nscript:\n%s\nerror: %s\n"
                , ref($_)
                , $_->source
                , $_->message;
    };

    my $fixer = Catmandu::Fix->new(fixes => $fixes);

    print Dumper($fixer->fix({}));

=head1 DESCRIPTION

Programmers are discouraged to use the Catmandu::Parser directly in code but
use the Catmandu package that provides the same functionality:

    use Catmandu;

    my $fixer = Catmandu->fixer(<<EOF);
    add_field(test,123)
    EOF

    print Dumper($fixer->fix({}));

=head1 METHODS

=head2 new()

Create a new Catmandu::Fix parser