--- /dev/null
+# Copyright (C) 2023 Balthasar Szczepański
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU Affero General Public License as
+# published by the Free Software Foundation, either version 3 of the
+# License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU Affero General Public License for more details.
+#
+# You should have received a copy of the GNU Affero General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+package post_common;
+
+use strict;
+#use warnings;
+use utf8;
+
+use Encode::Locale;
+use Encode ('encode', 'decode');
+
+use Exporter;
+
+###PERL_EXPORT_VERSION: our $VERSION = 'x.x.x';
+our @ISA = qw(Exporter);
+our @EXPORT = ();
+our @EXPORT_OK = (
+ 'prepare_post',
+ 'wget',
+ 'CODE',
+);
+
+###PERL_LIB: use lib '/botm/lib/post';
+use botm_common (
+ 'system_encoded',
+ 'write_postdata_file'
+);
+
+###PERL_DEFAULT_PASSWORD: use constant DEFAULT_PASSWORD => 'password';
+###PERL_DEFAULT_SUBJECT: use constant DEFAULT_SUBJECT => 'Re: 1190: "Time"';
+###PERL_DEFAULT_USERNAME: use constant DEFAULT_USERNAME => 'username';
+
+###PERL_WGET_RETRIES: use constant WGET_RETRIES => 3;
+###PERL_WGET_TIMEOUT: use constant WGET_TIMEOUT => 60;
+###PERL_WGET_USERAGENT: use constant WGET_USERAGENT => "post tool (http://bicyclesonthemoon.info/git-projects/?p=ott/post)";
+
+###PERL_WGET: use constant WGET => '/usr/bin/wget';
+
+###PERL_ENCODING_FILE: use constant ENCODING_FILE => 'UTF-8';
+
+
+use constant CODE => {
+ 'OK' => 0,
+ 'POST_INVALID' => 1,
+ 'POST_FAILED' => 2,
+ 'POST_NOT_ACCEPTED' => 3
+};
+
+sub prepare_post {
+ (my $cmd_options, my $file_data) = @_;
+ my %post;
+
+ if (($cmd_options->{'subject'}) ne '') {
+ $post{'subject'} = $cmd_options->{'subject'};
+ }
+ elsif (($file_data->{'subject'}) ne '') {
+ $post{'subject'} = $file_data->{'subject'};
+ }
+ else {
+ $post{'subject'} = DEFAULT_SUBJECT;
+ }
+
+ if (($cmd_options->{'username'}) ne '') {
+ $post{'username'} = $cmd_options->{'username'};
+ }
+ elsif (($file_data->{'username'}) ne '') {
+ $post{'username'} = $file_data->{'username'};
+ }
+ else {
+ $post{'username'} = DEFAULT_USERNAME;
+ }
+
+ if (($cmd_options->{'password'}) ne '') {
+ $post{'password'} = $cmd_options->{'password'};
+ }
+ elsif (($file_data->{'password'}) ne '') {
+ $post{'password'} = $file_data->{'password'};
+ }
+ else {
+ $post{'password'} = DEFAULT_PASSWORD;
+ }
+
+ if (($cmd_options->{'content'}) ne '') {
+ $post{'content'} = $cmd_options->{'content'};
+ }
+ elsif (($file_data->{'content'}) ne '') {
+ $post{'content'} = $file_data->{'content'};
+ }
+ else {
+ $post{'content'} = '';
+ }
+
+ if (($cmd_options->{'no-bbcode'}) ne '') {
+ $post{'bbcode'} = 0;
+ }
+ elsif (($cmd_options->{'bbcode'}) ne '') {
+ $post{'bbcode'} = 1;
+ }
+ elsif (($file_data->{'bbcode'}) ne '') {
+ $post{'bbcode'} = $file_data->{'bbcode'}+0;
+ }
+ else {
+ $post{'bbcode'} = 1;
+ }
+
+ if (($cmd_options->{'no-smilies'}) ne '') {
+ $post{'smilies'} = 0;
+ }
+ elsif (($cmd_options->{'smilies'}) ne '') {
+ $post{'smilies'} = 1;
+ }
+ elsif (($file_data->{'smilies'}) ne '') {
+ $post{'smilies'} = $file_data->{'smilies'}+0;
+ }
+ else {
+ $post{'smilies'} = 1;
+ }
+
+ if (($cmd_options->{'no-urls'}) ne '') {
+ $post{'urls'} = 0;
+ }
+ elsif (($cmd_options->{'urls'}) ne '') {
+ $post{'urls'} = 1;
+ }
+ elsif (($file_data->{'urls'}) ne '') {
+ $post{'urls'} = $file_data->{'urls'}+0;
+ }
+ else {
+ $post{'urls'} = 1;
+ }
+
+ if (($cmd_options->{'no-signature'}) ne '') {
+ $post{'signature'} = 0;
+ }
+ elsif (($cmd_options->{'signature'}) ne '') {
+ $post{'signature'} = 1;
+ }
+ elsif (($file_data->{'signature'}) ne '') {
+ $post{'signature'} = $file_data->{'signature'}+0;
+ }
+ else {
+ $post{'signature'} = 1;
+ }
+
+ if (($cmd_options->{'no-notify'}) ne '') {
+ $post{'notify'} = 0;
+ }
+ elsif (($cmd_options->{'notify'}) ne '') {
+ $post{'notify'} = 1;
+ }
+ elsif (($file_data->{'notify'}) ne '') {
+ $post{'notify'} = $file_data->{'notify'}+0;
+ }
+ else {
+ $post{'notify'} = 0;
+ }
+
+ if (($file_data->{'time'}) ne '') {
+ $post{'time'} = $file_data->{'time'}+0;
+ }
+ else {
+ $post{'time'} = 0;
+ }
+
+ return %post;
+}
+
+##########
+# BBCODE #
+##########
+
+# bbtree is the representation of a BBcode tag tree as a Perl hash
+# each element can be a tag or text.
+# text only has value
+# tag can have properties and other tags
+#
+# index consists of multiple parts separated by dots
+# top level index is "_"
+# element's index is created by adding a number to the index
+# starting from 0.
+# EXAMPLE:
+# element "_" can have other elements with indexes:
+# "_.0", "_.1", "_.2", ...
+# element "_.1" can have other elements with indexes:
+# "_.1.0", "_.1.1", "_.1.2", ...
+# and so on.
+#
+# properties also have index created by adding the property name
+# to the element's base index separated by dot
+#
+# property ".type" dedermines type of element:
+# - "text" - element is just normal text
+# - "tag" - element is BBcode tag
+#
+# text has just 1 property:
+# - ".text" - the actual text content
+#
+# tag has these properties:
+# - ".text" - full text of BBcode opening tag
+# - ".endtext"- full text of BBcode closing tag
+# - ".name" - name of BBcode tag
+# - ".value" - (optional) value of BBcode tag
+# - ".count" - number, how many elements the tag contains inside
+# - ".closed" - 1 or 0, if tag has a matching closing tag
+
+# initialise bbtree with top level
+sub bbtree_init {
+ (my $bbtree, my $base_ind, my $print) = @_;
+
+ %$bbtree = ();
+ $bbtree{$base_ind.'.name'} = $base_ind;
+ $bbtree{$base_ind.'.type'} = 'tag';
+ $bbtree{$base_ind.'.count'} = 0;
+
+ if ($print){
+ print bbtree_debug(%bbtree, $ind);
+ }
+
+ return ($base_ind, 0);
+}
+
+# add new tag to bbtree, and enter new tag
+sub bbtree_add_tag {
+ (my $bbtree, my $ind, my $level, my $name, my $value, my $text, my $print) = @_;
+
+ my $ind_count = $ind.'.count';
+ # index for NEW tag
+ my $new_ind = $ind.'.'.$bbtree->{$ind_count};
+
+ # increase count of CURRENT tag
+ $bbtree->{$ind_count} += 1;
+
+ # save NEW tag properties
+ $bbtree->{$new_ind.'.type' } = 'tag';
+ $bbtree->{$new_ind.'.name' } = $name;
+ $bbtree->{$new_ind.'.value' } = $value;
+ $bbtree->{$new_ind.'.text' } = $text;
+
+ # NEW tag starts empty and open
+ $bbtree->{$new_ind.'.count' } = 0;
+ $bbtree->{$new_ind.'.closed'} = 0;
+
+ if ($print) {
+ print bbtree_debug(%bbtree, $new_ind);
+ }
+
+ # enter NEW tag
+ return ($new_ind, $level+1);
+}
+
+# add new text to bbtree, don't enter
+sub bbtree_add_text {
+ (my $bbtree, my $ind, my $level, my $text, my $print) = @_;
+
+ my $ind_count = $ind.'.count';
+ my $count = $bbtree->{$ind_count};
+
+ # if last element of CURRENT tag is text,
+ # then merge NEW text instead of adding separately
+ if ($count >= 0) {
+ my $ind_last = $ind.'.'.($count-1);
+ if ($bbtree->{$ind_last.'.type'} eq 'text') {
+ $bbtree->{$ind_last.'.text'} += $text;
+ $text = '';
+ }
+ }
+ # text was not merged & actually exists, add normally
+ if ($text ne '') {
+ # index for NEW tag
+ my $new_ind = $ind.'.'.$count;
+
+ # increase count of CURRENT tag
+ $bbtree->{$ind_count} = $count + 1;
+
+ # save NEW text properties
+ $bbtree->{$new_ind.'.type' } = 'text';
+ $bbtree->{$new_ind.'.text'} = $text;
+ }
+
+ if ($print){
+ print bbtree_debug(%bbtree, $ind);
+ }
+ return ($ind, $level);
+}
+
+# close existing tag in bbtree, return to parent tag
+sub bbtree_close_tag {
+ (my $bbtree, my $ind, my $level, my $text, my $print) = @_;
+
+ $bbtree->{$ind.'endtext'} = $text;
+ # mark CURRENT tag as closed
+ $bbtree->{$ind.'closed'} = 1;
+
+ if ($print){
+ print bbtree_debug(%bbtree, $ind);
+ }
+
+ # return to PARENT tag
+ if ($level > 0) {
+ $ind =~ s/\.[0-9]+$//;
+ return ($ind, $level-1);
+ }
+ else {
+ return ($ind, $level);
+ }
+}
+
+# don't close existing tag in bbtree, return to parent tag
+sub bbtree_drop_tag {
+ (my $bbtree, my $ind, my $level, my $text, my $print) = @_;
+
+ $bbtree->{$ind.'endtext'} = $text;
+ # mark CURRENT tag as NOT closed
+ $bbtree->{$ind.'closed'} = 0;
+
+ if ($print){
+ print bbtree_debug(%bbtree, $ind);
+ }
+
+ # return to PARENT tag
+ if ($level > 0) {
+ $ind =~ s/\.[0-9]+$//;
+ return ($ind, $level-1);
+ }
+ else {
+ return ($ind, $level);
+ }
+}
+
+# create debug text for bbtree element currently in focus
+sub bbtree_debug {
+ (my $bbtree, my $ind) = @_;
+
+ # start with current index
+ my $debug = '['.$ind.']';
+
+ # element is tag, analyse further
+ if ($bbtree->{$ind.'.type'} eq 'tag') {
+
+ # tag already closed, print name with "/"
+ if ($bbtree->{$ind.'.closed'}) {
+ $debug .= 'tag: [/'.$bbtree->{$ind.'.name'}.']';
+ }
+
+ # not closed but has end text
+ elsif ($bbtree->{$ind.'.endtext'} ne '') {
+ $debug .= 'mismatch: '.$bbtree->{$ind.'.endtext'};
+ }
+
+ # tag contains other elements,
+ # create debug text for last element instead
+ elsif ($bbtree->{$ind.'.count'} > 0) {
+ return bbtree_debug($bbtree, $ind.'.'.($bbtree->{$ind.'.count'}-1));
+ }
+
+ # empty, open tag, print name
+ else {
+ $debug .= 'tag: ['.$bbtree->{$ind.'.name'};
+ # tag has value, print as well
+ if ($bbtree->{$ind.'.value'} ne '') {
+ $debug .= '='.$bbtree->{$ind.'.value'};
+ }
+ $debug .= ']';
+ }
+ }
+
+ # element is text, just print
+ elsif ($bbtree->{$ind.'.type'} eq 'text') {
+ $debug .= 'text: '.$bbtree->{$ind.'.value'};
+ }
+
+ # unknown type, no idea what to print
+ else {
+ $debug .= '???';
+ }
+
+ $debug .= "\n";
+ return $debug;
+}
+
+sub bbcode_to_html {
+ (my $cmd_options, my $post) = @_;
+
+ my $bbcode = $post->{'content'}; # BBcode text to convert
+ my $html = '';
+ my $level; # how deep in the BB tree
+ my $ind; # current BB tree element's index
+ my %bbtree = (); # BB tree structure
+ my $tag; # current tag, full
+ my $tag_end; # current tag's closing mark
+ my $tag_name; # current tag's name
+ my $tag_value; # current tag's (optional) value
+ my $text; # current text
+ my $in_code = 0; # if (and how deep) in [code] tag
+ my $in_spoiler = 0; # if (and how deep) in [spoiler] tag
+ my $in_size = 0; # if (and how deep) in [size] tag
+ my $print = $cmd_options->{'verbose'} ne '' # allowed to print
+
+ # initialise BB tree with top level
+ if ($print) {
+ print "Build BBcode tree:\n";
+ }
+ ($ind, $level) = bbtree_init(\%bbtree, '_', $print);
+
+ while ($bbcode ne '') {
+
+ # found nearest tag
+ # [name]
+ # [/name]
+ # [name=value]
+ # [name="value"]
+ if($bbcode =~ m/(\[(\/?)([a-z]+|\*)(=(([^\[\]]*)|("[^"]*")))?\])/g) {
+ # assign detected parts:
+ $tag = $1;
+ $tag_end = $2;
+ $tag_name = $3;
+ $tag_value = $5;
+ # text before the tag:
+ $text = substr($bbcode, 0, pos($bbcode) - length($tag));
+ # cut off already processed part:
+ $bbcode = substr ($bbcode, pos ($bbcode));
+ }
+ # no tag found, only text left
+ else {
+ # mark no tag found
+ $tag = '';
+ # take all text at once
+ $text = $bbcode;
+ $bbcode = '';
+ }
+
+ # there was text (before tag or alone)
+ if ($text ne '') {
+ if ($print) {
+ print 'text: '.$text."\n";
+ }
+ # add new text to BB tree
+ bbtree_add_text(\%bbtree, $ind, $level, $text, $print);
+ }
+
+ # no tag, skip
+ if ($tag eq '') {
+ next;
+ }
+ if ($print) {
+ print 'tag: '.$tag."\n";
+ }
+
+ # tag name not recognised
+ if ($tag_name !~ /^(quote|b|i|u|code|img|url|size|color|center|right|sub|sup|s|spoiler|list|\*)$/) {
+ if ($print) {
+ print 'invalid tag name "'.$tag_name."\"\n";
+ }
+ # add bad tag to BB tree as text
+ bbtree_add_text(\%bbtree, $ind, $level, $tag, $print);
+ # skip
+ next;
+ }
+
+ # opening tag\r if ($tag_end eq '') {
+
+ # additional reasons for rejecting tag
+ if (
+ # no tags in [code] except [code][/code]
+ (($in_code > 0) and ($tag_name ne 'code')) or
+ # no tags in [img]
+ ($bbtree{$ind.'.name'} eq 'img') or
+ # no nested [spoiler] (compatibility)
+ (($in_spoiler > 0) and ($tag_name eq 'spoiler')) or
+ # no nested [size] (compatibility)
+ (($in_size > 0) and ($tag_name eq 'size'))
+ ) {
+ if ($print) {
+ print "this tag forbidden here\n";
+ }
+ # add bad tag as text
+ bbtree_add_text(\%bbtree, $ind, $level, $tag, $print);
+ # skip
+ next;
+ }
+
+ # [*] tag is special case as it doesn't need closing
+ if ($tag_name eq '*') {
+ # [*] after [*]
+ # add implicit [/*]
+ if ($bbtree{$ind.'.name'} eq '*') {
+ if ($print) {
+ print "implicit [/*]\n";
+ }
+ # add [/*] to BB tree
+ ($ind, $level) = bbtree_close_tag(\%bbtree, $ind, $level, '[/*]', $print);
+ }
+ # [*] not in [list], forbidden
+ elsif ($bbtree{$ind.'.name'} ne 'list') {
+ if ($print) {
+ print "this tag forbidden here\n";
+ }
+ # add tag to BB tree as text
+ bbtree_add_text(\%bbtree, $ind, $level, $tag, $print);
+ # skip
+ next;
+ }
+ }
+
+ # add tag to BB tree and enter
+ ($ind, $level) = bbtree_add_tag(\%bbtree, $ind, $level, $tag_name, $tag_value, $tag, $print);
+ # keep track of special case tags
+ if ($tag_name eq 'code') {
+ $in_code += 1;
+ }
+ elsif ($tag_name eq 'spoiler') {
+ $in_spoiler += 1;
+ }
+ elsif ($tag_name eq 'size') {
+ $in_size += 1;
+ }
+ }
+ # closing tag
+ else {
+
+ # already on top level
+ if($level <= 0) {
+ if ($print) {
+ print "unmatched\n";
+ }
+ # add bad tag to BB tree as text
+ bbtree_add_text(\%bbtree, $ind, $level, $tag, $print);
+ # skip
+ next;
+ }
+
+ # unclosed [*] before [/list]
+ # add implicit [/*]
+ if (($tag_name eq 'list' ) and ($bbtree{$ind.'.name'} eq '*')) {
+ if ($print) {
+ print "implicit [/*]\n";
+ }
+ # add [/*] to BB tree
+ ($ind, $level) = bbtree_close_tag(\%bbtree, $ind, $level, '[/*]' $print);
+ }
+
+ # handle special case tags
+ if ($bbtree{$ind.'.name'} eq 'code') {
+ $in_code -= 1;
+ }
+ elsif ($bbtree{$ind.'.name'} eq 'spoiler') {
+ $in_spoiler -= 1;
+ }
+ elsif ($bbtree{$ind.'.name'} eq 'size') {
+ $in_size -= 1;
+ }
+
+ # mismatched tag, but leave without closing
+ if ($tag_name ne $bbtree{$ind.'.name'}) {
+ if ($print) {
+ print "mismatched\n";
+ }
+ # add bad tag to BB tree as text and close current tag
+ ($ind, $level) = bbtree_drop_tag(\%bbtree, $ind, $level, $tag, $print);
+ }
+
+ # close current tag
+ ($ind, $level) = bbtree_close_tag(\%bbtree, $ind, $level, $tag, $print);
+ }
+ }
+
+ if ($print) {
+ print "\nGenerate HTML from BBcode tree:\n";
+ }
+
+}
+
+########
+# WGET #
+########
+
+sub wget {
+ (my $url, my $path, my $options, my $postdata) = @_;
+
+ my @arg = (
+ WGET,
+ '-t', WGET_RETRIES,
+ '--connect-timeout='.WGET_TIMEOUT,
+ );
+
+ unless ($options->{'verbose'} ne '') {
+ push(@arg, '-q');
+ }
+
+ if ($options->{'with_header'}) {
+ push(@arg, '--save-headers');
+ }
+
+ if ($options->{'cookie_path'} ne '') {
+ if (-f $options->{'cookie_path'}) {
+ push(@arg, '--load-cookies='.$options->{'cookie_path'});
+ }
+ push(@arg, '--save-cookies='.$options->{'cookie_path'});
+ }
+ else {
+ push(@arg, '--no-cookies');
+ }
+
+ if ($options->{'useragent'} ne '') {
+ push(@arg, '-U', $options->{'useragent'});
+ }
+
+ if ($options->{'referer'} ne '') {
+ push(@arg, '--referer='.$options->{'referer'});
+ }
+
+ if ($options->{'no-check-certificate'} ne '') {
+ push(@arg, '--no-check-certificate');
+ }
+
+ if ($options->{'postdata_path'} ne '') {
+ if (defined $postdata) {
+ write_postdata_file(
+ $options->{'postdata_path'},
+ ENCODING_FILE, $options->{'encoding'},
+ $postdata
+ );
+ push(@arg, '--post-file='.$options->{'postdata_path'});
+ }
+ }
+
+ push(@arg, (
+ $url,
+ '-O', $path
+ ));
+
+ if ($options->{'verbose'} ne '') {
+ print WGET."\n";
+ foreach my $a (@arg) {
+ print "$a\n";
+ }
+ }
+
+ my $r = system_encoded(WGET, @arg);
+
+ return $r;
+}
+
--- /dev/null
+###RUN_PERL:
+
+# Copyright (C) 2023 Balthasar Szczepański
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU Affero General Public License as
+# published by the Free Software Foundation, either version 3 of the
+# License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU Affero General Public License for more details.
+#
+# You should have received a copy of the GNU Affero General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use utf8;
+use Getopt::Long;
+use Encode::Locale ('decode_argv');
+use Encode ('encode', 'decode');
+
+###PERL_LIB: use lib '/botm/lib/post';
+use botm_common (
+ 'read_data_file', 'write_data_file'
+);
+use post_common (
+ 'prepare_post',
+ 'CODE'
+);
+
+###PERL_VERSION: use constant VERSION => 'x.x.x';
+
+###PERL_ENCODING_FILE: use constant ENCODING_FILE => 'UTF-8';
+
+use constant HELP_TEXT =>
+ "preview [options] [file(s)]\n".
+ " -l, --username=USERNAME\n".
+ # " -p, --password=PASSWORD\n".
+ " -t, --subject=POST_SUBJECT\n".
+ " -c, --content=POST_CONTENT\n".
+ # " -e, --edit=POST_ID\n".
+ # " -a, --append\n".
+ "\n".
+ " -d, --data-only\n".
+ "\n".
+ " -B, --bbcode\n".
+ " -b, --no-bbcode\n".
+ " -S, --smilies\n".
+ " -s, --no-smilies\n".
+ " -U, --urls\n".
+ " -u, --no-urls\n".
+ " -G, --signature\n".
+ " -g, --no-signature\n".
+ " -N, --notify\n".
+ " -n, --no-notify\n".
+ "\n".
+ " -o, --output-file=OUTPUT_FILE\n".
+ "\n".
+ " -q, --quiet\n".
+ " -v, --verbose\n".
+ # " --keep-tempfile\n".
+ "\n".
+ " -h, --help\n".
+ " --version\n";
+
+binmode STDIN, ':encoding(console_in)';
+binmode STDOUT, ':encoding(console_out)';
+binmode STDERR, ':encoding(console_out)';
+decode_argv();
+
+my %options = ();
+
+Getopt::Long::Configure('bundling');
+GetOptions (
+ 'username|l=s' => \$options{'username'},
+ # 'password|p=s' => \$options{'password'},
+ 'subject|t=s' => \$options{'subject'},
+ 'content|c=s' => \$options{'content'},
+ # 'edit|e=s' => \$options{'edit'},
+ # 'append|a' => \$options{'append'},
+
+ 'data-only|d' => \$options{'data-only'},
+
+ 'bbcode|B' => \$options{ 'bbcode'},
+ 'no-bbcode|b' => \$options{'no-bbcode'},
+ 'smilies|S' => \$options{ 'smilies'},
+ 'no-smilies|s' => \$options{'no-smilies'},
+ 'urls|U' => \$options{ 'urls'},
+ 'no-urls|u' => \$options{'no-urls'},
+ 'signature|G' => \$options{ 'signature'},
+ 'no-signature|g' => \$options{'no-signature'},
+ 'notify|N' => \$options{ 'notify'},
+ 'no-notify|n' => \$options{'no-notify'},
+
+ 'output-file|o=s' => \$options{'output-file'},
+
+ 'quiet|q' => \$options{'quiet'},
+ 'verbose|v' => \$options{'verbose'},
+ # 'keep-tempfile' => \$options{'keep-tempfile'},
+
+ 'help|h' => \$options{'help'},
+ 'version' => \$options{'version'},
+);
+
+if ($options{'help'} ne '') {
+ print HELP_TEXT;
+ exit 0;
+}
+if ($options{'version'} ne '') {
+ print VERSION."\n";
+ exit 0;
+}
+
+my $time = time();
+my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($time);
+my $timetext = sprintf (
+ "%04d-%02d-%02d %02d:%02d:%02d",
+ $year+1900, $mon+1, $mday, $hour, $min, $sec
+);
+
+if ($options{'quiet'} ne '') {
+ $options{'verbose'} = '';
+}
+if (($options{'output-file'} eq '') and ($options{'verbose'} eq '')) {
+ $options{'quiet'} = '1';
+}
+
+unless ($options{'quiet'} ne '') {
+ print "PREVIEW $$ $time - $timetext\n\n";
+ if ($options{'verbose'} ne '') {
+ print "OPTIONS:\n";
+ write_data_file(\*STDOUT, 'console_out', 0, \%options);
+ print "\n";
+ }
+}
+
+if ((scalar @ARGV) == 0) {
+ @ARGV = (\*STDIN);
+}
+
+my $code = CODE->{'OK'};
+foreach my $arg (@ARGV) {
+ my $r;
+
+ unless ($options{'quiet'} ne '') {
+ if ($arg == \*STDIN) {
+ print "STDIN\n";
+ }
+ else {
+ print "FILE $arg\n";
+ }
+ }
+
+ my %data = ();
+ unless (($arg == \*STDIN) and ($options{'content'} ne '') and ($options{'data-only'} ne ''))
+ {
+ %data = read_data_file($arg, ENCODING_FILE, $options{'data-only'});
+ unless (keys %data) {
+ unless ($options{'quiet'} ne '') {
+ print "NO DATA\n";
+ }
+ if ($code == CODE->{'OK'}) {
+ $code = CODE->{'POST_INVALID'};
+ }
+ print STDERR 'No data';
+ unless ($arg == \*STDIN) {
+ print STDERR " in file $arg";
+ }
+ print STDERR "\n";
+ next;
+ }
+ }
+ if ($options{'verbose'} ne '') {
+ write_data_file(\*STDOUT, 'console_out', 0, \%data);
+ print "\n";
+ }
+
+ my %post = prepare_post(\%options, \%data);
+ if ($options{'verbose'} ne '') {
+ print "POST\n";
+ write_data_file(\*STDOUT, 'console_out', 0, \%post);
+ print "\n";
+ }
+
+ # now generate preview
+}
+
+exit $code;
###PERL_LIB: use lib '/botm/lib/post';
use botm_common (
- 'read_data_file', 'write_data_file', 'write_postdata_file',
+ 'read_data_file', 'write_data_file',
'read_header_file',
'merge_url',
'html_entity_decode', 'url_query_encode',
- 'make_temp_path',
- 'system_encoded'
+ 'make_temp_path'
+);
+use post_common (
+ 'prepare_post',
+ 'wget',
+ 'CODE'
);
-
-use constant OK => 0;
-use constant POST_INVALID => 1;
-use constant POST_FAILED => 2;
-use constant POST_NOT_ACCEPTED => 3;
###PERL_VERSION: use constant VERSION => 'x.x.x';
###PERL_ENCODING_OTT: use constant ENCODING_OTT => 'UTF-8';
###PERL_ENCODING_MIRROR: use constant ENCODING_MIRROR => 'UTF-8';
-###PERL_DEFAULT_PASSWORD: use constant DEFAULT_PASSWORD => 'password';
-###PERL_DEFAULT_SUBJECT: use constant DEFAULT_SUBJECT => 'Re: 1190: "Time"';
-###PERL_DEFAULT_USERNAME: use constant DEFAULT_USERNAME => 'username';
-
-###PERL_WGET_RETRIES: use constant WGET_RETRIES => 3;
-###PERL_WGET_TIMEOUT: use constant WGET_TIMEOUT => 60;
-###PERL_WGET_USERAGENT: use constant WGET_USERAGENT => "post tool (http://bicyclesonthemoon.info/git-projects/?p=ott/post)";
-
-###PERL_WGET: use constant WGET => '/usr/bin/wget';
-
###PERL_TMP_PATH: use constant TMP_PATH => '/botm/tmp/post';
###PERL_MIRROR_URL: use constant MIRROR_URL => 'https://1190.bicyclesonthemoon.info/ott';
+###PERL_WGET_USERAGENT: use constant WGET_USERAGENT => "post tool (http://bicyclesonthemoon.info/git-projects/?p=ott/post)";
+
use constant HELP_TEXT =>
"sendpost [options] [file(s)]\n".
" -l, --username=USERNAME\n".
@ARGV = (\*STDIN);
}
-my $code = OK;
+my $code = CODE->{'OK'};
foreach my $arg (@ARGV) {
my $r;
unless ($options{'quiet'} ne '') {
print "NO DATA\n";
}
- if ($code == OK) {
- $code = POST_INVALID;
+ if ($code == CODE->{'OK'}) {
+ $code = CODE->{'POST_INVALID'};
}
print STDERR 'No data';
unless ($arg == \*STDIN) {
# }
unless ($options{'no-mirror'}) {
$r = post_to_mirror(\%options, \%post);
- if ($r == OK) {
+ if ($r == CODE->{'OK'}) {
next;
}
}
- if ($code == OK) {
+ if ($code == CODE->{'OK'}) {
$code = $r;
}
}
exit $code;
-
-sub prepare_post {
- (my $cmd_options, my $file_data) = @_;
- my %post;
-
- if (($cmd_options->{'subject'}) ne '') {
- $post{'subject'} = $cmd_options->{'subject'};
- }
- elsif (($file_data->{'subject'}) ne '') {
- $post{'subject'} = $file_data->{'subject'};
- }
- else {
- $post{'subject'} = DEFAULT_SUBJECT;
- }
-
- if (($cmd_options->{'username'}) ne '') {
- $post{'username'} = $cmd_options->{'username'};
- }
- elsif (($file_data->{'username'}) ne '') {
- $post{'username'} = $file_data->{'username'};
- }
- else {
- $post{'username'} = DEFAULT_USERNAME;
- }
-
- if (($cmd_options->{'password'}) ne '') {
- $post{'password'} = $cmd_options->{'password'};
- }
- elsif (($file_data->{'password'}) ne '') {
- $post{'password'} = $file_data->{'password'};
- }
- else {
- $post{'password'} = DEFAULT_PASSWORD;
- }
-
- if (($cmd_options->{'content'}) ne '') {
- $post{'content'} = $cmd_options->{'content'};
- }
- elsif (($file_data->{'content'}) ne '') {
- $post{'content'} = $file_data->{'content'};
- }
- else {
- $post{'content'} = '';
- }
-
- if (($cmd_options->{'no-bbcode'}) ne '') {
- $post{'bbcode'} = 0;
- }
- elsif (($cmd_options->{'bbcode'}) ne '') {
- $post{'bbcode'} = 1;
- }
- elsif (($file_data->{'bbcode'}) ne '') {
- $post{'bbcode'} = $file_data->{'bbcode'}+0;
- }
- else {
- $post{'bbcode'} = 1;
- }
-
- if (($cmd_options->{'no-smilies'}) ne '') {
- $post{'smilies'} = 0;
- }
- elsif (($cmd_options->{'smilies'}) ne '') {
- $post{'smilies'} = 1;
- }
- elsif (($file_data->{'smilies'}) ne '') {
- $post{'smilies'} = $file_data->{'smilies'}+0;
- }
- else {
- $post{'smilies'} = 1;
- }
-
- if (($cmd_options->{'no-urls'}) ne '') {
- $post{'urls'} = 0;
- }
- elsif (($cmd_options->{'urls'}) ne '') {
- $post{'urls'} = 1;
- }
- elsif (($file_data->{'urls'}) ne '') {
- $post{'urls'} = $file_data->{'urls'}+0;
- }
- else {
- $post{'urls'} = 1;
- }
-
- if (($cmd_options->{'no-signature'}) ne '') {
- $post{'signature'} = 0;
- }
- elsif (($cmd_options->{'signature'}) ne '') {
- $post{'signature'} = 1;
- }
- elsif (($file_data->{'signature'}) ne '') {
- $post{'signature'} = $file_data->{'signature'}+0;
- }
- else {
- $post{'signature'} = 1;
- }
-
- if (($cmd_options->{'no-notify'}) ne '') {
- $post{'notify'} = 0;
- }
- elsif (($cmd_options->{'notify'}) ne '') {
- $post{'notify'} = 1;
- }
- elsif (($file_data->{'notify'}) ne '') {
- $post{'notify'} = $file_data->{'notify'}+0;
- }
- else {
- $post{'notify'} = 0;
- }
-
- if (($file_data->{'time'}) ne '') {
- $post{'time'} = $file_data->{'time'}+0;
- }
- else {
- $post{'time'} = 0;
- }
-
- return %post;
-}
-
sub post_to_mirror {
(my $cmd_options, my $post) = @_;
print 'INVALID ID '.$cmd_options->{'edit'}."\n";
}
print STDERR 'Not a valid mirror post ID: '.$cmd_options->{'edit'}."\n";
- return POST_INVALID;
+ return CODE->{'POST_INVALID'};
}
$query_data{'e'} = 'm'.$cmd_options->{'edit'};
}
print "WGET FAIL $r\n";
}
print STDERR "Failed to get edit page: wget: $r\n";
- return POST_FAILED;
+ return CODE->{'POST_FAILED'};
}
unless (open($fh, '<:encoding('.ENCODING_MIRROR.')', encode('locale_fs', $tmp_path))) {
print "FAIL open $tmp_path\n";
}
print STDERR "Failed to open edit page. $tmp_path\n";
- return POST_FAILED;
+ return CODE->{'POST_FAILED'};
}
%header = read_header_file($fh, ENCODING_MIRROR());
print 'FAIL '.$header{':status-code'}.' '.$header{':reason-phrase'}."\n";
}
print STDERR 'Failed to get edit page: '.$header{':status-code'}.' '.$header{':reason-phrase'}."\n";
- return POST_FAILED;
+ return CODE->{'POST_FAILED'};
}
if (($cmd_options->{'edit'} ne '') and ($cmd_options->{'append'} ne '')) {
print "FAIL previous post\n";
}
print STDERR 'Failed getting previous post content: '.$previous_post{'error'}."\n";
- return POST_FAILED;
+ return CODE->{'POST_FAILED'};
}
if ($cmd_options->{'verbose'} ne '') {
print "PREVIOUS POST\n";
print "WGET FAIL $r\n";
}
print STDERR "Failed to get post submit response: wget: $r\n";
- return POST_FAILED;
+ return CODE->{'POST_FAILED'};
}
unless (open($fh, '<:encoding('.ENCODING_MIRROR.')', encode('locale_fs', $tmp_path))) {
print "FAIL open $tmp_path\n";
}
print STDERR "Failed to open post submit response. $tmp_path\n";
- return POST_FAILED;
+ return CODE->{'POST_FAILED'};
}
%header = read_header_file($fh, ENCODING_MIRROR());
print 'FAIL '.$header{':status-code'}.' '.$header{':reason-phrase'}."\n";
}
print STDERR 'Failed to get post submit response page: '.$header{':status-code'}.' '.$header{':reason-phrase'}."\n";
- return POST_FAILED;
+ return CODE->{'POST_FAILED'};
}
($r, $s) = get_mirror_post_status($fh);
print "FAIL $s\n";
}
print STDERR "Post not accepted by mirror: $s.\n";
- return POST_NOT_ACCEPTED;
+ return CODE->{'POST_NOT_ACCEPTED'};
}
unless ($cmd_options->{'quiet'} ne '') {
unlink($tmp_path, $cookie_path, $postdata_path);
}
- return OK;
+ return CODE->{'OK'};
}
sub get_mirror_post_status {
}
return %post;
}
-
-sub wget {
- (my $url, my $path, my $options, my $postdata) = @_;
-
- my @arg = (
- WGET,
- '-t', WGET_RETRIES,
- '--connect-timeout='.WGET_TIMEOUT,
- );
-
- unless ($options->{'verbose'} ne '') {
- push(@arg, '-q');
- }
-
- if ($options->{'with_header'}) {
- push(@arg, '--save-headers');
- }
-
- if ($options->{'cookie_path'} ne '') {
- if (-f $options->{'cookie_path'}) {
- push(@arg, '--load-cookies='.$options->{'cookie_path'});
- }
- push(@arg, '--save-cookies='.$options->{'cookie_path'});
- }
- else {
- push(@arg, '--no-cookies');
- }
-
- if ($options->{'useragent'} ne '') {
- push(@arg, '-U', $options->{'useragent'});
- }
-
- if ($options->{'referer'} ne '') {
- push(@arg, '--referer='.$options->{'referer'});
- }
-
- if ($options->{'postdata_path'} ne '') {
- if (defined $postdata) {
- write_postdata_file(
- $options->{'postdata_path'},
- ENCODING_FILE, $options->{'encoding'},
- $postdata
- );
- push(@arg, '--post-file='.$options->{'postdata_path'});
- }
- }
-
- push(@arg, (
- $url,
- '-O', $path
- ));
-
- if ($options->{'verbose'} ne '') {
- print WGET."\n";
- foreach my $a (@arg) {
- print "$a\n";
- }
- }
-
- my $r = system_encoded(WGET, @arg);
-
- return $r;
-}
-
bicyclesonthemoon.info / projects / ott / post / commitdiff