init
This commit is contained in:
708
livejournal/htdocs/poll/create.bml
Executable file
708
livejournal/htdocs/poll/create.bml
Executable file
@@ -0,0 +1,708 @@
|
||||
<?_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?>
|
||||
117
livejournal/htdocs/poll/index.bml
Executable file
117
livejournal/htdocs/poll/index.bml
Executable file
@@ -0,0 +1,117 @@
|
||||
<?_code
|
||||
{
|
||||
use strict;
|
||||
use vars qw(%FORM $title $body);
|
||||
|
||||
$title = $ML{'.title'};
|
||||
$body = "";
|
||||
|
||||
# answers to checkbox questions are null-separated sequences
|
||||
# since our inout correctness check rules out nulls, we change them
|
||||
# to commas here rather than inside LJ::Poll::submit() .
|
||||
foreach (values %FORM) {
|
||||
s/\0/,/g;
|
||||
}
|
||||
unless (LJ::text_in(\%FORM)) {
|
||||
$body = "<?badinput?>";
|
||||
return;
|
||||
}
|
||||
|
||||
my $remote = LJ::get_remote();
|
||||
|
||||
my $pollid = ($FORM{'id'} || $FORM{'pollid'})+0;
|
||||
|
||||
unless ($pollid) {
|
||||
$body .= $ML{'.gotocreate'};
|
||||
return;
|
||||
}
|
||||
|
||||
my $dbr = LJ::get_db_reader();
|
||||
my $po = $dbr->selectrow_hashref("SELECT itemid, whovote, journalid, posterid, whoview, whovote, name ".
|
||||
"FROM poll WHERE pollid=?", undef, $pollid);
|
||||
unless ($po) {
|
||||
$title = $ML{'Error'};
|
||||
$body = $ML{'.pollnotfound'};
|
||||
return;
|
||||
}
|
||||
|
||||
my $u = LJ::load_userid($po->{'journalid'});
|
||||
my $jarg = $u->{'clusterid'} ? "journal=$u->{'user'}&" : "";
|
||||
|
||||
my $mode = "";
|
||||
foreach my $m ([ "enter", $ML{'.filloutpoll'} ], [ "results" , $ML{'.viewresults'} ]) {
|
||||
if ($FORM{'mode'} eq $m->[0]) {
|
||||
$mode = $FORM{'mode'};
|
||||
$body .= "<b>[ $m->[1] ]</b> ";
|
||||
} else {
|
||||
$body .= "<a href=\"$LJ::SITEROOT/poll/?id=$pollid&mode=$m->[0]\">[ $m->[1] ]</a> ";
|
||||
}
|
||||
}
|
||||
|
||||
# load the item being shown
|
||||
my $udbr = LJ::get_cluster_reader($u);
|
||||
my $itemid = int($po->{'itemid'} / 256);
|
||||
my $anum = $po->{'itemid'} % 256;
|
||||
my $log = $udbr->selectrow_hashref("SELECT * FROM log2 WHERE journalid=? AND jitemid=? AND anum=?",
|
||||
undef, $u->{'userid'}, $itemid, $anum);
|
||||
$log->{'ownerid'} = $log->{'journalid'};
|
||||
unless ($log) {
|
||||
$body = $ML{'.error.postdeleted'};
|
||||
return;
|
||||
}
|
||||
|
||||
unless (LJ::can_view($remote, $log)) {
|
||||
$body = $ML{'.error.cantview'};
|
||||
return;
|
||||
}
|
||||
|
||||
$body .= "<a href='" . LJ::item_link($u, $itemid, $anum) . "'>[ $ML{'.discuss'} ]</a> ";
|
||||
|
||||
if ($FORM{'mode'} eq "ans") { $mode = "ans"; } # also allowed, but not shown
|
||||
|
||||
$body .= "<hr><p>";
|
||||
|
||||
if (defined $FORM{'poll-submit'})
|
||||
{
|
||||
unless (LJ::did_post()) {
|
||||
$title = $ML{'Error'};
|
||||
$body = $ML{'bml.requirepost'};
|
||||
return;
|
||||
}
|
||||
|
||||
unless (LJ::check_form_auth()) {
|
||||
$title = $ML{'Error'};
|
||||
$body = $ML{'error.invalidform'};
|
||||
return;
|
||||
}
|
||||
|
||||
my $error;
|
||||
LJ::Poll::submit($remote, \%FORM, \$error);
|
||||
if ($error) {
|
||||
$title = $ML{'Error'};
|
||||
$body .= $error;
|
||||
return;
|
||||
}
|
||||
$title = $ML{'.submitted.title'};
|
||||
$body .= "<?h1 $ML{'.submitted.head'} h1?><?p $ML{'.submitted.text'} p?>";
|
||||
return;
|
||||
}
|
||||
|
||||
my $opts = { 'mode' => $mode,
|
||||
'qid' => $FORM{'qid'},
|
||||
'prefill' => 1,
|
||||
};
|
||||
|
||||
## itemid 0 means no security is done to check that it's not hijacked:
|
||||
$body .= LJ::Poll::show_poll(0, $remote, $pollid, $opts);
|
||||
|
||||
return;
|
||||
}
|
||||
_code?><?page
|
||||
title=><?_code return $title; _code?>
|
||||
body=><?_code return $body; _code?>
|
||||
page?><?_c <LJDEP>
|
||||
lib: cgi-bin/ljlib.pl, cgi-bin/cleanhtml.pl
|
||||
link: htdocs/poll/index.bml, htdocs/talkread.bml, htdocs/support/faqbrowse.bml, htdocs/poll/create.bml
|
||||
</LJDEP> _c?>
|
||||
|
||||
Reference in New Issue
Block a user