soramineの日記: otomodatilistmake.pl(修正版)
#!/usr/bin/perl -w
############################################################
#
# make otomodatilist script
# otomodatilistmake.pl
#
# This script is coded by SORAMINE Yukino
# mailto: yukinosky@mail.goo.ne.jp
#
# UPDATE RECORDS:
# 20011001 think and create.
# 20011002 make sub routines and open
# 20011003 modify typographical error and sort rule
#
# Special Thanks:
# haresu (http://srad.jp/users.pl?op=userinfo&nick=haresu)
#
############################################################
########### main routine
{
##### initialize grobal variables(define/const data)
$friendsfilename = 'otomodatilist_light.html'; # 'journal.pl' name move
$outputlistname = 'friend_html.txt'; # output file name
$diaryfirst = '<a href="http://srad.jp/journal.pl?op=display&uid=';
$diarysecond = '">日記</a>';
$userinfofirst = '<a href="http://srad.jp/users.pl?op=userinfo&nick=';
$userinfosecond = '">ユーザ情報</a>';
$userinfotitle = '">空峰雪乃 (1131)</a> のお友達りすと♪(アルファベット順です)';
##### initialize grobal variables(to store)
$mynick = ''; # store my nick
@forwritinglist = (); # store write data with using hash variable
%friendspair = (); # store hash 'friend nickname = userid' data
##### exec sub routine
&readandstore;
&listsorting;
&outwrite;
exit;
}
########## exec part
sub readandstore
{
##### initialize local variables
my $startline = '<!-- start template: ID 143, journalfriends;journal;default -->';
my $endline = '<!-- end template: ID 143, journalfriends;journal;default -->';
my $processflag = 'off';
##### open otomodati_list_html_file
open(FRIENDFILE, "< $friendsfilename") || die("Error: Open Failed File $friendsfilename: ");
{
foreach my $processline (<FRIENDFILE>)
{
### remove newline code
chomp($processline);
### process flow
if($processline eq $startline){ $processflag = 'on'; next; } # set processflag
if($processflag eq 'off'){ next; } # skip
if($processline eq $endline){ last; } # process end
### store infomation
# <BOLD>soramine の友達リスト</BOLD>
if($processline =~ /^\t{7}<BOLD>.+? の友達リスト<\/BOLD>$/)
{
$processline =~ s/^\t{7}<BOLD>(.+?) の友達リスト<\/BOLD>$/$1/g;
$mynick = $processline;
next;
}
# <A HREF="journal.pl?op=display&uid=1131">soramine</A>
if($processline =~ /^\t{9}<A HREF=\"journal\.pl\?op\=display\&uid=.+?\">.+?<\/A>$/)
{
$processline =~ s/^\t{9}<A HREF=\"journal\.pl\?op\=display\&uid=(.+?)\">(.+?)<\/A>$/$1$2/g;
$friendspair{$2} = $1;
push(@forwritinglist, $2); # sorting forward
}
}
}
close(FRIENDFILE);
}
sub listsorting
{
##### initialize local variables
my %saveorig = ();
my @sortinglist = ();
##### readiness
while(@forwritinglist)
{
my $friendnick = shift(@forwritinglist); # popup from nickname list
my $lcnick = lc($friendnick); # change lower characters
$saveorig{$lcnick} = $friendnick; # save original characters
push(@sortinglist, $lcnick);
}
##### sorting
@sortinglist = sort(@sortinglist);
##### re-push
foreach my $friendnick (@sortinglist)
{
push(@forwritinglist, $saveorig{$friendnick});
}
}
sub outwrite
{
open(OUTLIST, "> $outputlistname") || die("Error: Open Failed File $outputlistname: ");
{
##### write header lines
print OUTLIST ' ' . $userinfofirst . $mynick . $userinfotitle . "\n";
print OUTLIST "\n";
##### write friends lines
foreach my $friendnick (@forwritinglist)
{
my $usingnick = $friendnick;
$usingnick =~ s/ /%20/g; # substitute half spacing to %20
print OUTLIST $diaryfirst . $friendspair{$friendnick} . $diarysecond . ' ' . $userinfofirst . $usingnick . $userinfosecond . ' ' . $friendnick . ' (' . $friendspair{$friendnick} . ') さん' . "\n";
}
print OUTLIST "\n";
}
close(OUTLIST);
}