パスワードを忘れた? アカウント作成
737302 journal

soramineの日記: otomodatilistmake.pl(修正版)

日記 by soramine

#!/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);
}

typodupeerror

日々是ハック也 -- あるハードコアバイナリアン

読み込み中...