view release on metacpan or  search on metacpan

lib/CGI/FormBuilder/Source/YAML.pm  view on Meta::CPAN

    local $YAML::Syck::LoadCode = 1;
    local $YAML::Syck::UseCode = 1;
    local $YAML::Syck::DumpCode = 1;

    $CGI::FormBuilder::Util::DEBUG ||= $self->{debug} if ref $self;

    puke("file must be only one scalar file name") if ref $file;

    my $formopt = LoadFile($file);
    puke("loaded file '$file' is not hashref") if ref $formopt ne 'HASH';

    debug 1, "processing YAML::Syck file '$file' as input source";

    # add in top-level options:
    map { $formopt->{$_} = $self->{$_} if !exists $formopt->{$_} } keys %{$self};

    # whork in the function refs:
    $self->_assign_references($formopt, 1) if ref $self;

    my %lame = ( %{$formopt} );
    debug 1, "YAML form definition is:", Dump(\%lame);

    return wantarray ? %{$formopt} : $formopt;
}

sub _assign_references {
    my ($self, $hashref, $stacklevel) = @_;
    $stacklevel++;

    NODE:
    foreach my $node (values %{$hashref}) {
        my $ref = ref $node;

        if ($ref eq 'HASH') {
            $self->_assign_references($node, $stacklevel);
        }
        elsif (!$ref) {

            debug 1, "node is '$node'\n";

            if ( $node =~ m{ \A \\ ([&\$%@]) (.*) \z }xms ) {

                my ($reftype, $refstr) = ($1, $2);
           
                if ($refstr =~ m{ :: }xms) {
                    # already know where it is.  assign it.
                    my $subref = undef;
                    debug 1, "assigning direct pkg ref for '$reftype$refstr'";
                    eval "\$subref = \\$reftype$refstr";
                    my $err = $@;
                    debug 1, "eval error '$err'" if $err;
                    debug 1, "subref is '$subref'";
                    $node = $subref;
                }
                else {
    
                    my $l = $stacklevel;
                    my $subref = undef;
                    LEVELUP:
                    while (my $pkg = caller($l++)) {
                        debug 1, "looking up at lev $l for ref '$refstr' in '$pkg'";
                        my $evalstr = "\$subref = \\$reftype$pkg\::$refstr";
                        debug 1, "eval '$evalstr'";
                        eval $evalstr;
                        if (!$@) {
                            $node = $subref;
                            last LEVELUP;
                        }
                    }
                }
                debug 1, "assgnd ref '$node' for '$reftype$refstr'";
            }
            elsif ( $node =~ m/ \A eval \s* { (.*) } \s* \z /xms ) {
                my $evalstr = $1;
                debug 1, "eval '$evalstr'";
                my $result = eval $evalstr;
                my $err = $@;
                if ($err) {
                    debug 1, "eval error '$err'";
                }
                else {
                    debug 1, "assgnd ref '$node' for eval";
                    $node = $result;
                }
            }

        }
    }
    return;
}

1;

=head1 NAME

CGI::FormBuilder::Source::YAML - Initialize FormBuilder from YAML file

=head1 SYNOPSIS

 use CGI::FormBuilder;

 my $form = CGI::FormBuilder->new(
    source  => {
        source  => 'form.fb',
        type    => 'YAML',
    },
 );

 my $lname = $form->field('lname');  # like normal

=head1 DESCRIPTION

This reads a YAML (YAML::Syck) file that contains B<FormBuilder>
config options and returns a hash to be fed to CGI::FormBuilder->new().

Instead of the syntax read by CGI::FormBuilder::Source::File,
it uses YAML syntax as read by YAML::Syck.  That means you
fully specify the entire data structure.

LoadCode is enabled, so you can use YAML syntax for defining subroutines.