# Copyright 2002-2017 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.

UserTag  survey-wizard  Order     name
UserTag  survey-wizard  AddAttr
UserTag  survey-wizard  HasEndTag
UserTag  survey-wizard  Version   1.5
UserTag  survey-wizard  Routine   <<EOR

use vars qw/$Session $Tag $CGI $Tmp $Scratch $Values $ready_safe/;
	
my @wanted_opts = qw/
	already_message
	already_title
	attach_fields
	bottom_buttons
	break_row_class
	combo_row_class
	data_cell_class
	data_row_class
	page_template_1
	page_template_2
	page_template_3
	page_template_4
	page_template_5
	page_template_6
	page_template_7
	page_template_8
	page_template_9
	page_template_10
	page_template_11
	page_template_12
	page_template_13
	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 sw_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 sw_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 sw_title_and_message {
	my ($opt, $already) = @_;
	my $tt = sw_thanks_title($opt, $already);
	my $tm = sw_thanks_message($opt, $already);
	return (
				'',
				"final: $tt",
				'template: <<EOF',
				$tm,
				'EOF',
			);
}

sub sw_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 sw_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 = sw_already($wizname);

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

	if ( $done ) {
		$opt->{intro_text} .= '<h1>' . sw_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 sw_find_attachments {
	my ($ref, $opt) = @_;
	my @fields = @$ref;
	my @attachments;
	if($opt->{file_upload} and $opt->{attach_fields}) {
		@attachments = grep /\S/, split /[\s,\0]/, $opt->{attach_fields};
		my %att;
		@att{@attachments} = @attachments;
		@$ref = grep ! $att{$_}, @$ref;
		@fields = grep ! $att{$_}, @fields;
	}
	return wantarray ? @attachments : \@attachments;
}

sub sw_non_attachments {
	my ($ref, $opt) = @_;
	my @fields = @$ref;
	my @attachments;
	if($opt->{file_upload} and $opt->{attach_fields}) {
		@attachments = grep /\S/, split /[\s,\0]/, $opt->{attach_fields};
		my %att;
		@att{@attachments} = @attachments;
		@fields = grep ! $att{$_}, @fields;
	}
	return wantarray ? @fields : \@fields;
}

sub sw_gen_email_template {
	my ($wizname, $ref, $opt, $fnames) = @_;
	my $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;
	}

	@fields = sw_non_attachments(\@fields, $opt);

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

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

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

#::logDebug("sw_email_output is continuing");
	my $tpl	 = $opt->{email_template};
	if(! $tpl or $tpl !~ /\S/) {
		$tpl = sw_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};
		}
	}
	my $subject = errmsg($opt->{email_subject} || "Response to %s", $wizname);
	my $from_addr = $opt->{email_from};
	my $cc_addr = $opt->{email_cc};
	if(! $from_addr) {
		for(qw/ EMAIL_SURVEY EMAIL_INFO EMAIL_SERVICE /) {
			next unless $from_addr = $::Variable->{$_};
			last;
		}
	}
	$from_addr ||= $Vend::Cfg->{MailOrderFrom} || $Vend::Cfg->{MailOrderTo};

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

	my @fields = grep /\S/, split /\s+/, $opt->{output_fields};
	if(! @fields) {
		@fields = @$fnames;
	}
	
	my @attachments = sw_find_attachments(\@fields, $opt);
#::logDebug("Found (in=$opt->{attach_fields}) attachments: " . join(",", @attachments));

	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());

	my $attach;
	my $ul = $::Scratch->{user_uploads};

	for my $afield (@attachments) {
		next unless $ul->{$afield};
		$attach ||= [];
		my %a = (
			path => $ul->{$afield},
		);
		if($Vend::Session->{logged_in}) {
			my $dn = $::Variable->{SURVEY_LOG_DIR} || 'logs/survey';
			$dn .= "/user_upload/$Vend::username";
			$dn = Vend::Util::escape_chars($dn);
			File::Path::mkpath($dn) unless -e $dn;
			File::Copy::copy($ul->{$afield}, $dn);
		}
		push @$attach, \%a;
	}

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

	my %email = (
		from => $from_addr,
		to => $opt->{output_email},
		subject => $subject,
		cc => $cc_addr,
		attach => $attach,
	);
	my $status;
	$status = $Tag->email(\%email, $out)
		or ::logError("Failed to send survey email output:\n$out");
#::logDebug("sw_email_output status=$status");
	return $status;
}

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

	if(! $opt->{output_repeated} and sw_already($wizname)) {
		return sw_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);
	sw_email_output($wizname, $ref, $opt, $fnames);
	sw_already($wizname => 1) unless $opt->{output_repeated};
	return sw_template_attr($wizname, $ref, $opt, $fnames);
}

my %survey_genfinal = (
	survey_log => \&sw_survey_log_generate_final,
	email_only => sub {
		my ($wizname, $opt, $ary) = @_;
		push @$ary, sw_title_and_message($opt, sw_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 .= sw_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 sw_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} = sw_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 sw_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 => \&sw_survey_log_to_file,
	auto_bounce => sub {
		my ($wizname, $ref, $opt, $fnames) = @_;
		my $url = sw_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;
		sw_email_output($wizname, $ref, $opt, $fnames);
		return sw_template_attr($wizname, $ref, $opt, $fnames);
	},
);

sub sw_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]+$//;

			my @pic = grep /\S/, split /[\r\n]+/, $string;

#Debug("pic=" . ::uneval(\@pic) );

			$string =~ s/[,\0\s]+/ /g;
			my @fields = split /\s+/, $string;
			my @out = "$k: $met->{label}";
			my $i = 1;

			for my $sf (@fields) {
				if($break{$sf}) {
					my @flines;
					push @out, "$i: $break{$sf}";
					my $start = 0;
					for my $nf (@pic) {
						my @f = split /[,\0\s]+/, $nf;
						if($start) {
							if($break{$f[0]}) {
								last;
							}
							else {
								push @flines, $nf;
							}
						}
						elsif($sf eq $f[0]) {
							$start = 1;	
							push @flines, $nf;
						}
					}
					push @out, "layout: " . join "|", @flines;
#Debug("layout: " . join "|", @flines);
					$i++;
				}
				push @out, "\tdb_id: $ids$sf";
				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(/^layout:\s*(.*)/) {
			my @lines = split /\|/, $1;
			$ref->{wizard_layout} = join "\n", @lines;
			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 = sw_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: %s\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

	if($optref->{wizard_layout} =~ / /) {
		$opts{ui_wizard_fields} = $optref->{wizard_layout};
		$opts{display_type} = $opts{multi_display_type} || '3';
	}
	else {
		$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}, $_);
				}
			}
		}
	}

	if(my $tpl = $opts{"page_template_$current_page"}) {
#::logDebug("yup, found a template=$tpl");
		$opts{row_template} = '';
		$opts{display_type} = 'default';
		$opts{fields_template_only} = 1;
		$opts{overall_template} = $tpl;
	}

	$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
