Name

auto-wizard —

ATTRIBUTES

Attribute Pos. Req. Default Description
name Yes default Survey name.
already_title You already did that survey!
thanks_title Thanks for completing the survey!
already_message We only want to collect information once from each person. Thank you.
thanks_message Your survey is complete. Thank you.
intro_text
survey_file logs/survey/name.txt
survey_counter logs/survey/name.cnt
survey_counter_sql
email_subject Response to name
email_from
email_cc
output_fields
output_email
output_repeated
email_template
continue_template
output_href
output_parm
db_id
row_template
scratch
show
run
compile
title_scratch page_title
banner_scratch page_banner
interpolate     0 interpolate input?
reparse     1 interpolate output?
hide     0 Hide the tag return value?

DESCRIPTION

BEHAVIOR

This tag appears to be affected by, or affects, the following:
Catalog Variables: SURVEY_LOG_DIR
Global Variables: MV_PAGE

EXAMPLES

No examples are available at this time. We do consider this a problem and will try to supply some.

NOTES

AVAILABILITY

auto-wizard is available in Interchange versions:

4.6.0-5.7.0 (git-head)

SOURCE

Interchange 5.7.0:

Source: code/UI_Tag/auto_wizard.coretag
Lines: 972


# Copyright 2002-2007 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: auto_wizard.coretag,v 1.20 2007-03-30 23:40:54 pajamian Exp $

UserTag  auto-wizard  Order     name
UserTag  auto-wizard  AddAttr
UserTag  auto-wizard  HasEndTag
UserTag  auto-wizard  Version   $Revision: 1.20 $
UserTag  auto-wizard  Routine   <<EOR

use vars qw/$Session $Tag $CGI $Tmp $Scratch $Values $ready_safe/;
 
my @wanted_opts = qw/
 already_message
 already_title
 bottom_buttons
 break_row_class
 combo_row_class
 data_cell_class
 data_row_class
 display_type
 help_cell_class
 intro_text
 label_cell_class
 left_width
 output_type
 spacer_row_class
 table_width
 thanks_message
 thanks_title
 top_buttons
 widget_cell_class
 email_from
 email_cc
 email_subject
 email_template
 continue_template
 row_template
 output_email
 output_fields
 output_repeated
/;

my %overall_opt;
@overall_opt{@wanted_opts} = @wanted_opts;

sub thanks_title {
 my ($opt, $already, $default) = @_;
 my $tt = $already
     ?  ($opt->{already_title} ||= "You already did that survey!" )
     :  ($opt->{thanks_title} ||= $default || "Thanks for completing the survey!");
 return errmsg($tt);
}

sub thanks_message {
 my ($opt, $already) = @_;
 my $tm;
 if($already) {
   $opt->{already_message} ||=
     "We only want to collect information once from each person. Thank you.";
   $tm = $opt->{already_message};
 }
 else {
   $opt->{thanks_message} ||= "Your survey is complete. Thank you.";
   $tm = $opt->{thanks_message};
 }
 return errmsg($tm);
 $opt->{intro_text} .= "<h1>$tm</h1>" if $already;
}

sub title_and_message {
 my ($opt, $already) = @_;
 my $tt = thanks_title($opt, $already);
 my $tm = thanks_message($opt, $already);
 return (
       '',
       "final: $tt",
       'template: <<EOF',
       $tm,
       'EOF',
     );
}

sub already {
 my ($wizname, $set) = @_;
 my $surv = $Vend::Session->{surveys} ||= {};
 if(defined $set) {
   $surv->{$wizname} = $set;
 }

 if ($Vend::Session->{logged_in} and ! $Vend::admin) {
   if (! defined $surv->{$wizname}) {
     my $o = {
       function => 'check_file_acl',
       location => "survey/$wizname",
     };
     $surv->{$wizname} = $Tag->userdb($o);
   }
   else {
     my $o = {
       function => 'set_file_acl',
       location => "survey/$wizname",
       mode => $surv->{$wizname},
     };
     $Tag->userdb($o);
   }
 }

 return $surv->{$wizname};
}

sub survey_log_generate_final {
 my ($wizname, $opt, $ary) = @_;

 ref($opt) eq 'HASH'
   or die "bad call to generate_final routine, output options not hash ref ($opt)";
 ref($ary) eq 'ARRAY'
   or die "bad call to generate_final routine, output not array ref ($ary)";

 my $done = already($wizname);

 push @$ary, title_and_message($opt, $done);

 if ( $done ) {
   $opt->{intro_text} .= '<h1>' . thanks_title($opt, 1) . '</h1>';
 }
#  else {
#    $opt->{survey_counter}  ||= "logs/survey/$wizname.cnt";
#    $opt->{survey_file}    ||= "logs/survey/$wizname.txt";
#    push @$ary, "\tsurvey_file: $opt->{survey_file}";
#    push @$ary, "\tsurvey_counter: $opt->{survey_counter}";
#  }
 return;
}

sub gen_email_header {
 my ($wizname, $ref, $opt, $fnames) = @_;
 my $subject = errmsg($opt->{email_subject} || "Response to %s", $wizname);
 my $from_addr = $opt->{email_from};
 my $cc_addr = $opt->{email_cc};
 for(qw/ EMAIL_SURVEY EMAIL_INFO EMAIL_SERVICE /) {
   next unless $from_addr = $::Variable->{$_};
   last;
 }
 $from_addr ||= $Vend::Cfg->{MailOrderFrom} || $Vend::Cfg->{MailOrderTo};
 my $tpl = <<EOF;
From: $from_addr
Subject: $subject
To: {output_email}
EOF
 $tpl .= "Cc: $cc_addr\n" if $cc_addr;
 return $tpl;
}

sub gen_email_template {
 my ($wizname, $ref, $opt, $fnames) = @_;
 my $tpl = gen_email_header($wizname, $ref, $opt, $fnames);
 $tpl .= <<EOF;

{code?}Sequence: {code}
{/code?}Username: {username}
IP Address: $CGI::remote_addr
Host: $CGI::remote_host
Date: {date}
--------------------------------------------
EOF

 my @fields = grep /\S/, split /\s+/, $opt->{output_fields};
 if(! @fields) {
   @fields = @$fnames;
 }

 for(@fields) {
   $tpl .= "$_: {$_}\n";
 }
 $tpl .= "--------------------------------------------\n";
 return $tpl;
}

sub email_output {
 my ($wizname, $ref, $opt, $fnames) = @_;
#::logDebug("Called email_output");
 return unless  $opt->{output_email};

#::logDebug("email_output has an address of $opt->{output_email}");
 ## Check and see if already sent
 if(! $opt->{output_repeated} and already($wizname)) {
#::logDebug("email_output already done, repeated=$opt->{output_repeated} \
 already=" . ::uneval($Vend::Session->{surveys}));
   return;
 }

#::logDebug("email_output is continuing");
 my $tpl   = $opt->{email_template};
 if(! $tpl or $tpl !~ /\S/) {
   $tpl = gen_email_template($wizname, $ref, $opt, $fnames);
 }
 else {
   $opt->{email_template} =~ s/\s+$//;
   $opt->{email_template} =~ s/^\s+//;
   if($opt->{email_template} !~ /[\r\n]/) {
     $tpl = interpolate_html(Vend::Util::readfile($opt->{email_template}));
   }
   else {
     $tpl = $opt->{email_template};
   }
   if($tpl !~ /^[-\w]+:/) {
     $tpl = join "\n", gen_email_header($wizname, $ref, $opt, $fnames), $tpl;
   }
 }

#::logDebug("email_output tpl=$tpl");

 my @fields = grep /\S/, split /\s+/, $opt->{output_fields};
 if(! @fields) {
   @fields = @$fnames;
 }
 
 my $outref = { %$opt };

 $outref->{ip_address} = $CGI::remote_addr;
 $outref->{host_name} = $CGI::remote_host;
 $outref->{username} = $Vend::username || 'anonymous';
 $outref->{date} = POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime());

 for(@fields) {
   $outref->{$_} = $Values->{$_};
 }
 my $out = tag_attr_list($tpl, $outref);

 my $status;
 $status = $Tag->email_raw({}, $out)
   or ::logError("Failed to send survey email output:\n$out");
#::logDebug("email_output status=$status");
 return $status;
}

sub survey_log_to_file {
 my ($wizname, $ref, $opt, $fnames) = @_;

if(! $opt->{output_repeated} and already($wizname)) {
 return template_attr($wizname, $ref, $opt, $fnames);
}

my $fn   = $ref->{survey_file};
my $cfn  = $ref->{survey_counter};
my $sqlc = $ref->{survey_counter_sql};

if(! $fn) {
 $fn = $::Variable->{SURVEY_LOG_DIR} || 'logs/survey';
 $fn .= "/$wizname.txt";
}

if(! $cfn and ! $sqlc) {
   $cfn = $fn;
   $cfn =~ s/\.txt$//;
   $cfn .= '.cnt';
   $cfn =~ s:(.*/):$1.:;
 }

 my @fields = grep /\S/, split /\s+/, $opt->{output_fields};
 if(! @fields) {
   @fields = @$fnames;
 }
 if(! -f $fn) {
   my $string = join "\t",
           'code', 'ip_address', 'username', 'date', @fields;
   $string .= "\n";
   $Tag->write_relative_file($fn, $string);
 }

 my @o = $Tag->counter({file => $cfn, sql => $sqlc});
 push @o, $CGI::remote_addr;
 push @o, $Vend::username || 'anonymous';
 push @o, POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime());

 for(@fields) {
   my $result = $Values->{$_};
   $result =~ s/\r?\n/\r/g;
   $result =~ s/\t/  /g;
   push @o, $result;
 }

 ::logData($fn, @o);
 email_output($wizname, $ref, $opt, $fnames);
 already($wizname => 1) unless $opt->{output_repeated};
 return template_attr($wizname, $ref, $opt, $fnames);
}

my %survey_genfinal = (
 survey_log => \&survey_log_generate_final,
 email_only => sub {
   my ($wizname, $opt, $ary) = @_;
   push @$ary, title_and_message($opt, already($wizname));
   if($opt->{continue_template}) {
     push @$ary, "template: <<EOF";
     push @$ary, $opt->{continue_template};
     push @$ary, 'EOF';
   }
   return;
 },
 default => sub {
   my ($wizname, $opt, $ary) = @_;
   my $line = "final: ";
   $line .= thanks_title(
           $opt,
           $Vend::Session->{surveys}{$wizname},
           errmsg("Finished with %s", $wizname),
         );
   push @$ary, '';
   push @$ary, $line;
   if($opt->{continue_template}) {
     push @$ary, "template: <<EOF";
     push @$ary, $opt->{continue_template};
     push @$ary, 'EOF';
   }
   return;
 },
);

sub template_attr {
 my ($wizname, $ref, $opt, $fields) = @_; 
 my %attr;

 if(ref($fields) eq 'hash') {
   %attr = { %$fields };
 }

 $attr{TITLE} = $ref->{_page_title} || "Finished with $wizname...";
 $attr{PROMPT} = $ref->{prompt};
 $attr{ANCHOR} = $ref->{anchor} || 'Go';
 $attr{EXTRA} = $ref->{extra} || '';
 $attr{EXTRA} = " $attr{EXTRA}" if $attr{EXTRA};
 $attr{URL} = wizard_url($ref, $opt, $fields);
#::logDebug("generated ATTR is: " . uneval(\%attr));
 my $template = $ref->{template} || <<EOF;
<H1>{TITLE}</h1>
{PROMPT}
<p>
<blockquote>
<A HREF="{URL}"{EXTRA}>{ANCHOR}</A>
</blockquote>
EOF
 return tag_attr_list($template, \%attr);
}

sub wizard_url {
 my ($ref, $opt, $fields) = @_; 
 my %attr;
 my %ignore = qw/
         page 
         href
         template
         remap
         /;
       
 my $form = { };
 for(keys %$ref) {
   next if /^_/;
   next if $ignore{$_};
   $form->{$_} = $ref->{$_};
 }

 $form->{href} = $opt->{output_href} || $ref->{href} || $ref->{page};
 if($opt->{output_parm}) {
   my $ref = Vend::Util::scalar_to_hash($opt->{output_parm}) || {};
   for (keys %$ref) {
     $form->{$_} = $ref->{$_};
   }
 }
 $form->{form} = 'auto';
 for(@$fields) {
   $form->{$_} = $Values->{$_};
 }

 my $save = { };
 if($ref->{remap}) {
   my @pairs = split /[\s,\0]+/, $ref->{remap};
   for(@pairs) {
     my ($k, $v) = split /=/, $_;
     next unless $k and $v;
     my $val = delete($form->{$k}) || $save->{$k};
     $save->{$k} = $val;
     $form->{$v} = $val;
   }
 }

 return $Tag->area($form);
}

my %survey_auto = qw/
           survey_log   1
           email_only   1
           auto_bounce  1
         /;
## Called with:
##
##  $$dest = $sub->($wizname, $ref, $opt, \@vals);
##
##   $wizname name of wizard/survey
##   $ref     copy of final stanza of auto_wizard, hash ref with keys, can modify
##   %opts    Options auto_wizard was created with, can modify
##   @vals    Fields names collected in the wizard, can modify

my %survey_action = (
 survey_log => \&survey_log_to_file,
 auto_bounce => sub {
   my ($wizname, $ref, $opt, $fnames) = @_;
   my $url = wizard_url($ref, $opt, $fnames);
   email_output($wizname, $ref, $opt, $fnames);
   my $status = $Tag->deliver( { type => 'text/html', location => $url });
   return $status;
 },
 default => sub {
   my ($wizname, $ref, $opt, $fnames) = @_;
   $ref->{wizard_name} = $wizname;
   email_output($wizname, $ref, $opt, $fnames);
   return template_attr($wizname, $ref, $opt, $fnames);
 },
);

sub compile_wizard {
 my ($wizname, $opt, $script) = @_;
#Debug("script in: $script");
 $script =~ s/^\s+//;
 $script =~ s/\r\n/\n/g;
 $script =~ s/\r/\n/g;
 my @lines = split /\n/, $script;
 my $ref;

 my @pages;

 my $qip; # question in progress
 my $iip; # item in progress
 my $fip; # final in progress
 my $bip; # breaks in progress
 my $blip; # break labels in progress
 my $began; # We have begun

 my $sip;
 my $vip;
 my $mark;
 my $break;
 my %opts;

 if($opt->{db_id}) {
#Debug("found db_id=$opt->{db_id}");
   my ($t, $k) = split /:+/, $opt->{db_id}, 2;
   BUILDWIZ: {
     my $met = $Tag->meta_record($k, undef, $t)
       or last BUILDWIZ;
     my($structure) = delete $met->{ui_data_fields};
     delete $met->{extended};
     %opts = %$met;
#Debug("display type=$opts{display_type} met=" . ::uneval($met) );
     $met->{row_template} = $opt->{row_template}
       if $opt->{row_template};
     my $ids = $t . '::' . $k . '::';
     $structure =~ s/\r\n?/\n/g;
     my $string = "\n\n$structure";
     my %break;
     while ($string =~ s/\n+(?:\n[ \t]*=(.*))?\n+[ \t]*(\w[:.\w]+)/\n$2/) {
       $break{$2} = $1;
     }
     $string =~ s/^[\s,\0]+//;
     $string =~ s/[\s,\0]+$//;
     $string =~ s/[,\0\s]+/ /g;
     my @fields = split /\s+/, $string;
     my @out = "$k: $met->{label}";
     my $i = 1;
     my $fields_line = join "\t", @fields;
     for(@fields) {
       if($break{$_}) {
         push @out, "$i: $break{$_}";
         $i++;
       }
       push @out, "\tdb_id: $ids$_";
       push @out, '';
     }
     $opts{output_fields} ||= join " ", @fields;
     my $otype = $opts{output_type} || 'default';
     my $sub = $survey_genfinal{$otype} || $survey_genfinal{default};
     $sub->($k, \%opts, \@out);
     @lines = @out;
   }
 }

#Debug("Found some lines, number=" . scalar @lines);
#Debug("display type=$opts{display_type}");
 for(@lines) {
   if($mark) {
     $sip .= "$_\n", next
       unless $_ eq $mark;
     $_ = $sip;
     undef $mark;
     undef $sip;
   }

   if (s/<<(\w+)$//) {
     $mark = $1;
     $sip = $_;
     next;
   }

   s/\s+$//;

   if(! $_) {
     undef $iip;
     next;
   }

   if(! $ref) {
     if(/^(\w+):\s*(.*)/) {
       $began = 1;
       $wizname ||= $1;
       my $title = $2;
       $ref = {
           _page_name => 'begin',
           _name => [],
           title => $title,
           %opts,
         };
     }
     next;
   }

   if(/^(\d+)[:.]\s*(.*)/) {
     my $pn = $1; my $title = $2;
     push @pages, $ref;
     my $lastpage = $ref->{_page_name};
     $qip = [];
     undef $bip;
     undef $blip;
     $ref = {  
           _page_name    => $pn,
           _name      => $qip,
           _breaks      => $bip,
           _break_labels  => $blip,
           _page_title    => $title,
           };
     next;
   }
   if(/^final[:.]\s*(.*)/) {
     undef $qip;
     undef $iip;
     $fip = 1;
     my $title = $1;
     push @pages, $ref;
     my $lastpage = $ref->{_page_name};
     $ref = { _page_name => 'final', _page_title => $title};
     next;
   }


   if($fip) {
     s/^\s+//;
     unless (/^([A-Za-z]\w+)(?:=([^:]+))?\s*:\s*(.*)/s) {
       $Tag->warnings(qq{Unrecognized "$_" in middle of script.});
       next;
     }
     my $thing    = $1;
     my $modifier = $2;
     my $value    = $3;
     if($modifier) {
       $ref->{_modifier} ||= {};
       $ref->{_modifier}{$thing} = $modifier;
     }
     $ref->{$thing} = $value;
     next;
   }

   if($qip) {
     if(/^(itl|perl)(?:_condition)?:\s*(.*)$/s) {
       if(! $ref->{_condition}) {
         $ref->{_condition_type} = $1;
         $ref->{_condition} = $2;
       }
       else {
         $Tag->error(
           "%s_condition: cannot set twice in wizard %s screen %s",
           $1,
           $pages[0]->{_title},
           $ref->{_page_name},
         );
         return;
       }
       next;
     }
     elsif(/^opt:\s*(.*)$/s) {
       my $option = $1;
       $option =~ s/\s+$//;
       my ($n, $v) = split /=/, $option, 2;
       my $o = $ref->{_options} ||= [];
       push @$o, $n, $v;
       next;
     }

     s/^\s+//;
     unless (/^([A-Za-z]\w+)(?:=([^:]+))?\s*:\s*(.*)/s) {
       $Tag->warnings(qq{Unrecognized "$_" in middle of script.});
       next;
     }
     my $thing = $1;
     my $modifier = $2;
     my $value = $3;

     if(! $iip) {

       ## This redoes the loop
       if($thing eq 'name') {
         $thing = $value;
         undef $value;
       }
       elsif($thing eq 'break') {
         $break = $value;
         $break =~ s/,/&#41;/g;
         $ref->{_breaks} ||= ($bip = []);
         $ref->{_break_labels} ||= ($blip = []);
         next;
       }
       elsif($thing eq 'db_id') {
         my ($t, $survey, $name) = split /:+/, $value, 3;
         $thing = $name;
         my $key = $survey . '::' . $name;
         my $meta = $Tag->meta_record($key, undef, $t);
         if($meta) {
           for(keys %$meta) {
             $ref->{$_} ||= {};
             $ref->{$_}{$thing} = $meta->{$_};
           }
         }
         $ref->{name}{$thing} = $thing;
#::logDebug("meta record is " . ::uneval($meta));

         undef $value;
       }

       $iip = $thing;
       push @$qip, $iip;
       if($break) {
         push @$bip, $iip;
         push @$blip, "$iip=$break";
         undef $break;
       }
       $ref->{label}{$iip} = $value if $value;
       next;
     }

     if($modifier) {
       $ref->{_modifier} ||= {};
       $ref->{_modifier}{$thing} ||= {};
       $ref->{_modifier}{$thing}{$iip} = $modifier;
     }
     $ref->{$thing} ||= {};
     $ref->{$thing}{$iip} = $value;
   }
   else {
     unless (/^([A-Za-z]\w+)(?:=([^:]+))?\s*:\s*(.*)/s) {
       $Tag->warnings(qq{Unrecognized "$_" in beginning section of script.});
       next;
     }
     my $thing = $1;
     my $modifier = $2;
     my $value = $3;
     $ref->{$thing} = $value;
   }
 }
 push @pages, $ref;
 $wizname ||= 'default';
 my $wiz_ary = $Session->{auto_wizard} ||= {};
 $wiz_ary->{$wizname} = \@pages;
#Debug("Wizard $wizname=" . ::uneval(\@pages));
 return $wizname;
}

sub {
 my ($wizname, $opt, $body) = @_;

 my $dest;
 $wizname ||= $CGI->{wizard_name};

 if($opt->{scratch}) {
   $Tag->tmp($opt->{scratch});
   $::Scratch->{$opt->{scratch}} ||= '';
   $dest = \$::Scratch->{$opt->{scratch}};
 }
 else {
   $Tmp->{auto_wizard} ||= '';
   $dest = \$Tmp->{auto_wizard};
 }
 return $$dest if $opt->{show} and ! $opt->{run};

 if($opt->{compile} eq 'auto') {
   $Session->{auto_wizard} ||= {};
   undef $opt->{compile} if $wizname && $Session->{auto_wizard}{$wizname};
   $opt->{show} = 1 unless defined $opt->{show};
   $opt->{run} = 1;
 }

 if($opt->{compile}) {
   my $n;
   $n = compile_wizard(@_)
     or do {
       ::logError(
         $$dest = errmsg(
                     "Wizard %s failed to compile.",
                     $wizname,
                   )
             );
       return;
       };
#Debug("compiler returned wizname=$n");
   $wizname = $n;
   undef $body;
 }

 if(! defined $opt->{run}) {
   $opt->{run} = 1;
   $opt->{show} = 0 if ! defined $opt->{show};
 }

 my $title_var = $opt->{title_scratch}   || 'page_title';
 my $banner_var = $opt->{banner_scratch} || 'page_banner';
 my $wiz;

 $wizname ||= $CGI->{wizard_name} || 'default';
#Debug("wizname=$wizname");

 return unless $wiz = $Vend::Session->{auto_wizard}{$wizname};
#Debug("we have a wiz! wizname=$wizname");

 my $beg = $wiz->[0];
 my $fin = $wiz->[-1];

 for($beg, $fin) {
   return "Bad wizard!" unless ref($_) eq 'HASH';
 }

 my $lastwiz = $#$wiz;
 my $lastpage = $CGI->{wizard_page} || 0;
 my $current_page;

 my %opts;
 copyref($beg, \%opts);

 # Get rid of internal stuff
 for(keys %opts) {
   next unless /^_/;
   delete $opts{$_};
 }

 if($CGI->{ui_wizard_action} eq 'Back') {
   $current_page = $lastpage - 1;
 }
 elsif($CGI->{ui_wizard_action} eq 'Cancel') {
   $current_page = 0;
 }
 elsif($CGI->{ui_wizard_action} eq 'Next') {
   $current_page = $lastpage + 1;
 }
 else {
   $current_page = $lastpage;
 }

 my $finished;
 my $condition_done;
 my $optref;
#::logDebug("Getting screens");
 GETSCREEN: {
   $optref = $wiz->[$current_page];
   if(! $condition_done and $optref->{_condition}) {
     $condition_done = 1;
     my $result;
     if($optref->{_condition_type} eq 'itl') {
       eval {
         $result = interpolate_html($optref->{_condition});
       };
       $result =~ s/\s+$//;
       $result =~ s/.*\s//s;
       $result += 0;
       $current_page += $result;
     }
     else {
       eval {
         $result = $ready_safe->reval($optref->{_condition});
       };
       if($@) {
         $Tag->error(
           "error during perl conditional: $@\ncode was:\n%s",
           $@,
           $optref->{_condition},
         );
         $current_page -= 1;
       }
       $result += 0;
#::logDebug("did perl conditional, result=$result");
       $current_page += $result;
     }
     redo GETSCREEN;
   }

   if($current_page <= 0) {
     $current_page = 1;
   }
   elsif ( ($current_page + 1) == $lastwiz ) {
     $opts{next_text} = errmsg('Finish')
       if $survey_auto{$opts{output_type}} or $fin->{auto};
   }
   elsif ($current_page >= $lastwiz) {
     $finished = 1;
   }
   $optref = $wiz->[$current_page];
 }
 
 unless($current_page <= 1) {
   delete $opts{intro_text};
   delete $optref->{intro_text};
 }

 my %modsub = (
     i    => sub {
             my $val = shift;
#              ::logDebug("running interpolate of $val");
             return interpolate_html($val);
           },
     default => sub {
             my $val = shift;
             my $filters = join " ", @_;
             return $Tag->filter($filters, $val);
           },
   );

 $Scratch->{$title_var}  = $optref->{_page_title};
 $Scratch->{$banner_var} = $optref->{_page_title};

 if($finished) {
     my $ref = { %$fin };

     my $mod;
     if( $mod = delete $ref->{_modifier}) {
       for(keys %$ref) {
         next if /^_/;
         if(my $m = $mod->{$_}) {
           my $v = $ref->{$_};
           my $sub = $modsub{$m} || $modsub{default};
           $ref->{$_} = $sub->($ref->{$_}, $m);
         }
       }
     }

     my @vals;
     for my $w (@$wiz) {
       next unless ref($w->{_name}) eq 'ARRAY';
       push @vals, @{$w->{_name}};
     }

     my $otype = $opts{output_type};
     $otype ||= 'auto_bounce' if $ref->{auto};
     my $sub = $survey_action{$otype} || $survey_action{default};
     $$dest = $sub->($wizname, $ref, \%opts, \@vals);
     return $$dest if $opt->{show};
     return;
#Debug("finished, page ref=" . uneval($ref));

 }

#Debug("we have a wiz=$wizname! current_page = $current_page");

#Debug("optref=" . $Tag->uneval(undef, $optref));

#::logDebug("prepping to walk optref");

### TODO: Find bad reference when no section title...

 my $name = $optref->{_name} || die;
#  $Scratch->{page_title} = $optref->{_page_title};

 if($optref->{_breaks} and ref($optref->{_breaks}) eq 'ARRAY') {
   $opts{ui_break_before} = join " ", @{$optref->{_breaks}};
   $opts{ui_break_before_label} = join ",", @{$optref->{_break_labels}};
 }

 if(my $o = $optref->{_options}) {
   for (my $i = 0; $i < @$o; $i += 2) {
     $opts{$o->[$i]} = $o->[$i + 1];
   }
 }

 $opts{form_name} ||= 'wizard';
 $opts{all_errors} = '1';
 $opts{hidden} = {
   wizard_name => $wizname,
   wizard_page => $current_page,
 };

 $opts{wizard} = 1;
 $opts{notable} = 1;
 $opts{no_meta} = 1;
 $opts{defaults} = 1;
 $opts{mv_cancelpage} ||= 'index';
 $opts{row_template} ||= $opt->{row_template} || <<'EOF' unless $opts{display_type};
{HELP?}<td>&nbsp;</td><td>
    <span style="color: blue">{HELP}</span>
  {HELP_URL?}<BR><A HREF="{HELP_URL}">more help</A>{/HELP_URL?}
  </td>
 </tr>
   <tr class=rnorm>
 {/HELP?}
  <td class=cdata width="20%" valign=top> 
    {LABEL}
 </td>
<td class=cdata width=500> 
        $WIDGET$
</td>
</tr>
<tr class=rspacer>
<td colspan=2><img src="bg.gif" height=1 width=1></td>
EOF

$opts{ui_wizard_fields} = join " ", @$name;
$opts{mv_nextpage} = $Global::Variable->{MV_PAGE};
$opts{mv_prevpage} = $Global::Variable->{MV_PAGE} if $current_page != 1;
$opts{bottom_buttons} = 1;

#::logDebug("walking optref");
my $mod = $optref->{_modifier} || '';
 for(keys %$optref) {
   next if /^_/;
   next if $overall_opt{$_};
   next unless ref($optref->{$_}) eq 'HASH';
   $opts{$_} = {} if ref($opts{$_}) ne 'HASH';
   Vend::Util::copyref($optref->{$_}, $opts{$_});
   my $m;
   if($mod and $m = $mod->{$_}) {
     my $r = $opts{$_};
     for my $k (keys %$r) {
       next unless $m->{$k};
       my @subs = split /\s*,\s*/, $m->{$k};
       for(@subs) {
         my $sub = $modsub{$_} || $modsub{default};
         $r->{$k} = $sub->($r->{$k}, $_);
       }
     }
   }
 }

 $opts{widget} ||= {};
 if( my $r = delete $opts{type} ) {
   for(keys %$r) {
     $opts{widget}{$_} = $r->{$_};
   }
 }

 delete $opts{type};
 # Prevent ui_data_fields from parent corrupting wizard
 delete $opts{ui_data_fields};
 delete $opts{extended};
#::logDebug("calling table_editor opts=" . ::uneval(\%opts));
 $$dest = $Tag->table_editor( {all_opts => \%opts });
 if($$dest !~ /<form\s+/i) {
   my $msg = errmsg("Auto wizard failed to run wizard %s.", $name);
   $$dest .= $Tag->error({ show => 1, set => $msg });
 }

 return $$dest if $opt->{show};
 return;
}
EOR

AUTHORS

Interchange Development Group

SEE ALSO

DocBook! Interchange!