'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';
" -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)';
'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);
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";
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) {
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;
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 {
my $r = system_encoded(WGET, @arg);
- return $r>>8;
+ return $r;
}
# 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;
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)