From: James E. J. Jr. <mu...@us...> - 2003-08-02 06:17:04
|
Update of /cvsroot/psp/psp/lib/tools/Parser In directory sc8-pr-cvs1:/tmp/cvs-serv27721/psp/lib/tools/Parser Modified Files: Group.pm Log Message: rename "group" stack to "grpdef". rename "ddisplay" stack to "grpuse". add much logic for group def to follow fieldspace and tablespace def. allow dummyok attribute on dynamicdisplay tag. replace all fieldspace-based @current with 'do_field'. we now use dummy_ok() accessor. Index: Group.pm =================================================================== RCS file: /cvsroot/psp/psp/lib/tools/Parser/Group.pm,v retrieving revision 1.18 retrieving revision 1.19 diff -u -r1.18 -r1.19 --- Group.pm 18 Jul 2003 07:02:52 -0000 1.18 +++ Group.pm 2 Aug 2003 06:17:01 -0000 1.19 @@ -22,15 +22,107 @@ @handled = qw(group dynamicdisplay do rollto rollover rollback refresh); @handled_no_end = qw(indexoverride); - - @stacks = qw(group ddisplay); - @current = qw(gname obj numvar - form fsdef define fsuse submit verify); + @stacks = qw(grpdef grpuse); + @current = qw(do_field); @propagatable = ((map { "stack_$_" } @stacks), (map { "current_$_" } @current)); - $ERR_STAR='<font color="#ff0000" size="+3" face="arial,helvetica">*</font>'; + *ERR_STAR = \$PSP::Parser::FieldSpace::ERR_STAR; }; +=head2 define_group + + [private] instance + () define_group (string fsname) + +DESCRIPTION: + +=cut + +sub define_group { + my ($this,$gname) = @_; + + # Construct the new full group name, with input name component. + my $full = join ".", (map{ $_->{name} } @{$this->{stack_grpdef}}), $gname; + $this->debug_line("gname[$gname],full[$full]"); + + # get the current fieldspace. + my $fs = $this->get_define_fieldspace(); + + my $group; + if (! ($group = $fs->{group_defs}->{$full})) { + + # We are creating a new define context. + $group = $fs->{group_defs}->{$full} = {}; + + # Note this new group definition. + $this->{new_groups} ||= []; + push @{$this->{new_groups}}, $full; + + # Construct the group package. + my @pkgcomp = qw(PSP::FieldSpace::Group); + push @pkgcomp, $this->{pile_name} if $this->{pile_name}; + push @pkgcomp, map { $_->{name} } @{$this->{stack_fsdef}}; + push @pkgcomp, map { $_->{name} } @{$this->{stack_grpdef}}; + push @pkgcomp, $gname; + my $package = join "::", @pkgcomp; + + # Initialize these attributes. + $group->{name} = $gname; + $group->{fullname} = $full; + $group->{package} = $package; + $group->{field_names} = []; + + $group->{provides} = + $this->{buildinfo}->{provides}->{groups}->{$full} ||= {}; + } + + push @{$this->{stack_grpdef}}, $group; + return $group; +} + +=head2 get_define_group + +=cut + +sub get_define_group { + my ($this,$no_throw_on_fail) = @_; + + # Construct the full group name. + my $full = join ".", map { $_->{name} } @{$this->{stack_grpdef}}; + $this->debug_line("full[$full]"); + + # get the current fieldspace. + my $fs = $this->get_define_fieldspace(); + + # get the current group. + my $group = $fs->{group_defs}->{$full}; + + if (!$group and !$no_throw_on_fail) { + local $Error::Depth += 1; + throw Error::Simple("Group DEFINE context expected."); + } + + return $group; +} + +=head2 pop_define_group + + [private] instance + (hashref) pop_define_group() + +DESCRIPTION: + +Pops any current group DEFINE context. Called by +end_pspgroup(). + +=cut + +sub pop_define_group { + my ($this) = @_; + $this->debug_line("last[$this->{stack_grpdef}->[-1]->{name}]"); + return pop @{$this->{stack_grpdef}}; +} + =head2 begin_pspgroup [private] instance @@ -45,12 +137,8 @@ sub begin_pspgroup { my ($this, $tag, $attr) = @_; - my $fs = $this->get_define_fieldspace(); my $gname = $attr->{name} or throw Error::Simple("<$tag> requires NAME attribute."); - $fs->{group_defs}->{$gname} and throw - Error::Simple("A <$tag> with NAME '$gname' already exists."); - my $fsname = $fs->{fullname}; # create a group context. my $context = $this->push_context @@ -60,25 +148,15 @@ # group context starts out in script mode. $this->script_mode(); - my $basepkg = "Group"; - $basepkg .= "::$this->{pile_name}" if $this->{pile_name}; - - my $group = $fs->{group_defs}->{$gname} = - { - setup => "", - name => $gname, - grpvar => $attr->{grpvar} || '$_'.$gname.'_group', + my $group = $this->define_group($gname); + %$group = + (grpvar => $attr->{grpvar} || '$_'.$gname.'_group', numvar => $attr->{numvar} || '$_'.$gname.'_index', objvar => $attr->{obj} || '$_'.$gname.'_obj', number => $attr->{numdisplay} || 20, maxnum => $attr->{maxnum} || "", - package => $basepkg."::${fsname}::${gname}", - field_names => [], - dummy_ok => bool_att($attr->{dummyok}) ? 1 : 0 - }; - - $this->{stack_group} ||= []; - push @{$this->{stack_group}}, $group; + dummy_ok => bool_att($attr->{dummyok}) ? 1 : 0, + %$group); # Override default inherited tag definitions my ($begin0,$end0) = $this->handlers(); @@ -101,9 +179,9 @@ sub end_pspgroup { my ($this,$tag) = @_; - # forget which group we have. - my $group = pop @{$this->{stack_group}} or throw - Error::Simple("<$tag> used outside of GROUP context"); + # pop which group we have. + my $group = $this->pop_define_group(); + $this->pop_handlers(); $this->script_mode(0); @@ -116,6 +194,141 @@ $this->{verbose} and print " Group '$group->{name}' defined\n"; } +=head2 begin_group_pspdefine + + [private] instance + () begin_group_pspdefine (string $tag, \%attrs, \@atrseq, string $orig) + +=cut + +sub begin_group_pspdefine { + my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_; + $this->debug_line($orig_txt); + + my $group = $this->get_define_group(); + my $name = $attr->{name} or throw + Error::Simple("<$tag> requires NAME attribute."); + + my $fs = $this->get_define_fieldspace(); + + $group->{provides}->{fields}->{$name}++; + + # defer to the normal DEFINE operation.. + $this->begin_pspdefine($tag,$attr,$attr_seq,$orig_txt); + + # the normal operation should have created a field def. + my $field_def = $fs->{field_defs}->{$name} or throw + Error::Simple("Internal error: $name field not defined?!?"); + + # note the group of this field in the field def. + $field_def->{group} = $group->{name}; + push @{$group->{field_names}}, $name; +} + +=head2 end_group_pspdefine + + [private] instance + () end_group_pspdefine (string $tag) + +=cut + +sub end_group_pspdefine { + my ($this,$tag) = @_; + $this->debug_line($tag); + + # simply defer to the normal DEFINE operation.. + $this->end_pspdefine($tag); +} + +=head2 use_group + + [private] instance + () use_group (string fsname) + +DESCRIPTION: + +=cut + +sub use_group { + my ($this,$gname) = @_; + + # Construct the new full group name, with input name component. + my $full = join ".", (map{ $_->{name} } @{$this->{stack_grpuse}}), $gname; + $this->debug_line("gname[$gname],full[$full]"); + + # get the current fieldspace. + my $fs = $this->get_use_fieldspace(); + + my $group; + if (! ($group = $fs->{use_groups}->{$full})) { + + # We are creating a new define context. + $group = $fs->{use_groups}->{$full} = {}; + + # Construct the group package. + my @pkgcomp = qw(PSP::FieldSpace::Group); + push @pkgcomp, $this->{pile_name} if $this->{pile_name}; + push @pkgcomp, map { $_->{name} } @{$this->{stack_grpuse}}; + push @pkgcomp, $gname; + my $package = join "::", @pkgcomp; + + # Initialize these attributes. + $group->{name} = $gname; + $group->{fullname} = $full; + $group->{package} = $package; + + $group->{requires} = + $this->{buildinfo}->{requires}->{groups}->{$full} ||= {}; + } + + push @{$this->{stack_grpuse}}, $group; + + return $group; +} + +=head2 get_use_group + +=cut + +sub get_use_group { + my ($this,$no_throw_on_fail) = @_; + + # Construct the full group name. + my $full = join ".", map { $_->{name} } @{$this->{stack_grpuse}}; + $this->debug_line("full[$full]"); + + # get the current fieldspace. + my $fs = $this->get_use_fieldspace(); + + # get the current group. + my $group = $fs->{use_groups}->{$full}; + + if (!$group and !$no_throw_on_fail) { + local $Error::Depth += 1; + throw Error::Simple("Group USE context expected."); + } + + return $group; +} + +=head2 pop_use_group + + [private] instance + (hashref) pop_use_group() + +DESCRIPTION: + +Pops any current group USE context. Called by +end_pspgroup(). + +=cut + +sub pop_use_group { + my ($this) = @_; + $this->debug_line("last[$this->{stack_grpuse}->[-1]->{name}]"); + return pop @{$this->{stack_grpuse}}; +} + =head2 begin_pspdynamicdisplay [private] instance @@ -130,46 +343,49 @@ sub begin_pspdynamicdisplay { my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_; - my $fs = $this->get_use_fieldspace(); my $gname = $attr->{name} or throw Error::Simple("<$tag> requires NAME attribute."); - $fs->{use_group}->{$gname} ||= {}; -# my $group_def = $fs->{group_defs}->{$gname} or -# $this->log_exception("There is no group defined for $gname."); - $this->{dyndisp}->{$gname} and throw - Error::Simple("<$tag> used in nested $gname \U$tag\E context."); + my $group = $this->use_group($gname); - push @{$this->{stack_ddisplay}}, $gname; + # there should not be a current dynamicdisplay for this group. + $group->{dyndisp} and throw + Error::Simple("<$tag> used in nested $gname \U$tag\E context."); - my $dyndisp = $this->{dyndisp}->{$gname} = {}; + # define they current dynamicdisplay group element. + my %d; $group->{dyndisp} = \%d; for my $p (qw(grp num obj)) { - $dyndisp->{$p."var"} = - ($attr->{$p."var"} || '$_'.$p.'_'.$gname); -# ($attr->{$p."var"} || $group_def->{$p."var"} || '$_'.$p.'_'.$gname); + $d{$p."var"} = ($attr->{$p."var"} || '$_'.$p.'_'.$gname); } + my $dummy_ok = quote_bareword($attr->{dummyok}) if defined $attr->{dummyok}; # note, index effectively starts at 1 $this->code("${gname}_setup:"); $this->begin_pspblock("setup($gname)"); - $this->code("my (".$dyndisp->{numvar}.",".$dyndisp->{objvar}.");"); - $this->code("my ".$dyndisp->{grpvar}." = \$fs->group('$gname');"); + $this->code("my (".$d{numvar}.",".$d{objvar}.");"); + $this->code("my ".$d{grpvar}." = \$fs->group('$gname');"); + $this->code($d{grpvar}."->dummy_ok($dummy_ok);") if defined $dummy_ok; if (my $num = $attr->{numdisplay}) { - $this->code($dyndisp->{grpvar}."->{propagated_controls} or"); - $this->code(" ".$dyndisp->{grpvar}."->n_items_per_page($num);"); + $this->code($d{grpvar}."->{propagated_controls} or"); + $this->code(" ".$d{grpvar}."->n_items_per_page($num);"); } - $this->code($dyndisp->{grpvar}."->set_cursor(". - $dyndisp->{grpvar}."->first_item_n());"); + $this->code($d{grpvar}."->set_cursor(". + $d{grpvar}."->first_item_n());"); $this->code("\$fs->errors_p() or"); - $this->code(" ".$dyndisp->{grpvar}."->import_controls(\$cgi);"); + $this->code(" ".$d{grpvar}."->import_controls(\$cgi);"); $this->code("${gname}_loop:"); - $this->code("while (".$dyndisp->{grpvar}."->more_to_come())"); + $this->code("while (".$d{grpvar}."->more_to_come())"); $this->begin_pspblock("while($gname->more_to_come)"); - $this->code($dyndisp->{numvar}." = ".$dyndisp->{grpvar}."->cursor();"); - $this->code($dyndisp->{objvar}." = ".$dyndisp->{grpvar}."->object();"); + $this->code($d{numvar}." = ".$d{grpvar}."->cursor();"); + $this->code($d{objvar}." = ".$d{grpvar}."->object();"); # $this->code("print STDERR \"top of $gname loop: ". -# "\\".$dyndisp->{numvar}."='".$dyndisp->{numvar}."'\\n\";"); +# "\\".$d{numvar}."='".$d{numvar}."'\\n\";"); + + # Override default inherited tag definitions + my ($begin0,$end) = $this->handlers(); + my $begin = { %$begin0 , 'psp:input' => \&begin_group_pspinput }; + $this->push_handlers($begin,$end); } =head2 end_pspdynamicdisplay @@ -186,19 +402,18 @@ sub end_pspdynamicdisplay { my ($this,$tag) = @_; - my $fs = $this->get_use_fieldspace(); - my $gname = pop @{$this->{stack_ddisplay}} or throw - Error::Simple("<$tag> used outside of GROUP context"); - $fs->{use_group}->{$gname} ||= {}; -# my $group_def = $fs->{group_defs}->{$gname} or -# $this->log_exception("There is no group defined for $gname."); - my $dyndisp = delete $this->{dyndisp}->{$gname} or throw + my $group = $this->pop_use_group(); + my $gname = $group->{name}; + + $this->pop_handlers(); + + my $d = delete $group->{dyndisp} or throw Error::Simple("<$tag> used outside of $gname \U$tag\E context."); $this->end_pspblock("while($gname->more_to_come)"); $this->code("continue"); $this->begin_pspblock("continue($gname->more_to_come)"); - $this->code($dyndisp->{grpvar}."->advance_cursor();"); + $this->code($d->{grpvar}."->advance_cursor();"); $this->end_pspblock("continue($gname->more_to_come)"); $this->end_pspblock("setup($gname)"); @@ -219,12 +434,15 @@ my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_; $this->debug_line($orig_txt); + my $group = $this->get_use_group(); + # defer to dynamic display $this->begin_pspdynamicdisplay($tag,$attr,$attr_seq,$orig_txt); - if (my $do_field = $attr->{field}) { - $this->{current_do_field} = $do_field; - $this->begin_pspfield($tag,{name => $do_field}); + if (my $name = $attr->{field}) { + $this->{current_do_field} = $name; + $group->{requires}->{fields}->{$name}++; + $this->begin_pspfield($tag,{name => $name}); } $this->script_mode(); @@ -253,42 +471,42 @@ $this->pop_handlers(); $this->script_mode(0); - if (my $do_field = delete $this->{current_do_field}) { + if (my $name = delete $this->{current_do_field}) { $this->end_pspfield($tag); } $this->end_pspdynamicdisplay($tag); } -sub begin_group_pspdefine { - my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_; - $this->debug_line($orig_txt); +=head2 begin_group_pspinput - my $fs = $this->get_define_fieldspace(); + [private] instance + () begin_group_pspinput (string $tag, \%attrs, \@atrseq, string $orig) - my $group = $this->{stack_group}->[-1] or throw - Error::Simple("Internal error: begin_pspdefine_group without a group?!?"); - my $name = $attr->{name} or throw - Error::Simple("<$tag> requires NAME attribute."); +DESCRIPTION: - # defer to the normal DEFINE operation.. - $this->begin_pspdefine($tag,$attr,$attr_seq,$orig_txt); +See PSP specification. - # the normal operation should have created a field def. - my $field_def = $fs->{field_defs}->{$name} or throw - Error::Simple("Internal error: $name field not defined?!?"); +See PSP::Parser::FieldSpace for more information. - # note the group of this field in the field def. - $field_def->{group} = $group->{name}; - push @{$group->{field_names}}, $name; -} +=cut -sub end_group_pspdefine { - my ($this,$tag) = @_; - $this->debug_line($tag); +sub begin_group_pspinput { + my($this,$tag,$attr,$attr_seq,$orig_txt) = @_; - # simply defer to the normal DEFINE operation.. - $this->end_pspdefine($tag); + if (! defined $attr->{group_index}) { + my $index = ""; + for my $group (@{$this->{stack_grpuse}}) { + my $d = $group->{dyndisp} or throw + Error::Simple("Nested used group without nested display???"); + $index .= "," if length $index; + $index .= $d->{numvar}; + } + $attr->{group_index} = $index; + } + + # defer to the normal DEFINE operation.. + $this->begin_pspinput($tag,$attr,$attr_seq,$orig_txt); } =head2 begin_pspindexoverride @@ -305,12 +523,8 @@ sub begin_pspindexoverride { my ($this, $tag, $attr) = @_; - my $fs = $this->get_use_fieldspace(); - my $gname = $attr->{group} or throw - Error::Simple("<$tag> requires GROUP attribute."); - $fs->{use_group}->{$gname} ||= {}; -# my $group = $fs->{group_defs}->{$gname} or -# $this->log_exception("There is no group defined for $gname."); + my $group = $this->get_use_group(); + my $gname = $group->{name}; my $test = defined $attr->{test} ? $attr->{test} : '1'; my $previous = bool_att($attr->{previous}); @@ -319,17 +533,10 @@ # (!$previous and !($steps and $number)) and throw # Error::Simple("<$tag>: PREVIOUS attribute requires STEP"); - $this->code("if ($test) {"); - if ($previous) { - $this->code(" \$_dd_index_$gname = \$_prev_dd_index_$gname;"); -# } elsif ($steps) { -# $this->code(" \$_dd_index_$gname += \$number * $steps;"); - } - $this->code(" \$cgi->param('_dd_index_$gname', \$_dd_index_$gname);"); - - #$this->fs_init_code($fsname); - - $this->code('}'); + $this->code("if ($test) "); + $this->begin_pspblock("indexoverride-if"); + $this->code("# insert code here to control the starting index of dd."); + $this->end_pspblock("indexoverride-if"); } =head2 begin_psprollto @@ -348,11 +555,11 @@ $this->debug_line($orig_txt); my $fs = $this->get_use_fieldspace(); + my $gname = $attr->{group} or throw Error::Simple("<$tag> requires GROUP attribute."); - $fs->{use_group}->{$gname} ||= {}; -# my $group = $fs->{group_defs}->{$gname} or throw -# Error::Simple("GROUP $gname does not exist in ".ref($fs)); + my $group = $this->use_group($gname); + my $name = $attr->{name} || "$gname:rollto"; my $text = $attr->{text} || "Go to page -->"; @@ -366,7 +573,7 @@ $this->code("my \$_grp = \$fs->group('$gname');"); my $qname = quote_bareword($name); my $qtext = quote_bareword($text); - $this->code("\$out->put(\$_grp->html_page_select($qtext,$qname));"); + $this->code("\$\$out.=(\$_grp->html_page_select($qtext,$qname));"); $this->end_pspblock("rollto($gname)"); # prepare the call for and call pspsubmit @@ -396,6 +603,9 @@ sub end_psprollto { my ($this,$orig_txt) = @_; + + my $group = $this->pop_use_group(); + return $this->end_pspsubmit($orig_txt); } @@ -415,11 +625,11 @@ $this->debug_line($orig_txt); my $fs = $this->get_use_fieldspace(); - my $gname = $attr->{group} or - throw Error::Simple("<$tag> requires GROUP attribute."); - $fs->{use_group}->{$gname} ||= {}; -# my $group = $fs->{group_defs}->{$gname} or throw -# Error::Simple("GROUP $gname does not exist in ".ref($fs)); + + my $gname = $attr->{group} or throw + Error::Simple("<$tag> requires GROUP attribute."); + my $group = $this->use_group($gname); + my $name = $attr->{name} || "$gname:rollover"; my $text = $attr->{text} || "Next >>"; @@ -430,11 +640,11 @@ $this->begin_pspblock("rollover($gname)"); $this->code("my \$_grp = \$fs->group('$gname');"); - $this->code('if ($_grp->{dummy_ok} or $_grp->page_n() < $_grp->n_pages())'); + $this->code('if ($_grp->dummy_ok() or $_grp->page_n() < $_grp->n_pages())'); $this->begin_pspblock("index($gname)"); my $qname = quote_bareword($name); my $qtext = quote_bareword($text); - $this->code("\$out->put(\$_grp->html_next_page_button($qtext,$qname));"); + $this->code("\$\$out.=(\$_grp->html_next_page_button($qtext,$qname));"); $this->end_pspblock("index($gname)"); $this->end_pspblock("rollover($gname)"); @@ -467,6 +677,7 @@ sub end_psprollover { my ($this,$orig_txt) = @_; + my $group = $this->pop_use_group(); return $this->end_pspsubmit($orig_txt); } @@ -485,13 +696,12 @@ my ($this,$tag,$attr,$attr_seq,$orig_txt) = @_; $this->debug_line($orig_txt); - my $fs = $this->get_use_fieldspace() or throw - Error::Simple("<$tag> called outside of FIELDSPACE context."); + my $fs = $this->get_use_fieldspace(); + my $gname = $attr->{group} or throw Error::Simple("<$tag> requires GROUP attribute."); - $fs->{use_group}->{$gname} ||= {}; -# my $group = $fs->{group_defs}->{$gname} or throw -# Error::Simple("GROUP $gname does not exist in ".ref($fs)); + my $group = $this->use_group($gname); + my $name = $attr->{name} || "$gname:rollback"; my $text = $attr->{text} || "<< Previous"; @@ -506,7 +716,7 @@ $this->begin_pspblock("index($gname)"); my $qname = quote_bareword($name); my $qtext = quote_bareword($text); - $this->code("\$out->put(\$_grp->html_prev_page_button($qtext,$qname));"); + $this->code("\$\$out.=(\$_grp->html_prev_page_button($qtext,$qname));"); $this->end_pspblock("index($gname)"); $this->end_pspblock("rollback($gname)"); @@ -539,6 +749,7 @@ sub end_psprollback { my ($this,$orig_txt) = @_; + my $group = $this->pop_use_group(); return $this->end_pspsubmit($orig_txt); } @@ -559,11 +770,11 @@ $this->debug_line($orig_txt); my $fs = $this->get_use_fieldspace(); - my $gname = $attr->{group} or - throw Error::Simple("<$tag> requires GROUP attribute."); - $fs->{use_group}->{$gname} ||= {}; -# my $group = $fs->{group_defs}->{$gname} or throw -# Error::Simple("GROUP $gname does not exist in ".ref($fs)); + + my $gname = $attr->{group} or throw + Error::Simple("<$tag> requires GROUP attribute."); + my $group = $this->use_group($gname); + my $name = $attr->{name} || "$gname:refresh"; my $text = $attr->{text} || "Refresh"; @@ -576,7 +787,7 @@ $this->code("my \$_grp = \$fs->group('$gname');"); my $qname = quote_bareword($name); my $qtext = quote_bareword($text); - $this->code("\$out->put(\$_grp->html_refresh_button($qtext,$qname));"); + $this->code("\$\$out.=(\$_grp->html_refresh_button($qtext,$qname));"); $this->end_pspblock("refresh($gname)"); # prepare the call for and call pspsubmit @@ -608,6 +819,7 @@ sub end_psprefresh { my ($this,$orig_txt) = @_; + my $group = $this->pop_use_group(); return $this->end_pspsubmit($orig_txt); } @@ -653,11 +865,11 @@ sub process_groups { my ($fs) = @_; - my $group_defs = $fs->{group_defs} || {}; + my $groups = $fs->{group_defs} || {}; my $out = ""; - for my $gname (sort keys %$group_defs) { - my $group = $group_defs->{$gname}; + for my $gname (sort keys %$groups) { + my $group = $groups->{$gname}; $out .= process_group($fs,$group); } return $out; |