]> bicyclesonthemoon.info Git - ott/post/commitdiff
1.0.1 v1.0.1
authorb <rowerynaksiezycu@gmail.com>
Sat, 8 Jul 2023 20:31:57 +0000 (20:31 +0000)
committerb <rowerynaksiezycu@gmail.com>
Sat, 8 Jul 2023 20:31:57 +0000 (20:31 +0000)
--version
--keep-tempfile
check status for success confiration
return post ID on success

sendpost.1.pl
settings.txt

index d83b0a4481b9b060794f008f6bb1c3aeb5cc93d9..97d317477ca8aea27dac6ad506c7c9f4ec87e1db 100644 (file)
@@ -31,6 +31,8 @@ use botm_common (
        'system_encoded'
 );
 
+###PERL_VERSION: use constant VERSION => 'x.x.x';
+
 ###PERL_ENCODING_FILE:   use constant ENCODING_FILE    => 'UTF-8';
 ###PERL_ENCODING_OTT:    use constant ENCODING_OTT     => 'UTF-8';
 ###PERL_ENCODING_MIRROR: use constant ENCODING_MIRROR  => 'UTF-8';
@@ -74,9 +76,12 @@ use constant HELP_TEXT =>
        "  -m,  --no-mirror\n".
        "  -R,  --mirror-url=MIRROR_URL\n",
        "\n".
-       "  -h,  --help\n".
        "  -q,  --quiet\n".
-       "  -v,  --verbose\n";
+       "  -v,  --verbose\n".
+       "       --keep-tempfile\n".
+       "\n".
+       "  -h,  --help\n".
+       "       --version\n";
 
 binmode STDIN,  ':encoding(console_in)';
 binmode STDOUT, ':encoding(console_out)';
@@ -110,16 +115,22 @@ GetOptions (
        'no-mirror|m'    => \$options{'no-mirror'},
        'mirror-url|R=s' => \$options{   'mirror-url'},
        
-       'help|h'         => \$options{'help'},
        'quiet|q'        => \$options{'quiet'},
        'verbose|v'      => \$options{'verbose'},
-       # TODO: useragent
+       '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);
@@ -351,9 +362,9 @@ sub post_to_mirror {
        my %post_data = ();
        my %query_data = ();
        my %header = ();
-       my $error = '';
        my $fh;
        my $r;
+       my $s;
        
        unless ($cmd_options->{'quiet'} ne '') {
                print "POST TO MIRROR\n";
@@ -363,6 +374,13 @@ sub post_to_mirror {
                if ($cmd_options->{'edit'} =~ /^m([0-9]+)$/) {
                        $cmd_options->{'edit'} = $1;
                }
+               else {
+                       unless ($cmd_options->{'quiet'} ne '') {
+                               print 'INVALID ID '.$cmd_options->{'edit'}."\n";
+                       }
+                       print STDERR 'Not a valid mirror post ID: '.$cmd_options->{'edit'}."\n";
+                       return 1;
+               }
                $query_data{'e'} = 'm'.$cmd_options->{'edit'};
        }
        if (keys %query_data) {
@@ -479,34 +497,41 @@ sub post_to_mirror {
                return int($header{':status-code'})
        }
        
-       $error = find_mirror_post_error($fh);
+       ($r, $s) = get_mirror_post_status($fh);
        close ($fh);
        
-       if ($error ne '') {
+       unless ($r) {
                unless ($cmd_options->{'quiet'} ne '') {
-                       print "FAIL $error\n";
+                       print "FAIL $s\n";
                }
-               print STDERR "Post not accepted by mirror: $error.\n";
+               print STDERR "Post not accepted by mirror: $s.\n";
                return 1;
        }
        
        unless ($cmd_options->{'quiet'} ne '') {
-               print "POSTED TO MIRROR.\n\n";
+               print 'POSTED TO MIRROR';
+               if ($s ne '') {
+                       print " id=$s";
+               }
+               print "\n\n";
        }
        
        # in case of earlier failure, the temp files will remain,
        # for investigation.
        # a bot should remove them after some time.
-       unlink($tmp_path, $cookie_path, $postdata_path);
+       unless ($cmd_options->{'keep-tempfile'} ne '') {
+               unlink($tmp_path, $cookie_path, $postdata_path);
+       }
        
        return 0;
        
 }
 
-sub find_mirror_post_error {
+sub get_mirror_post_status {
        (my $file) = @_;
        my $fh;
-       my $error = '';
+       my $ok = 1;
+       my $text = 's';
        
        if(ref($file)) {
                $fh=$file;
@@ -520,21 +545,29 @@ sub find_mirror_post_error {
        while (defined(my $line = <$fh>)) {
                # TODO: better catch mechanism!
                if ($line =~ /<p class="error">(.*)<\/p>/) {
-                       if ($1 ne '') {
-                               $error = html_entity_decode($1);
-                       }
-                       else {
-                               $error =  '""';
-                       }
+                       $ok = 0;
+                       $text = html_entity_decode($1);
                        last;
                }
+               if (lc($line) =~ /<h2>information/) {
+                       $ok;
+               }
+               if ($line =~ /p=([0-9]+)#m([0-9]+)/) {
+                       if ($ok and ($1 eq $2)) {
+                               $text = 'm'.$1;
+                       }
+               }
        }
        
        unless (ref($file)) {
                close ($fh);
        }
        
-       return $error;
+       if ((not $ok) and ($text eq '')) {
+               $text = '???';
+       }
+       
+       return ($ok, $text);
 }
 
 sub wget {
@@ -598,6 +631,6 @@ sub wget {
        my $r = system_encoded(WGET, @arg);
        
        
-       return $r>>8;
+       return $r;
 }
 
index ad4d3664788d9229626e5fa5491113ab5b53748a..40a8c266f2996f8521ab1ace0015cf1938715d93 100644 (file)
@@ -16,6 +16,8 @@
 # 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/>.
 
+_version: 1.0.1
+
 _PERL_STR: '@_ESCAPE($0,')'
 _SHEBANG: #!$0
 _PERL_USE_2: use $0 $1;
@@ -47,6 +49,7 @@ PERL_ENCODING_MIRROR   = @_PERL_CONSTANT_STR( ENCODING_MIRROR  , $encoding_mirro
 PERL_ENCODING_OTT      = @_PERL_CONSTANT_STR( ENCODING_OTT     , $encoding_ott)
 PERL_MIRROR_URL        = @_PERL_CONSTANT_STR( MIRROR_URL       , $mirror_url)
 PERL_TMP_PATH          = @_PERL_CONSTANT_STR( TMP_PATH         , $tmp_path)
+PERL_VERSION           = @_PERL_CONSTANT_STR( VERSION          , $_version)
 
 PERL_WGET_RETRIES      = @_PERL_CONSTANT_STR( WGET_RETRIES     , $wget_retries)
 PERL_WGET_TIMEOUT      = @_PERL_CONSTANT_STR( WGET_TIMEOUT     , $wget_timeout)