日記才人・テキスト庵用更新報告スクリプト。
いちいちwebブラウザを立ち上げなくても、Unixのコマンドラインから更新報告ができます。
自動ftpスクリプト (mirrorとか) と組み合わせておけば、コンテンツのアップロードから
更新報告までコマンド一発。
但し、自動空更新とかサーバに迷惑をかけることは御遠慮ください。  

わかる人はテキトーに切り貼りして使って下さい。核になるのは postForm() で、
こいつに適当なパラメータを渡してやればどんなフォームへのpostも自動化できます。

要jcode.pl (このディレクトリにもjcode.pl.txtという名で置いてあります)

#! /usr/bin/perl
#
# NE-UPDATE -- update Nikki-Engine one-line comment
#
# Copyright (c) 1999 by Shiro Kawai, shiro@acm.org
# This program is provided "as is".  The author disclaim any warranties,
# and shall not be liable to anybody for the outcome of using this
# software.
#
# $Id: ne-update,v 1.10 2001/01/07 20:05:59 shiro Exp $
#

require "jcode.pl";
use Socket;
use Getopt::Long;
use FileHandle;


# USAGE:
#   ne-update -ne|-ta <diary#> <password> <your-diary-file>
#
# <diary#> is the registration number of your diary.
# <password> is your nikki-engine password.
# <your-diary-file> is your diary file, prepared for the automatic
# update feature of Nikki Site, i.e. containing a line which matches:
#   /<!--NE_COMMENT="(.*)"-->/
#
# -ne     : Nikki Site
# -ta     : Text AN
#
# To customize, add appropriate sub's below the "Server dependent routines".


#======================================================
# Misc routines
#

# safeUrl URL_STRING
#
#  Escape special characters of URL in given arg.
#  See http://www.w3.org/Protocols/rfc2068/rfc2068 for details
#
sub safeUrl {
  local $_ = shift;
  s/([;\?\/\@\:&=+\#%<>\000-\037])/"%" . unpack("H*", $1)/eg;
  tr/ /+/;
  return $_;
}

# getComment DIARY_FILE
#
#  Get Nikki-Engine comment embedded in the DIARY_FILE
#
sub getComment {
  my $filename = shift;
  my $comment;
  open FILE,$filename or die "Couldn't open $filename.\n";
  while (<FILE>) {
    /<!--NE_COMMENT="(.*)"-->/ and do {
      $comment = $1;
      last;
    };
  }
  die "Couldn't find NE_COMMENT in file $filename.\n" unless $comment;
  $comment =~ s/\\\"/\"/g;
  $comment =~ s/\\\\/\\/g;
  return $comment;
}

# postForm HOST UPDATE_CGI NAME VALUE ...
#
#  Submit the form data using POST method.  HOST is a hostname of the http
#  server and UPDATE_CGI is a pathname of the CGI script.   Followings
#  are NAME and VALUE pairs for the parameters.

sub postForm {
  my ($host, $update_cgi, @params) = @_;

  my @p;
  while (@params) {
    my $c = safeUrl(shift @params);
    $c .= "=";
    $c .= safeUrl(jcode::euc(shift @params));

    push @p, $c;
  }
  my $content = join "&", @p;
  my $content_length = 2 + length $content; # +2 for CR and LF
  
  if ($test) {
    print "$content\n";
    print "$content_length\n";
    exit 0;
  }

  # Open socket
  my ($hostname, $port) = split(":", $host, 2);
  my $iaddr = inet_aton($hostname) or die "Can't find host '$host'\n";
  my $port  = 80 unless ($port);
  my $paddr = sockaddr_in($port, $iaddr);
  my $proto = getprotobyname('tcp');
  socket(SOCK, PF_INET, SOCK_STREAM, $proto) or die "Can't create socket: $!\n";
  connect(SOCK, $paddr) or die "Connect failed: $!\n";
  SOCK->autoflush(1);

  # send header
  print SOCK "POST $update_cgi HTTP/1.1\r\n";
  print SOCK "Host: $hostname\r\n";
  print SOCK "Expect: 100-continue\r\n";
  print SOCK "Content-Type: application/x-www-form-urlencoded\r\n";
  print SOCK "Content-Length: $content_length\r\n";
  print SOCK "\r\n";

  print "Request header sent.\n";

  # Wait for reply.  NOTE: the server need not respond here, so we set
  # timeout to the select() call.
  $rvec = '';
  vec($rvec, fileno(SOCK), 1) = 1;
  $navail = select($rvec, undef, undef, 10);
  if ($navail) {
    $reply = <SOCK>;
    $reply !~ /100/ and do {
      close SOCK;
      die "Server complains: $reply\nExitting...\n";
    };
  }

  # send content
  print SOCK "$content\r\n";
  print SOCK "\r\n";

  print "Content sent.\n";

  # receive the result.
  while (<SOCK>) {
    print $_;
    /^0\r$/ and last; # for chunked reply - more proper check is required.
  }
  close SOCK;
}

#======================================================
# Server dependent routines
#

sub NikkiSite {
  my ($diary_num, $passwd, $comment) = @_;
  postForm("www.nikki-site.com", "/exes/update.pl",
           "num"      => $diary_num,
           "passwd"   => $passwd,
           "comment"  => $comment,
           "do_lite"  => 1);
}

sub TextAN {
  my ($diary_num, $passwd, $comment) = @_;
  postForm("www.mmm.ne.jp", "/~soulfing/text/vagabond/report.cgi",
           "ope"      => "report_one",
           "reg_num"  => $diary_num,
           "password" => $passwd,
           "new_subtitle" => $comment,
           "submit"   => "submit");
}

#======================================================
# Main
#

sub usage {
  print "Usage: $0 [-ne][-ta] diary# password [diary_file]\n";
}

GetOptions("test"    => \$test,
           "ne"      => \$ne,
           "ta"      => \$ta)
  or usage();

usage() if (scalar(@ARGV) < 2);

$diary_num = $ARGV[0];
$diary_pass = $ARGV[1];
$comment = getComment($ARGV[2]) if ($ARGV[2]);

NikkiSite      ($diary_num, $diary_pass, $comment) if ($ne);
TextAN         ($diary_num, $diary_pass, $comment) if ($ta);

exit 0;

# Local variables:
# mode: perl
# end: