use Win32::Clipboard; use Tk; use Unicode::Japanese; $s = Unicode::Japanese->new(); $cgidir = "C:/anhttpd" . $ENV{'CGIDIR'}; opendir(DIR, $cgidir); @files = grep(/^renewal(_\d{4}_\d{2})?\.xml$/, readdir(DIR)); foreach $file (@files){ open(FILE,"$cgidir/$file"); while(){ $_ = $s->set($_,'utf8')->sjis; if(/(.+?)<\/title>/){ $title = $1; }elsif(/(.+?)<\/link>/){ $url = $1;$date = $1; if($date =~ s/^.+(\d{4})_(\d{2})\.html#([a-z]+)_(\d+)$/$4/){ $link{$date} = "$url\t${1}-$2\t$title($3)"; }elsif($date =~ s/^.+\.html#([a-z]+)_(\d+)$/$2/){ $link{$date} = "$url\t今月\t$title($1)"; } $sw = 0; } } } close(FILE); } closedir(DIR); my $mw = MainWindow->new; $mw->title("更新日記コンソール"); $menub = $mw->Menubutton(-text => "マイ楽コピー", -font => "MS ゴシック 10.5 normal", -relief => 'raised', -menuitems => [["command" => "ハイパーリンク", -command => [\&raku_hyperlink, "hlink"]], ["command" => "引用", -command => [\&raku_hyperlink, "cite"]], "-", ["command" => "終了", -command => sub { exit }] ])->pack(-side => 'left'); $menub = $mw->Menubutton(-text => "更新日記記事リンク出力", -font => "MS ゴシック 10.5 normal", -relief => 'raised')->pack(-side => 'right'); $menub->command(-label => "Exit", -command => sub { exit }); $menub->separator; foreach my $key (sort {$b <=> $a} keys(%link)){ ($link, $date, $title) = split(/\t/,$link{$key}); $menub->command(-label => "$date $title", -command => [\&hyperlink, $link, $title]); } MainLoop; sub raku_hyperlink{ my ($arg) = @_; # クリップボードの文字列を取得する $CLIP = Win32::Clipboard(); $clipstr = $CLIP->Get(); # Rakucopyクリップボード文字列から取得する文字列の改行は CRLF である @content = split(/\r\n/, $clipstr); # クリップボードのタイトルの取得 $title = shift(@content); # クリップボードの URL の取得 $url = shift(@content); # クリップボードの引用部分の取得 $cite = join("\n",@content); if($arg eq "hlink"){ $CLIP->Set("$title"); }elsif($arg eq "cite"){ $CLIP->Set("

$title\n

\n$cite\n
"); } return; } sub hyperlink{ my($link, $title) = @_; $CLIP = Win32::Clipboard(); $CLIP->Set("$title"); return; }