+### sub response ###############################################################
+#
+# print the response to STDOUT
+#
+# Return: -none-
+#
+sub response {
+ my $self = shift;
+ my $formdata = $self -> {conf} -> {form_data};
+ my $formact = $self -> {conf} -> {form_action};
+ my $template = $self -> {template};
+ my $assign = $self -> {conf} -> {assign};
+ my $q = $self -> {cgi_object};
+
+ # fill out the form field names
+ #
+ my $pars = {};
+ for (keys %$formdata) {
+ $pars -> {$formdata -> {$_} -> {assign} -> {name}} = plain($formdata -> {$_} -> {name}) if (
+ exists($formdata -> {$_} -> {name})
+ and exists ($formdata -> {$_} -> {assign})
+ and exists ($formdata -> {$_} -> {assign} -> {name})
+ );
+ }
+
+ # response the 'new message' page
+ #
+ if ($self -> {response} -> {new_thread}) {
+
+ # fill in the default form data
+ # and optionlist(s)
+ #
+ my $default = {};
+ for (keys %$formdata) {
+ unless (exists ($formdata -> {$_} -> {type}) and $formdata -> {$_} -> {type} eq 'internal') {
+ if (exists ($formdata -> {$_} -> {default}) and exists ($formdata -> {$_} -> {assign} -> {value})) {
+ $default -> {$formdata -> {$_} -> {assign} -> {value}}
+ = $formdata -> {$_} -> {default};
+ }
+ elsif (exists($formdata -> {$_} -> {values})) {
+ my ($_name, $val) = $_;
+ $val = exists ($formdata -> {$_} -> {default})
+ ? $formdata -> {$_} -> {default}
+ : undef;
+ $default -> {$formdata -> {$_} -> {assign} -> {value}}
+ = $self -> {template} -> list (
+ $assign -> {option},
+ [ map {
+ { $assign -> {optval} => plain($_),
+ ((defined $val and $_ eq $val)
+ ? ($assign -> {optsel} => 1)
+ : ()
+ )
+ }
+ } @{$formdata -> {$_name} -> {values}}
+ ]
+ );
+ }
+ }
+ }
+
+ print $q -> header (-type => 'text/html');
+ print ${$template -> scrap (
+ $assign -> {docNew},
+ { $formdata->{uniqueID} ->{assign}->{value} => plain(unique_id),
+ $formdata->{quoteChar} ->{assign}->{value} => 'ÿ'.plain($self -> {conf} -> {admin} -> {View} -> {quoteChars}),
+ $formact->{post}->{assign} => $formact->{post}->{url},
+ },
+ $pars,
+ $default
+ )};
+ return;
+ }
+
+ # check the response -> doc
+ #
+ unless ($self -> {response} -> {doc}) {
+ $self -> {error} = {
+ spec => 'unknown_error',
+ type => 'fatal'
+ };
+
+ $self -> handle_error;
+
+ unless ($self -> {response} -> {doc}) {
+ $self -> jerk ('While producing the HTML response an unknown error has occurred.');
+ return;
+ }
+ }
+
+ # ok, print the response document to STDOUT
+ #
+ print $q -> header (-type => 'text/html');
+ print ${$template -> scrap (
+ $self -> {response} -> {doc},
+ $pars,
+ $self -> {response} -> {pars}
+ )
+ };
+
+ return;
+}
+
+### sub handle_error ###########################################################
+#
+# analyze error data and create content for the response method
+#
+# Return: true if error detected
+# false otherwise
+#
+sub handle_error {
+ my $self = shift;
+
+ my $spec = $self -> {error} -> {spec};
+
+ return unless ($spec);
+
+ my $assign = $self -> {conf} -> {assign};
+ my $formdata = $self -> {conf} -> {form_data};
+
+ my $desc = $self -> {error} -> {desc} || '';
+ my $type = $self -> {error} -> {type};
+ my $emsg;
+
+ if (exists ($formdata -> {$desc})
+ and exists ($formdata -> {$desc} -> {assign} -> {$spec})) {
+ $emsg = $formdata -> {$desc} -> {assign} -> {$spec};
+ }
+ else {
+ $emsg = $assign -> {$spec} || '';
+ }
+
+ # fatal errors
+ #
+ if ($type eq 'fatal') {
+ $self -> {response} -> {doc} = $assign -> {docFatal};
+ $self -> {response} -> {pars} = {
+ $assign -> {errorMessage} => $self -> {template} -> insert ($emsg)
+ };
+ }
+
+ # 'soft' errors
+ # user is able to repair his request
+ #
+ elsif ($type eq 'repeat' or $type eq 'fetch') {
+ $self -> {response} -> {doc} = $assign -> {docError};
+ $self -> fillout_form;
+ $self -> {response} -> {pars} -> {$assign -> {errorMessage}} = $self -> {template} -> insert ($emsg);
+ my $num = $spec eq 'too_long'
+ ? $formdata -> {$desc} -> {maxlength}
+ : ($spec eq 'too_short'
+ ? $formdata -> {$desc} -> {minlength}
+ : undef
+ );
+
+ $self -> {response} -> {pars} -> {$assign -> {charNum}} = $num
+ if $num;
+ }
+
+ 1;
+}
+
+### sub fillout_form ###########################################################
+#
+# fill out the form using available form data
+#
+# Return: -none-
+#
+sub fillout_form {
+ my $self = shift;
+
+ my $assign = $self -> {conf} -> {assign};
+ my $formdata = $self -> {conf} -> {form_data};
+ my $formact = $self -> {conf} -> {form_action};
+ my $q = $self -> {cgi_object};
+ my $pars = {};
+
+ # fill out the form
+ #
+ $pars -> {$formact -> {post} -> {assign}} = $formact -> {post} -> {url};
+
+ for (keys %$formdata) {
+ if ($_ eq 'quoteChar') {
+ $pars -> {$formdata->{$_}->{assign}->{value}}
+ = 'ÿ'.plain($q -> param ($formdata -> {quoteChar} -> {name}) or '');
+ }
+ elsif (exists ($formdata -> {$_} -> {name})) {
+ unless (exists ($formdata -> {$_} -> {values})) {
+ $pars -> {$formdata -> {$_} -> {assign} -> {value}}
+ = plain($q -> param ($formdata -> {$_} -> {name}));
+ }
+ else {
+ my $_name = $_;
+ $pars -> {$formdata -> {$_} -> {assign} -> {value}}
+ = $self -> {template} -> list (
+ $assign -> {option},
+ [ map {
+ { $assign -> {optval} => plain($_),
+ (( $_ eq $q -> param ($formdata -> {$_name} -> {name}))
+ ? ($assign -> {optsel} => 1)
+ : ()
+ )
+ }
+ } @{$formdata -> {$_name} -> {values}}
+ ]
+ );
+ }
+ }
+ }
+
+ $self -> {response} -> {pars} = $pars;
+ return;
+}
+
+### sub save ###################################################################
+#
+# save posting
+# check on legal reply or dupe is released here
+#
+# Return: -none-
+#
+sub save {
+ my $self = shift;
+
+ # if an empty 'new message' document, there's nothing to save
+ #
+ return if ($self -> {response} -> {new_thread});
+
+ $self -> {check_success} = 0;
+
+ # lock and load the forum main file
+ #
+ if ($self -> load_main_file) {
+
+ # if a reply - is it legal?
+ # is it a dupe?
+ #
+ if ($self -> check_reply_dupe) {
+
+ unless ($self -> {response} -> {reply} or $self -> {response} -> {new}) {
+ # don't know, if we any time come to this branch
+ # the script is probably broken
+ #
+ $self -> {error} = {
+ spec => 'unknown_error',
+ type => 'fatal'
+ };
+ }
+ else {
+ my $time = time;
+ my $formdata = $self -> {conf} -> {form_data};
+ my $q = $self -> {cgi_object};
+ my $f = $self -> {forum};
+ my $pars = {
+ quoteChars => $q -> param ($formdata -> {quoteChar} -> {name}),
+ uniqueID => $q -> param ($formdata -> {uniqueID} -> {name}),
+ time => $time,
+ ip => $q -> remote_addr,
+ forumFile => $self -> {conf} -> {forum_file_name},
+ messagePath => $self -> {conf} -> {message_path},
+ lastThread => $f -> {last_thread},
+ lastMessage => $f -> {last_message},
+ parsedThreads => $f -> {threads},
+ dtd => $f -> {dtd},
+ messages => $self -> {template} -> {messages} || {},
+ };
+
+ # set the variables if defined..
+ #
+ my %may = (
+ author => 'posterName',
+ email => 'posterEmail',
+ category => 'posterCategory',
+ subject => 'posterSubject',
+ body => 'posterBody',
+ homepage => 'posterURL',
+ image => 'posterImage'
+ );
+
+ for (keys %may) {
+ $pars -> {$_} = $q -> param ($formdata -> {$may{$_}} -> {name})
+ if (defined $q -> param ($formdata -> {$may{$_}} -> {name}));
+ }
+
+ my ($stat, $xml, $mid);
+
+ # we've got a fup if it's a reply
+ #
+ if ($self -> {response} -> {reply}) {
+ $pars -> {parentMessage} = $self -> {fup_mid};
+ $pars -> {thread} = $self -> {fup_tid};
+ ($stat, $xml, $mid) = write_reply_posting ($pars);
+ }
+ else {
+ ($stat, $xml, $mid) = write_new_thread ($pars);
+ }
+
+ if ($stat) {
+ $self -> {error} = {
+ spec => 'not_saved',
+ desc => $stat,
+ type => 'fatal'
+ };
+ }
+ else {
+ $self -> {check_success} = 1;
+ my $thx = $self -> {conf} -> {show_posting} -> {thanx};
+
+ # define special response data
+ #
+ $self -> {response} -> {doc} = $self -> {conf} -> {assign} -> {docThx};
+ $self -> {response} -> {pars} = {
+ $thx -> {time} => plain (hr_time($time)),
+ $thx -> {body} => message_as_HTML (
+ $xml,
+ $self -> {template},
+ { posting => $mid,
+ assign => $self -> {conf} -> {assign},
+ quoteChars => $q -> param ($formdata -> {quoteChar} -> {name}),
+ quoting => $self -> {conf} -> {admin} -> {View} -> {quoting}
+ }) || ''
+ };
+
+ # set the variables if defined..
+ #
+ my %may = (
+ author => 'posterName',
+ email => 'posterEmail',
+ category => 'posterCategory',
+ subject => 'posterSubject',
+ homepage => 'posterURL',
+ image => 'posterImage'
+ );
+
+ for (keys %may) {
+ my $x = $q -> param ($formdata -> {$may{$_}} -> {name});
+ $x = '' unless (defined $x);
+ $self -> {response} -> {pars} -> {$thx -> {$_}} = plain ($x)
+ if (defined $thx -> {$_});
+ }
+ }
+ }
+ }
+ }
+
+ # unlock forum main file
+ #
+ if ($self -> {forum} -> {flocked}) {
+ violent_unlock_file($self -> {conf} -> {forum_file_name}) unless write_unlock_file ($self -> {conf} -> {forum_file_name});
+ $self -> {forum} -> {flocked} = 0;
+ }
+
+ $self -> handle_error unless $self -> {check_success};
+
+ return;
+}
+
git.p6c8.net / selfforum.git / blobdiff