|
From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:08
|
Update of /cvsroot/psp/psp/lib/tools/Parser
In directory sc8-pr-cvs1:/tmp/cvs-serv27778/psp/lib/tools/Parser
Modified Files:
FieldSpace.pm
Log Message:
add preliminary buildinfo: requires and provides.
$out is now local() -- no longer lexical -- allows for a lexical $out.
treat $out as scalar ref.
correct $name -> $vname typo for verifies provides.
Index: FieldSpace.pm
===================================================================
RCS file: /cvsroot/psp/psp/lib/tools/Parser/FieldSpace.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- FieldSpace.pm 18 Jul 2003 07:02:51 -0000 1.21
+++ FieldSpace.pm 2 Aug 2003 06:17:06 -0000 1.22
@@ -70,7 +70,10 @@
# Initialize these attributes.
$fs->{name} = $fsname;
$fs->{fullname} = $full;
- $fs->{package} = $package;
+ $fs->{package} = $package;
+
+ $fs->{provides} =
+ $this->{buildinfo}->{provides}->{fieldspaces}->{$full} ||= {};
}
push @{$this->{stack_fsdef}}, $fs;
@@ -249,6 +252,8 @@
Error::Simple("<$tag> requires NAME attribute.");
$this->{current_define} = $name;
+ $fs->{provides}->{fields}->{$name}++;
+
# create a define field context.
my $context = $this->push_context
({ type => "definefield",
@@ -378,6 +383,9 @@
$fs->{name} = $fsname;
$fs->{fullname} = $full;
$fs->{package} = $package;
+
+ $fs->{requires} =
+ $this->{buildinfo}->{requires}->{fieldspaces}->{$full} ||= {};
}
push @{$this->{stack_fsuse}}, $fs;
@@ -476,9 +484,13 @@
my $form;
if ($this->can("form") and ($form = $this->form())) {
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
$form->{fieldspace} = $fs->{name};
$this->context_lexical('$_no_prop');
- $this->code('$out->put($fs->propagate($_no_prop));');
+ $this->code("\$\${${package}::out}.=".'($fs->propagate($_no_prop));');
}
delete $this->{current_sname} and throw
@@ -502,11 +514,14 @@
# Ensure fieldspace context.
my $fs = $this->get_use_fieldspace();
+ my $fsname = $fs->{name};
my $name = $attr->{name} or throw
Error::Simple("<$tag> requires NAME attribute.");
$name = quote_bareword($name);
+ $fs->{requires}->{fields}->{$name}++;
+
# Make sure this variable is declared.
$this->context_lexical('$_field');
@@ -568,7 +583,11 @@
my $out = '$_field->'.$method."($noformat,$index_name,$delimiter)";
- $this->code("\$out->put($out);");
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
+ $this->code("\$\${${package}::out}.=($out);");
}
=head2 begin_pspalias
@@ -590,7 +609,11 @@
my ($field_name) =
$this->begin_pspfield($tag,$attr,$attr_seq,$orig_text);
- $this->code('$out->put($_field->alias());');
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
+ $this->code("\$\${${package}::out}.=".'($_field->alias());');
}
=head2 begin_pspinput
@@ -610,6 +633,9 @@
my($this,@args) = @_;
my $attr = $args[1];
+ my $append = defined $attr->{group_index} ? $attr->{group_index} : "";
+ $append =~ s/^([^,])/,$1/;
+
my ($field_name,$index_name,$value,$change,$noformat,$delimiter) =
$this->begin_pspfield(@args);
@@ -618,27 +644,24 @@
$this->code_add_indent(" ");
}
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
# accumulate code here.
my @code;
- my $dyndisp;
- if (my $gname = $this->{stack_ddisplay}->[-1]) {
- $dyndisp = $this->{dyndisp}->{$gname};
- }
- my $numcode = $dyndisp->{numvar}
- ? ",".quote_bareword($dyndisp->{numvar}) : "";
-
# check for errors and possibly insert a star.
unless (bool_att($attr->{nomark})) {
push @code,
- ("if (\$fs->in_error('field',$field_name$numcode)) {",
- " \$out->put('$ERR_STAR');",
+ ("if (\$fs->in_error('field',$field_name$append)) {",
+ " \$\${${package}::out}.=('$ERR_STAR');",
"}");
}
$this->context_lexical('$_no_prop');
push @code,
- ('$out->put($_field->html_input('."$index_name,$delimiter));",
+ ("\$\${${package}::out}.=(\$_field->html_input($index_name,$delimiter));",
"\$_field->poss_changed_p(1);",
"for my \$val (\$_field->value($index_name)) {",
" \$_no_prop->{$field_name}->{\$val}++;",
@@ -675,10 +698,14 @@
my ($field_name,$index_name,$value,$change,$noformat,$delimiter) =
$this->begin_pspfield($tag,$attr,$attr_seq,$orig_text);
+ my $page_name = $this->{page_name};
+ my $pile_name = $this->{pile_name};
+ my $package = $pile_name ? "Pile::".$pile_name : "Page::".$page_name;
+
$this->context_lexical('$_no_prop');
$this->context_lexical('$_field');
my @code =
- ("\$out->put(\$_field->html_hidden($index_name));",
+ ("\$\${${package}::out}.=(\$_field->html_hidden($index_name));",
"for my \$val (\$_field->value($index_name)) {",
" \$_no_prop->{$field_name}->{\$val}++;",
"}");
@@ -709,6 +736,8 @@
(defined $vname and defined $test) or throw
Error::Simple("<$tag> requires NAME and TEST attributes.");
+ $fs->{provides}->{verifies}->{$vname}++;
+
my $context = $this->push_context
({type => "verify",
code => "",
@@ -818,10 +847,7 @@
my $name = $attr->{name} or throw
Error::Simple("<$tag> requires a NAME attribute.");
- $fs->{use_vfield}->{$name} ||= {};
-# XXX - no longer valid: fieldspace may not be available yet.
-# $fs->{field_defs}->{$name} or throw
-# Error::Simple("Undefined reference to $fs->{name} field, $name");
+ $fs->{requires}->{fields}->{$name}++;
$name = quote_bareword($name);
@@ -906,10 +932,7 @@
my $name = $attr->{name} or throw
Error::Simple("<$tag> requires a NAME attribute.");
- $fs->{use_verify}->{$name} ||= {};
-# if (!$fs->{verify_defs}->{$name}) {
-# throw Error::Simple("<$tag> refers to an unknown $fs->{name} verify: '$name'");
-# }
+ $fs->{requires}->{verifies}->{$name}++;
$name = quote_bareword($name);
@@ -1197,8 +1220,8 @@
' my $out = PSP::Output->new();',
$verify_def->{code},
' $out or',
- " \$out->put(\"VERIFY '$verify_name' failed without reason.\");",
- ' return $out->get();',
+ " \$\$out.=(\"VERIFY '$verify_name' failed without reason.\");",
+ ' return $$out;',
'}',
""))."\n";
}
|