view release on metacpan or  search on metacpan

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

                # If we have validation or defaults, handle them
                my $padding_lines = 0;
                if (! $simple_bind) { 
                    my @parm_declarations = ();
                    foreach my $entry (@$bind_entries) {
                        my $variable_decl    = $entry->{'variable'};
                        my $field_name       = $entry->{'field'};
                        my $spec             = $entry->{'spec'};
                        my $trailing_comment = $entry->{'trailing_comment'};
                        if ( (! defined($spec)) || ($spec eq '')) {
                            # push(@parm_declarations, $trailing_comment);
                            next;
                        }
                        # The hard case. We have validation requirements.
                        my ($has_side_effects, $bind_spec_output) = $self->bind_spec($spec, $field_name);
                        $side_effects += $has_side_effects;
                        push (@parm_declarations, "$bind_spec_output$trailing_comment");
                    }
                    $args .=  join("\n",@parm_declarations,'');
                }

                # Generate the actual parameter data binding
                my @var_declarations      = ();
                my @hard_var_declarations = ();
                my @field_declarations    = ();
                my @fields_list           = ();
                foreach my $entry (@$bind_entries) {
                	my $spec       = $entry->{'spec'};
                	next if ((not defined $spec) || ($spec eq ''));
                    my $raw_var    = $entry->{'variable'};
                    my $field_name = $entry->{'field'};
                    
                    push (@fields_list, "'$field_name'");
                    my ($variable_name) = $raw_var =~ m/^my\s+(\S+)$/;
                    if (defined $variable_name) { # simple 'my $variable :' entries are special-cased for performance
                        push (@var_declarations,   $variable_name);
                        push (@field_declarations, "'$field_name'");

                    } else { # Otherwise make a seperate entry for this binding
                        push (@hard_var_declarations, "$raw_var = \$Acme::Sub::Parms::args\{$field_name\};");
                    }
                }
                my $hard_args = join(' ',@hard_var_declarations);
                my $arg_line  = '';
                if (0 < @var_declarations) {
                 
                    if ($simple_bind && (! $normalize) && $no_validation && (0 == $side_effects) && (0 == @hard_var_declarations)) {
                       $args = "\n    my (" . join(",", @var_declarations) . ') = @{{@_}}{' . join(',',@field_declarations) . '}; ';

                    } else {
    
                        $arg_line  = 'my (' . join(",", @var_declarations) . ') = @Acme::Sub::Parms::args{' . join(',',@field_declarations) . '}; ';
                    }
                }
                my $unknown_parms_check = '';
                unless ($no_validation) {
                    $unknown_parms_check = 'delete @Acme::Sub::Parms::args{' . join(',',@fields_list) . '}; if (0 <  @Acme::Sub::Parms::args) { require Carp; Carp::croak(\'Unexpected parameters passed: \' . join(\', \',@Acme::Sub::Parms::args)); } ';

                }
                $self->{'bind_block'} = 0;
                my $original_block_length = $Acme::Sub::Parms::line_counter - $self->{'line_block_start'};
                my $new_block = $args . join(' ',$arg_line, $hard_args, $unknown_parms_check) . "$block_trailing_comment\n";
                $new_block =~ s/\n+/\n/gs;
                my $new_block_lines = $new_block =~ m/\n/gs;
                
                my $additional_lines = $original_block_length - $new_block_lines;
                #warn("Need $additional_lines extra lines\n---\n$new_block---\n");
                if ($additional_lines > 0) {
                    $_ = $new_block . ("\n" x $additional_lines);	
                } else {
                    $_ = $new_block;	
                }

            ########################
            # Bind block parameter line
            } elsif (my($bind_var, $bind_field,$trailing_comment) = m/^\s*(\S.*?)\s+:\s+([^'"\s\[]+.*?)\s*(;\s*|;\s*#.*)$/) {
            	$trailing_comment = defined($trailing_comment) ? $trailing_comment : '';
            	$trailing_comment =~ s/[\r\n]+$//s;
            	$trailing_comment =~ s/^;//;
                my $bind_entry = { 'variable' => $bind_var, 'field' => $bind_field, trailing_comment => $trailing_comment };
                push (@$bind_entries, $bind_entry);
                if ($bind_var !~ m/^my \$\S+$/) {
                    $self->{'simple_bind'} = 0;
                }
                if ($bind_field =~ m/^(\S+)\s*\[(.*)\]$/) { # Complex spec
                    $bind_entry->{'field'} = $1;
                    $bind_entry->{'spec'}  = $2;
                    unless ($no_validation && ($bind_field !~ m/[\s\[,](default|callback)\s*=\s*/)) {
                        $self->{'simple_bind'} = 0;
                    }
                } elsif ($bind_field =~ m/^\w+$/) { # my $thing : something;
                	$bind_entry->{'spec'}  = 'required';
                	unless ($no_validation) {
                		$self->{'simple_bind'} = 0;	
                    }
                } else {
                	die("Failed to parse BindParms block line $Acme::Sub::Parms::line_counter: $_");
                }
                undef $trailing_comment;
                undef $bind_var;
                undef $bind_field;
                $_ = '';

            ############################
            # Blank and comment only lines
            } elsif (m/^(\s*|\s*#.*)$/) {
            	my $trailing_comment = $1;
            	$trailing_comment = defined ($trailing_comment) ? $trailing_comment : '';
            	$trailing_comment =~ s/[\r\n]+$//s;
            	
                my $bind_entry = { spec => '', trailing_comment => $trailing_comment};
                push (@$bind_entries, $bind_entry);
                $_ = '';
                
            } else {
                die("Failed to parse BindParms block line $Acme::Sub::Parms::line_counter: $_");
            }

        } else { # Start of a bind block
            if (m/^\s*BindParms\s+:\s+\((\s*#.*$|\s*$)/) {
                $self->{'simple_bind'}  = 1;
                $self->{'bind_entries'} = [];
                $self->{'bind_block'}   = 1;
                $self->{'line_block_start'} = $Acme::Sub::Parms::line_counter;
                my $block_head_comment = $2;
                $block_head_comment = defined ($block_head_comment) ? $block_head_comment : '';