k3cの日記: ワタシ風スクリプト
若干改訂版 (^^;
#!/usr/bin/perl
############################################################
#
# make otomodachilist script
# otomodachimake3.pl
#
# Original script "otomodatilistmake.pl" is coded by:
# SORAMINE Yukino (yukinosky@mail.goo.ne.jp)
# Modified by:
# k3c (k3c_AT_tokyo.com)
#
# UPDATE RECORDS:
# 20011001 create.
# 20011002 debug...
# 20011003 modified by k3c
#
############################################################
########### main routine
{
##### Customizable parts
$diarytext = 'Diary';
$friendinfo = 'User Info.';
$userinfo1 = 'Friends of ';
$userinfo2 = ' (in alphabetical order)';
##### slashdot HTML
$userinfourl = '<A HREF="http://srad.jp/users.pl?op=userinfo&nick=';
$diaryurl = '<A HREF="http://srad.jp/journal.pl?op=display&uid=';
$startline = '<!-- start template: ID 143, journalfriends;journal;default -->';
$endline = '<!-- end template: ID 143, journalfriends;journal;default -->';
##### modules
use Getopt::Long;
&GetOptions("help!");
##### initialize global variables
$usernick = ''; # Your nickname
%uid = (); # 'friend nickname --> userid' reference table
##### declare subroutines
sub readandstore;
sub sortandwrite;
sub usage;
##### show usage
($opt_help) and usage;
##### open files
if ($#ARGV > -1) {
($infile, $outfile) = @ARGV;
unless (open STDIN, "< $infile") {
print STDERR "Error: failed to open input file: $infile\n";
usage;
}
if (($outfile) and not (open STDOUT, "> $outfile")) {
print STDERR "Error: failed to open output file: $outfile\n";
usage;
}
}
##### main stream
readandstore;
sortandwrite;
##### close files
($infile) and close STDIN;
($outfile) and close STDOUT;
##### all over
exit;
}
########## subroutines
sub readandstore {
##### initialize local variables
my $process;
while ( <STDIN> ) {
### process flow
(m#$startline#o) and ($process = 1); # start of block
($process) or next; # skip if not yet started
(m#$endline#o) and last; # end of block
### store infomation
# user name
if (m#^\t{7}<BOLD>(.+) の友達リスト</BOLD>#) {
$usernick = $1;
next;
}
# friends
if (m#^\t{9}<A HREF.+uid=(\d+)">(.+)</A>$#) {
$uid{$2} = $1;
next;
}
}
1;
}
sub sortandwrite {
##### initialize
my $closeanchor = '</A>';
my $tagclose = '">';
my $blank = ' ';
my $nick;
my $urlnick;
##### write header lines
($urlnick = $usernick) =~ s# #%20#;
print $userinfo1, $userinfourl, $urlnick, $tagclose, $usernick, $closeanchor, $userinfo2, "\n\n";
##### write friends lines
foreach $nick (sort {lc($a) cmp lc($b)} keys %uid) {
($urlnick = $nick) =~ s# #%20#g; # substitute half spacing to %20
print $diaryurl, $uid{$nick}, $tagclose, $diarytext, $closeanchor, # link to diary
$blank, # blank
$userinfourl, $urlnick, $tagclose, $friendinfo, $closeanchor, # link to user info.
$blank, # blank
$nick, ' (', $uid{$nick}, ')', # friend name
"\n"; # line feed
}
print "\n";
1;
}
sub usage {
die "Usage: $0 [--help] [input [output]]\n";
1;
}