#!/usr/bin/perl -T
use warnings;
use strict;
use CGI;
use Fcntl;
my $password = 'here goes the password';
my $basedir = '/var/www/blog/';
my $baseurl = 'http://blog.example.org/';
##############################################################################
my $query = new CGI;
my $pwd = $query->param('pwd') || '';
fatal('Bad password.') if $pwd ne $password;
my $title = $query->param('title');
fatal('Missing title.') if not $title;
my $text = $query->param('fckeditor');
fatal('Missing text.') if not $text;
$text =~ s/\r//g;
my $postfile;
if ($query->param('unpublished')) {
$postfile = $basedir . 'unpublished/';
} else {
$postfile = $basedir . 'data/';
}
my $posturl = $baseurl;
my $category = $query->param('category') || '';
$category =~ /^([a-z]+)/;
$postfile .= $1 . '/' if $1;
$posturl .= $1 . '/' if $1;
my $postid = new_post_id($basedir);
$postfile .= "$postid.txt";
$posturl .= "id_$postid";
sysopen(POST, $postfile, O_WRONLY | O_CREAT | O_EXCL)
or fatal("sysopen($postfile): $!");
print POST "$title\n$text\n";
close POST;
print "Content-Type: text/plain\n"
. "Status: 303 See Other\n"
. "Location: $posturl\n"
. "\n"
. "OK (posted as $posturl)\n";
exit 0;
##############################################################################
# XXX there is a small race here...
sub new_post_id {
my ($dir) = @_;
my @files = (
glob("$dir/data/*.txt"),
glob("$dir/data/*/*.txt"),
glob("$dir/unpublished/*.txt"),
glob("$dir/unpublished/*/*.txt"),
);
@files = sort { $a <=> $b } map { /.+\/([0-9]+)\.txt$/ } @files;
my $id = pop(@files) || 0;
return $id + 1;
}
sub fatal {
print "Status: 500 program error\n"
. "Content-Type: text/plain\n\n"
. "$_[0]\n";
exit 0;
}