709 lines
26 KiB
Plaintext
Executable File
709 lines
26 KiB
Plaintext
Executable File
<?_code
|
|
{
|
|
use strict;
|
|
use vars qw(%GET %POST %RULES %TYPENAME $title $body);
|
|
|
|
# init title and body variables
|
|
$title = $ML{'.title'};
|
|
$body = '';
|
|
|
|
# some rules used for error checking
|
|
%RULES = (
|
|
"elements" => {
|
|
"max" => 15, # maximum total number of elements allowed
|
|
},
|
|
"items" => {
|
|
"min" => 1, # minimum number of options
|
|
"start" => 5, # number of items shown at start
|
|
"max" => 15, # max number of options
|
|
"maxlength" => 500, # max length of an option's textual value, min is implicitly 0
|
|
"more" => 5, # number of items to add when requesting more
|
|
},
|
|
"question" => {
|
|
"maxlength" => 1000, # maximum length of question allowed
|
|
},
|
|
"pollname" => {
|
|
"maxlength" => 1000, # maximum length of poll name allowed
|
|
},
|
|
"text" => {
|
|
"size" => 30, # default size of a text element
|
|
"maxlength" => 50, # default maxlength of a text element
|
|
},
|
|
"size" => {
|
|
"min" => 1, # minimum allowed size value for a text element
|
|
"max" => 100, # maximum allowed size value for a text element
|
|
},
|
|
"maxlength" => {
|
|
"min" => 1, # minimum allowed maxlength value for a text element
|
|
"max" => 255, # maximum allowed maxlength value for a text element
|
|
},
|
|
"scale" => {
|
|
"from" => 1, # default from value for a scale
|
|
"to" => 10, # default to value for a scale
|
|
"by" => 1, # default by value for a scale
|
|
"maxitems" => 20, # maximum number of items allowed in a scale
|
|
},
|
|
);
|
|
|
|
# type name mappings
|
|
%TYPENAME = ( "radio" => $ML{'.type.radio'},
|
|
"check" => $ML{'.type.check'},
|
|
"drop" => $ML{'.type.drop'},
|
|
"text" => $ML{'.type.text'},
|
|
"scale" => $ML{'.type.scale'},
|
|
);
|
|
|
|
|
|
#######################################################
|
|
#
|
|
# Generate page for the user
|
|
#
|
|
|
|
# authenticate - but bypass db hit if we think they're already in.
|
|
my $remote = LJ::get_remote();
|
|
unless ($remote) {
|
|
$body = "<?needlogin?>";
|
|
return;
|
|
}
|
|
|
|
my $authas = $GET{'authas'} || $remote->{'user'};
|
|
my $u = LJ::get_authas_user($authas);
|
|
unless ($u) {
|
|
$body = "<?h1 $ML{'Error'} h1?><?p $ML{'error.invalidauth'} p?>";
|
|
return;
|
|
}
|
|
|
|
# first pageview, show authas and pregeneration hook
|
|
if (! LJ::did_post() || $POST{'start_over'}) {
|
|
|
|
# authas switcher form
|
|
$body .= "<form method='get' action='create.bml'>\n";
|
|
$body .= LJ::make_authas_select($remote, { 'authas' => $GET{'authas'}, 'cap' => 'makepoll' }) . "\n";
|
|
$body .= "</form>\n\n";
|
|
|
|
# show pregenerate options
|
|
$body .= LJ::run_hook('poll_pregeneration_html', $u, $authas);
|
|
}
|
|
|
|
# does the selected user have the 'makepoll' cap?
|
|
unless (LJ::get_cap($u, "makepoll")) {
|
|
$body .= "<?h1 $ML{'Sorry'} h1?><?p $ML{'.error.accttype'} p?>";
|
|
return;
|
|
}
|
|
|
|
# extra arguments for get requests
|
|
my $getextra = $authas ne $remote->{'user'} ? "?authas=$authas" : '';
|
|
|
|
|
|
#######################################################
|
|
#
|
|
# Function definitions
|
|
#
|
|
|
|
# builds a %poll object
|
|
my $build_poll = sub {
|
|
my $err = shift;
|
|
|
|
# initialize the hash
|
|
my $poll = {
|
|
"name" => "",
|
|
"count" => "0",
|
|
"whoview" => "all",
|
|
"whovote" => "all",
|
|
"pq" => [],
|
|
};
|
|
|
|
# make sure they don't plug in an outrageous count
|
|
$POST{'count'} = 0 if $POST{'count'} < 0;
|
|
$POST{'count'} = $RULES{'elements'}->{'max'}
|
|
if $POST{'count'} > $RULES{'elements'}->{'max'};
|
|
|
|
# form properties
|
|
foreach (qw(count name whoview whovote)) {
|
|
$poll->{$_} = $POST{$_} if $POST{$_};
|
|
}
|
|
|
|
# go through the count to build our hash
|
|
foreach my $q (0..$poll->{'count'}-1) {
|
|
|
|
# sanify 'opts' form elements at this level
|
|
# so we don't have to do it later
|
|
my $opts = "pq_${q}_opts";
|
|
$POST{$opts} = 0 if $POST{$opts} && $POST{$opts} < 0;
|
|
$POST{$opts} = $RULES{'items'}->{'max'}
|
|
if $POST{$opts} > $RULES{'items'}->{'max'};
|
|
|
|
# question record
|
|
my $qrec = {};
|
|
|
|
# validate question attributes
|
|
foreach my $atr (qw(type question opts size maxlength from to by)) {
|
|
my $val = $POST{"pq_${q}_$atr"};
|
|
next unless defined $val;
|
|
|
|
# ignore invalid types?
|
|
next if $atr eq 'type' && $val !~ /^(radio|check|drop|text|scale)$/;
|
|
|
|
# question too long/nonexistant
|
|
if ($atr eq 'question') {
|
|
|
|
if (! $val) {
|
|
$qrec->{$atr} = $val;
|
|
$err->{$q}->{$atr} = $ML{'.error.notext'};
|
|
} elsif (length($val) > $RULES{$atr}->{'maxlength'}) {
|
|
$qrec->{$atr} = substr($val, 0, $RULES{$atr}->{'maxlength'});
|
|
} else {
|
|
$qrec->{$atr} = $val;
|
|
}
|
|
|
|
next;
|
|
}
|
|
|
|
# opts too long?
|
|
if ($atr eq 'opts') {
|
|
$qrec->{$atr} = int($val);
|
|
next;
|
|
}
|
|
|
|
# size too short/long?
|
|
if ($atr eq 'size') {
|
|
$qrec->{$atr} = int($val);
|
|
|
|
if ($qrec->{$atr} > $RULES{$atr}->{'max'} || $qrec->{$atr} < $RULES{$atr}->{'min'}) {
|
|
$err->{$q}->{$atr} = BML::ml('.error.pqsizeinvalid', { 'min' => $RULES{$atr}->{'min'}, 'max' => $RULES{$atr}->{'max'} });
|
|
}
|
|
|
|
next;
|
|
}
|
|
|
|
# maxlength too short/long?
|
|
if ($atr eq 'maxlength') {
|
|
$qrec->{$atr} = int($val);
|
|
|
|
if ($qrec->{$atr} > $RULES{$atr}->{'max'} || $qrec->{$atr} < $RULES{$atr}->{'min'}) {
|
|
$err->{$q}->{$atr} = BML::ml('.error.pqmaxlengthinvalid', { 'min' => $RULES{'maxlength'}->{'min'}, 'max' => $RULES{'maxlength'}->{'max'} });
|
|
}
|
|
|
|
next;
|
|
}
|
|
|
|
# from/to/by -- scale
|
|
if ($atr eq 'from') {
|
|
$qrec->{'to'} = int($POST{"pq_${q}_to"}) || 0;
|
|
$qrec->{'from'} = int($POST{"pq_${q}_from"}) || 0;
|
|
$qrec->{'by'} = int($POST{"pq_${q}_by"}) >= 1 ? int($POST{"pq_${q}_by"}) : 1;
|
|
|
|
if ($qrec->{'by'} < $RULES{'by'}->{'min'}) {
|
|
$err->{$q}->{'by'} = BML::ml('.error.scalemininvalid', { 'min' => $RULES{'by'}->{'min'} });
|
|
}
|
|
|
|
if ($qrec->{'from'} >= $qrec->{'to'}) {
|
|
$err->{$q}->{'from'} = $ML{'.error.scalemaxlessmin'};
|
|
}
|
|
|
|
if ((($qrec->{'to'}-$qrec->{'from'})/$qrec->{'by'}) > $RULES{'scale'}->{'maxitems'}) {
|
|
$err->{$q}->{'to'} = BML::ml('.error.scaletoobig', { 'max' => $RULES{'scale'}->{'maxitems'} });
|
|
}
|
|
|
|
next;
|
|
}
|
|
|
|
# otherwise, let it by.
|
|
$qrec->{$atr} = $val;
|
|
}
|
|
|
|
# insert record into poll structure
|
|
$poll->{'pq'}->[$q] = $qrec;
|
|
|
|
my $num_opts = 0;
|
|
foreach my $o (0..$qrec->{'opts'}-1) {
|
|
next unless $POST{"pq_${q}_opt_$o"};
|
|
|
|
if (length($POST{"pq_${q}_opt_$o"}) > $RULES{'items'}->{'maxlength'}) {
|
|
$qrec->{'opt'}->[$o] = substr($POST{"pq_${q}_opt_$o"}, 0, $RULES{'items'}->{'maxlength'});
|
|
$err->{$q}->{$o}->{'items'} = $ML{'.error.texttoobig'};
|
|
} else {
|
|
# no change necessary
|
|
$qrec->{'opt'}->[$o] = $POST{"pq_${q}_opt_$o"};
|
|
}
|
|
|
|
$num_opts++;
|
|
}
|
|
|
|
# too few options specified?
|
|
if ($num_opts < $RULES{'items'}->{'min'} && $qrec->{'type'} =~ /^(drop|check|radio)$/) {
|
|
$err->{$q}->{'items'} = $ML{'.error.allitemsblank'};
|
|
}
|
|
}
|
|
|
|
|
|
# closure to apply action to poll object, given 'type', 'item', and 'val'
|
|
my $do_action = sub {
|
|
my ($type, $item, $val) = @_;
|
|
return unless $type && defined $item && defined $val;
|
|
|
|
# move action
|
|
if ($type eq "move") {
|
|
|
|
# up or down?
|
|
my $adj = undef;
|
|
if ($val eq 'up' && $item-1 >= 0) {
|
|
$adj = $item - 1;
|
|
} elsif ($val eq 'dn' && $item+1 <= $poll->{'count'}) {
|
|
$adj = $item + 1;
|
|
}
|
|
|
|
# invalid action
|
|
return unless $adj;
|
|
|
|
# swap poll items and error references
|
|
my $swap = sub { return (@_[1], @_[0]) };
|
|
|
|
($poll->{'pq'}->[$adj], $poll->{'pq'}->[$item]) =
|
|
$swap->($poll->{'pq'}->[$adj], $poll->{'pq'}->[$item]);
|
|
|
|
($err->{$adj}, $err->{$item}) =
|
|
$swap->($err->{$adj}, $err->{$item});
|
|
|
|
return;
|
|
}
|
|
|
|
# delete action
|
|
if ($type eq "delete") {
|
|
|
|
# delete from poll and decrement question count
|
|
splice(@{$poll->{"pq"}}, $item, 1);
|
|
$poll->{'count'}--;
|
|
delete $err->{$item};
|
|
|
|
return;
|
|
}
|
|
|
|
# request more options
|
|
if ($type eq "request") {
|
|
|
|
# add more items
|
|
$poll->{"pq"}->[$item]->{'opts'} += $RULES{'items'}->{'more'};
|
|
$poll->{'pq'}->[$item]->{'opts'} = $RULES{'items'}->{'max'}
|
|
if @{$poll->{'pq'}}[$item]->{'opts'} > $RULES{'items'}->{'max'};
|
|
|
|
return;
|
|
}
|
|
|
|
# insert
|
|
if ($type eq "insert") {
|
|
|
|
# increase poll count
|
|
$poll->{'count'}++;
|
|
|
|
# splice new item in
|
|
splice (
|
|
@{$poll->{'pq'}},
|
|
$item,
|
|
0,
|
|
{
|
|
"question" => '',
|
|
"type" => $val,
|
|
"opts" => ($val =~ /^(radio|drop|check)$/) ? $RULES{'items'}->{'start'} : 0,
|
|
"opt" => [],
|
|
}
|
|
);
|
|
|
|
return;
|
|
}
|
|
};
|
|
|
|
# go through the count again, this time apply requested actions
|
|
foreach my $q (0..$poll->{'count'}) {
|
|
|
|
# if there is an action, perform the action
|
|
foreach my $act (qw(move delete insert request)) {
|
|
|
|
# images stick an .x and .y on inputs
|
|
my $do = $POST{"$act:$q:do.x"} ? "$act:$q:do.x" : "$act:$q:do";
|
|
|
|
# catches everything but move
|
|
if ($POST{$do}) {
|
|
|
|
# catches deletes, requests, etc
|
|
if ($act ne 'insert') {
|
|
$do_action->($act, $q, $act);
|
|
next;
|
|
}
|
|
|
|
# catches inserts
|
|
if ($POST{"$act:$q"} =~ /^(radio|check|drop|text|scale)$/) {
|
|
$do_action->($act, $q, $1);
|
|
next;
|
|
}
|
|
}
|
|
|
|
# catches moves
|
|
if ($POST{"$act:$q:up.x"} =~ /\d+/ || $POST{"$act:$q:dn.x"} =~ /\d+/) {
|
|
$do_action->($act, $q, $POST{"$act:$q:up.x"} ? 'up' : 'dn');
|
|
next;
|
|
}
|
|
|
|
}
|
|
}
|
|
|
|
# all arguments are refs, nothing to return
|
|
return $poll;
|
|
};
|
|
|
|
# generate edit form to be displayed to user
|
|
my $make_form = sub {
|
|
my ($poll, $err) = @_;
|
|
|
|
my $ret;
|
|
|
|
### Form Header
|
|
|
|
$ret .= "<form method='post' action='create.bml$getextra'>\n";
|
|
$ret .= LJ::html_hidden('count', $poll->{'count'});
|
|
|
|
$ret .= "<div style='margin: 10px 0 20px 40px'><b>$ML{'.haserrors'}</b></div>\n"
|
|
if %$err;
|
|
|
|
### Poll Properties -- name, whovote, whoview
|
|
|
|
$ret .= "<?h1 $ML{'.properties'} h1?>\n";
|
|
|
|
$ret .= "<div style='margin-left: 40px; margin-bottom: 20px'>\n";
|
|
$ret .= "<p>$ML{'.whoview'}<br /><select name='whoview'>\n";
|
|
foreach ( qw(all friends none) ) {
|
|
$ret .= "<option value='$_'";
|
|
$ret .= " selected='selected'" if $poll->{'whoview'} eq $_;
|
|
$ret .= ">" . $ML{'poll.security.'.$_} . "</option>\n";
|
|
}
|
|
$ret .= "</select></p>\n";
|
|
|
|
$ret .= "<p>$ML{'.whovote'}<br /><select name='whovote'>\n";
|
|
foreach ( qw(all friends) ) {
|
|
$ret .= "<option value='$_'";
|
|
$ret .= " selected='selected'" if $poll->{'whovote'} eq $_;
|
|
$ret .= ">" . $ML{'poll.security.'.$_} . "\n";
|
|
}
|
|
$ret .= "</select></p>\n";
|
|
|
|
$ret .= "$ML{'.pollname'}<br />";
|
|
$ret .= LJ::html_text({ 'name' => 'name', 'size' => '50',
|
|
'maxlength' => $RULES{'pollname'}->{'maxlength'},
|
|
'value' => $poll->{'name'} }) . "\n";
|
|
|
|
$ret .= "</div>\n\n";
|
|
|
|
### Poll Questions
|
|
|
|
$ret .= "<?h1 $ML{'.questions'} h1?>\n";
|
|
|
|
# closure for an html select box to insert element
|
|
my $insert_element_html = sub {
|
|
my $after = shift;
|
|
|
|
my $ret;
|
|
|
|
$ret .= "<div style='margin-top: 20px; margin-bottom: 20px'><?standout ";
|
|
if ($after >= $RULES{"elements"}->{"max"}) {
|
|
$ret .= "<?de [$ML{'.elements.limitreached'}] de?>\n";
|
|
} else {
|
|
$ret .= "$ML{'.insertquestion'} <select name='insert:$after'>\n";
|
|
foreach (qw(-- radio check drop text scale)) {
|
|
$ret .= "<option value='$_'>$TYPENAME{$_}</option>\n";
|
|
}
|
|
$ret .= "</select>\n";
|
|
$ret .= LJ::html_submit("insert:$after:do", $ML{'.button.insert'}) . "\n";
|
|
}
|
|
$ret .= " standout?></div>\n";
|
|
|
|
return $ret;
|
|
};
|
|
|
|
# if they have no elements, we need to manually give them an insert option
|
|
$ret .= $insert_element_html->(0);
|
|
|
|
# go through our elements in order
|
|
foreach my $q (0..$poll->{'count'}-1) {
|
|
my $elem = $poll->{'pq'}->[$q];
|
|
|
|
$ret .= "<?h2 " . BML::ml('.questionnum', { 'num' => ($q + 1) }) . " - $TYPENAME{$elem->{'type'}} h2?>\n";
|
|
|
|
$ret .= "<table border='0' cellspacing='0' cellpadding='0' width='90%'>\n";
|
|
$ret .= "<tr><td align='left' width='15%'>\n";
|
|
|
|
# can't move the first element up
|
|
if ($q > 0) {
|
|
$ret .= LJ::img('btn_up', 'input', "move:$q:up");
|
|
}
|
|
|
|
# delete button
|
|
$ret .= "<br />" . LJ::img('btn_del', 'input', "delete:$q:do");
|
|
|
|
# can't move the last element down
|
|
if ($q < ($poll->{'count'} - 1)) {
|
|
$ret .= "<br />" . LJ::img('btn_down', 'input', "move:$q:dn");
|
|
}
|
|
|
|
$ret .= "</td>\n";
|
|
$ret .= "<td align='left' valign='top'>\n";
|
|
|
|
# question text and hidden fields
|
|
$ret .= LJ::html_hidden("pq_${q}_type", $elem->{'type'}, "pq_${q}_opts", $elem->{'opts'});
|
|
$ret .= "<br />Question:<br />";
|
|
$ret .= LJ::html_text({ 'name' => "pq_${q}_question", 'size' => '50',
|
|
'maxlength' => $RULES{'question'}->{'maxlength'},
|
|
'value' => $elem->{"question"} }) . "\n";
|
|
$ret .= "<br /><font size='1'><b>[$err->{$q}->{'question'}]</b></font>\n"
|
|
if $err->{$q}->{'question'};
|
|
|
|
$ret .= "<div style='margin: 10px 0 10px 40px'>\n";
|
|
|
|
# spit out opts -- choices for drop-down, radio, etc questions
|
|
if ($elem->{'type'} =~ /^(radio|check|drop)$/) {
|
|
$ret .= "Options:\n";
|
|
foreach my $o (0..$elem->{'opts'}-1) {
|
|
$ret .= "<br />";
|
|
|
|
$ret .= LJ::html_check({ 'type' => 'radio', 'name' => "dummy_$q", 'disabled' => 'disabled' }) if $elem->{'type'} eq 'radio';
|
|
$ret .= LJ::html_check({ 'type' => 'checkbox', 'disabled' => 'disabled' }) if $elem->{'type'} eq 'check';
|
|
|
|
$ret .= LJ::html_text({ 'type' => 'text', 'name' => "pq_${q}_opt_$o", 'size' => '35',
|
|
'maxlength' => $RULES{'items'}->{'maxlength'}, 'value' => $elem->{'opt'}->[$o] }) . "\n";
|
|
}
|
|
$ret .= "<br /><font size='1'><b>[$err->{$q}->{'items'}]</b></font>\n"
|
|
if $err->{$q}->{"items"};
|
|
$ret .= $elem->{'opts'} < $RULES{'items'}->{'max'}
|
|
? "<br />" . LJ::html_submit("request:$q:do", undef, { 'raw' => " value='More >>'" }) . "\n"
|
|
: "<br /><?de [$ML{'.options.limitreached'}] de?>\n";
|
|
|
|
# text type
|
|
} elsif ($elem->{'type'} eq 'text') {
|
|
foreach my $atr ( qw(size maxlength) ) {
|
|
$ret .= ucfirst($atr) . ": ";
|
|
$ret .= LJ::html_text({ 'name' => "pq_${q}_$atr", 'value' => $elem->{$atr} || $RULES{'text'}->{$atr},
|
|
'size' => '3', 'maxlength' => '3' }) . "\n";
|
|
$ret .= "<br /><font size='1'><b>[$err->{$q}->{$atr}]</b></font>\n"
|
|
if $err->{$q}->{$atr};
|
|
}
|
|
|
|
# scale type
|
|
} elsif ($elem->{'type'} eq 'scale') {
|
|
foreach my $atr ( qw(from to by) ) {
|
|
$ret .= ' ' . ucfirst($atr) . ": ";
|
|
$ret .= LJ::html_text({ 'name' => "pq_${q}_$atr",
|
|
'value' => defined $elem->{$atr} ? $elem->{$atr} : $RULES{'scale'}->{$atr},
|
|
'size' => '3', 'maxlength' => '9' }) . "\n";
|
|
}
|
|
foreach my $atr ( qw(from to by items) ) {
|
|
$ret .= "<br /><font size='1'><b>[$err->{$q}->{$atr}]</b></font>\n"
|
|
if $err->{$q}->{$atr};
|
|
}
|
|
}
|
|
|
|
$ret .= "</div>\n</td></tr>\n</table>\n\n";
|
|
|
|
# add a new element unless they're already at the max
|
|
$ret .= $insert_element_html->($q+1, $poll);
|
|
|
|
}
|
|
|
|
if ($poll->{'count'} > 0) {
|
|
$ret .= "<?h1 When you're done ... h1?>\n";
|
|
$ret .= "<div style='margin: 20px 0 20px 40px'>\n";
|
|
$ret .= LJ::html_submit('start_over', undef, { 'raw' => "value='← $ML{'.button.startover'}'" }) . "\n";
|
|
$ret .= LJ::html_submit('see_code', undef, { 'raw' => "value='$ML{'.button.seecode'} →'" }) . "\n";
|
|
$ret .= LJ::html_submit('see_preview', undef, { 'raw' => "value='$ML{'.button.preview'} →'" }) . "\n";
|
|
$ret .= "</div>\n";
|
|
}
|
|
|
|
$ret .= "</form>\n";
|
|
|
|
return $ret;
|
|
};
|
|
|
|
|
|
# preview page so the users can view a preview and decide
|
|
# if they want to continue or go back for revision
|
|
my $make_preview = sub {
|
|
my $poll = shift;
|
|
|
|
# create poll code given a %poll object
|
|
my $make_code = sub {
|
|
my $poll = shift;
|
|
|
|
my $ret;
|
|
|
|
# start out the tag
|
|
$ret .= "<lj-poll name='" . LJ::ehtml($poll->{'name'}) . "' whovote='" . LJ::ehtml($poll->{'whovote'}) . "' whoview='" . LJ::ehtml($poll->{'whoview'}) . "'>\n";
|
|
|
|
# go through and make <lj-pq> tags
|
|
foreach my $q (0..$poll->{'count'}-1) {
|
|
my $elem = $poll->{'pq'}->[$q];
|
|
$ret .= "<lj-pq type='$elem->{'type'}'";
|
|
|
|
# fill in attributes
|
|
if ($elem->{'type'} eq 'text') {
|
|
foreach ( qw(size maxlength) ) {
|
|
$ret .= " $_='" . LJ::ehtml($elem->{$_}) . "'";
|
|
}
|
|
} elsif ($elem->{'type'} eq 'scale') {
|
|
foreach ( qw(from to by) ) {
|
|
$ret .= " $_='" . LJ::ehtml($elem->{$_}) . "'";
|
|
}
|
|
}
|
|
$ret .= ">\n";
|
|
$ret .= $elem->{'question'} . "\n" if $elem->{'question'};
|
|
|
|
if ($elem->{'type'} =~ /^(radio|drop|check)$/) {
|
|
# make <lj-pi> tags
|
|
foreach my $o (0..$elem->{'opts'}) {
|
|
$ret .= "<lj-pi>$elem->{'opt'}->[$o]</lj-pi>\n" if $elem->{'opt'}->[$o] ne '';
|
|
}
|
|
}
|
|
$ret .= "</lj-pq>\n";
|
|
}
|
|
|
|
# close off the poll
|
|
$ret .= "</lj-poll>";
|
|
|
|
# escape html on this because it'll currently be sent to user so they can copy/paste
|
|
return $ret;
|
|
};
|
|
|
|
# generates html for the hidden elements necessary to maintain
|
|
# the state of the given poll
|
|
my $poll_hidden = sub {
|
|
my $poll = shift;
|
|
|
|
my @elements = ();
|
|
foreach my $k (keys %$poll) {
|
|
|
|
# poll attributes
|
|
unless (ref $poll->{$k} eq 'ARRAY') {
|
|
push @elements, ($k, $poll->{$k});
|
|
next;
|
|
}
|
|
|
|
# poll questions
|
|
my $q_idx = 0;
|
|
foreach my $q (@{$poll->{$k}}) {
|
|
|
|
# question attributes
|
|
foreach my $atr (keys %$q) {
|
|
unless (ref $q->{$atr} eq 'ARRAY') {
|
|
push @elements, ("${k}_${q_idx}_$atr", $q->{$atr});
|
|
next;
|
|
}
|
|
|
|
# radio/text/drop options
|
|
my $opt_idx = 0;
|
|
foreach my $o (@{$q->{$atr}}) {
|
|
push @elements, ("${k}_${q_idx}_${atr}_$opt_idx", $o);
|
|
$opt_idx++;
|
|
}
|
|
}
|
|
|
|
$q_idx++;
|
|
}
|
|
}
|
|
|
|
return LJ::html_hidden(@elements);
|
|
};
|
|
|
|
# generate code for preview
|
|
my $code = $make_code->($poll);
|
|
|
|
# parse code into standard poll hashref
|
|
# so we can feed it into LJ::Poll::preview()
|
|
my $err;
|
|
my $codecopy = $code; # parse function will eat the code
|
|
my $stdpoll = (LJ::Poll::parse(\$codecopy, \$err, {}))[0];
|
|
return "<b>[$ML{'.error.parsing'} $err]</b>\n" if $err;
|
|
|
|
# display poll preview
|
|
my $ret;
|
|
$ret .= "<?h1 $ML{'.preview.options'} h1?>\n";
|
|
$ret .= "<?p $ML{'.preview.desc'} p?>\n\n";
|
|
|
|
$ret .= "<div align='center'>\n";
|
|
|
|
# edit poll
|
|
$ret .= "<form method='post' action='create.bml$getextra' style='display: inline'>\n";
|
|
$ret .= $poll_hidden->($poll);
|
|
$ret .= LJ::html_submit('edit_poll', undef, { 'raw' => "value='← $ML{'.button.editpoll'}'" }) . "\n";
|
|
|
|
# need one more button, depending on which page they're currently on
|
|
my ($name, $val) = $POST{'see_code'}
|
|
? ("see_preview", $ML{'.button.preview'})
|
|
: ("see_code", $ML{'.button.seecode'});
|
|
|
|
$ret .= LJ::html_submit($name, $val) . "\n";
|
|
$ret .= "</form>\n";
|
|
|
|
# submit button / form
|
|
my $usejournal = $getextra ? "?usejournal=$authas" : '';
|
|
$ret .= "<form method='post' action='$LJ::SITEROOT/update.bml$usejournal' style='display: inline'>\n";
|
|
$ret .= LJ::html_hidden('event', $code) . "\n";
|
|
$ret .= LJ::html_submit('showform', undef, { 'raw' => "value='$ML{'.button.postpoll'} →'" }) . "\n";
|
|
$ret .= "</form>\n";
|
|
|
|
# preview code or ... preview
|
|
$ret .= "</div><div style='margin: 20px 0 20px 40px; width: 90%'>\n";
|
|
|
|
# viewing code, show preview button
|
|
if ($POST{'see_code'}) {
|
|
$ret .= "<form action='#'>\n";
|
|
$ret .= LJ::html_textarea({ 'style' => 'width: 100%', 'rows' => '16', 'cols' => '60', 'value' => $code });
|
|
$ret .= "</form>\n";
|
|
|
|
# seeing preview, show code button
|
|
} elsif ($POST{'see_preview'}) {
|
|
# this has its own form open / close
|
|
$ret .= LJ::Poll::preview($stdpoll);
|
|
}
|
|
|
|
$ret .= "</div>\n";
|
|
|
|
return $ret;
|
|
};
|
|
|
|
|
|
# variables to pass around
|
|
my $poll = {};
|
|
my $err = {};
|
|
|
|
# should we pregenerate something?
|
|
if (my $pgid = $GET{'pregen'}+0) {
|
|
$poll = LJ::run_hook('pregenerate_poll', $u, $pgid);
|
|
}
|
|
|
|
# process post input
|
|
if (LJ::did_post() && ! $POST{'start_over'}) {
|
|
|
|
# load poll hash from %POST and get action and error info
|
|
$poll = $build_poll->($err);
|
|
|
|
# generate poll preview for them
|
|
if (($POST{'see_preview'} || $POST{'see_code'}) && ! %$err) {
|
|
$body .= $make_preview->($poll);
|
|
return;
|
|
}
|
|
}
|
|
|
|
# show start page
|
|
$body .= $make_form->($poll, $err);
|
|
|
|
return;
|
|
}
|
|
_code?><?page
|
|
title=><?_code return $title; _code?>
|
|
body=><?_code return $body; _code?>
|
|
page?><?_c
|
|
<LJDEP>
|
|
lib: LJ::img, cgi-bin/htmlcontrols.pl, cgi-bin/ljpoll.pl
|
|
link: htdocs/support/faqbrowse.bml, htdocs/login.bml
|
|
img: img::btn_up, img::btn_down, img::btn_del
|
|
post: htdocs/poll/create.bml, htdocs/update.bml
|
|
</LJDEP>
|
|
_c?>
|