##!c:/perl/bin/perl -w
# $RCSfile: __perl_net_get_news_win32_tk_u_02_003.pl $ $Revision: 0.2003 $ $Date: 2018/2/13 00:00:01 $
# Perl version    : 5.240.2400
# Perl/Tk version : 804.027   :Tk patchLevel        , 804
# @ Copy right    : Hiroshi Hayashi:geg01137@nifty.com
#------------------------------------------------------------------
#use strict;
#use warnings;
use utf8;
use Tk;
use Win32::GUI();
use Win32;
use Cwd;
use LWP::Simple;
use LWP::UserAgent;
use Encode::JP;
use Encode qw(from_to encode decode is_utf8 encode_utf8);
use Encode::Guess qw/shift-jis euc-jp 7bit-jis/;
use Time::Local;
# -----------------------------------------------------------
#   グローバル変数
my  $font             = "{ＭＳ 明朝} 16";
my  $fontsize         = 16;
my  $font1            = '{ＭＳ 明朝}16';
my  $font2            = '{ＭＳ 明朝}16';#タイトルの文字の大きさ
my  $scrolled_height  = 16;
my  $scrolied_width   = 16;
my  $f_read_prog_s    = encode("shift-jis","__perl_net_get_news_win32_tk_u_02_003_readme_u.htm"); # 注意事項_プログラム使用
#   メインメニュー -------------------------------------
my  $top   = MainWindow->new();
             $top->title("ニュース各社まとめ読み by ActivePerl");
my  $t_t  .= "====================================================================\n";
    $t_t  .= "＊＊＊＊　　　　　ニュース各社まとめ読みツール＊＊＊＊ 　　　　　　 \n";
    $t_t  .= "====================================================================\n";
    $t_t  .= "朝日・毎日・読売・IZA・中日新聞・Livdoor・Yahooをまとめて読みます。 \n";
    $t_t  .= "最初の起動時のみ、１時間以内分の記事を選択します。　　　　　　　　　\n";
    $t_t  .= "その後は、前に読んだ時間以降の記事を選択します。（最長２４時間以内）\n";
    $t_t  .= "一番古い記事の時間を変えると、最長２４時間以内まで遡れます。　　　　\n";
    $t_t  .= "===================================================================\n";
    $top->Label (-font => $font1,-text => $t_t                ,-foreground => 'blue'                 )->pack(-side => "top");
    $top->Button(-font => $font2,-text => "ニュース読み・処理",-command =>  \&all                    )->pack(-side => "left");
    $top->Button(-font => $font2,-text => "ニュース読みのみ"  ,-command =>  \&news_get               )->pack(-side => "left");
    $top->Button(-font => $font2,-text => "ニュース処理のみ"  ,-command =>  \&perl_get_news_htm2table)->pack(-side => "left");
    $top->Button(-font => $font2,-text => "説明書"            ,-command =>  \&message_manual         )->pack(-side => "left");
    $top->Button(-font => $font2,-text => "バージョン表示他"  ,-command =>  \&message_about          )->pack(-side => "left");
    $top->Button(-font => $font2,-text => "終了"              ,-command => sub { exit; }             )->pack(-side => "right");
MainLoop();
# sub ========================================================================
sub all {
  &news_get;
  &perl_get_news_htm2table;
  print "end\n";# <stdin>;
}
# --------------------------------------------------------------------
# html2table_begin----------------------------------------
sub perl_get_news_htm2table {
    # now time ---------------------------------------------
    ($sec,$min,$hour,$mday,$month,$year,$wday,$stime) = localtime(time); 
    $year_now         = $year  + 1900;
    $month_now        = $month +    1;
    $time_now         = sprintf("%04d%02d%02d_%02d%02d%02d",$year_now,$month_now,$mday,$hour,$min,$sec);
    # move htm2csv and htm2table old file ----------------------------
    opendir(DRC,".");@f_old = grep(/_htm2csv_\d+\.htm$/i  || /_htm2table_\d+\.htm$/i,readdir(DRC));closedir(DRC);
    foreach $f_old(@f_old) {
      $drc            = "_kiji_01";mkdir($drc,"0644");
      open(IN,"< $f_old");open(OU,"> $drc/$f_old"); 
      while(<IN>) {print OU;} 
      close(IN);          close(OU);
      unlink($f_old);
    }
    # read old time ---------------------------------------------------------------
    opendir(DRC,".");@f_temp = grep(/^temp/ && /\.htm$/,readdir(DRC));closedir(DRC);  
    if((@f_temp) == 0)  {
      print encode("shift-jis","[記事が有りません！記事を読んでからこの処理をしてください[CR]\n");#<stdin>;
      last;
    }
    $f_old            = $f_temp[0];       ($time_old) = ($f_old =~ m#(\d+_\d+)_#);$time_old2  = $time_old;$time_old2 =~ s/_/\./;
    $f_new            = $f_temp[$#f_temp];($time_new) = ($f_new =~ m#(\d+_\d+)_#);$time_new2  = $time_new;$time_new2 =~ s/_/\./;
    $time_sa          = $time_new2 -  $time_old2;
    print encode("shift-jis","時間差は[$time_new2 -  $time_old2]->[$time_sa]です\n");#<stdin>;
    if($time_sa < 0.0030)  {    # ３０分以内は、「１時間前」から処理する
      print encode("shift-jis","前回との時間差は[$time_sa]です\n");
      print encode("shift-jis","新しい記事の１時間前から処理します\n");
     ($year_old,$month_old,$mday_old,$hour_old,$min_old,$sec_old)  = 
     ($time_new2      =~ m/(\d{4})(\d{2})(\d{2})\.(\d{2})(\d{2})(\d{2})/);      # print "($year_old,$month_old,$mday_old,$hour_old,$min_old,$sec_old)";<stdin>;
      $month_old     -=    1;
      $year_old      -= 1900;
      $time_old3      = timelocal($sec_old,$min_old,$hour_old,$mday_old,$month_old,$year_old);
      $time_old3      -= 60 * 60;
     ($sec_old,$min_old,$hour_old,$mday_old,$month_old,$year_old,$wday_old,$yday_old,$isdst_old) = localtime($time_old3);
      $month_old      +=    1;
      $year_old       += 1900;
      $time_old4       = sprintf("%04d%02d%02d_%02d%02d%02d",$year_old,$month_old,$mday_old,$hour_old,$min_old,$sec_old);
      print encode("shift-jis","[$time_old4]以降を読みます\n");
      $time_old        =  $time_old4;
    }
    elsif($time_sa > 1.000000)  {  # １日以上は、１日分処理する
      print encode("shift-jis","前回との時間差は[$time_sa]です\n");
      print encode("shift-jis","古い記事の２４時間前から処理します\n");
     ($year_old,$month_old,$mday_old,$hour_old,$min_old,$sec_old)  = 
     ($time_new2      =~ m/(\d{4})(\d{2})(\d{2})\.(\d{2})(\d{2})(\d{2})/);
# print "($year_old,$month_old,$mday_old,$hour_old,$min_old,$sec_old)";<stdin>;
      $month_old      -=    1;
      $year_old       -= 1900;
      $time_old3      = timelocal($sec_old, $min_old, $hour_old,$mday_old, $month_old,$year_old);
      $time_old3      -= 24 * 60 * 60;
     ($sec_old,$min_old,$hour_old,$mday_old,$month_old,$year_old,$wday_old,$yday_old,$isdst_old) = localtime($time_old3);
      $month_old      +=    1;
      $year_old       += 1900;
      $time_old4       = sprintf("%04d%02d%02d_%02d%02d%02d",$year_old,$month_old,$mday_old,$hour_old,$min_old,$sec_old);
      print encode("shift-jis","[$time_old4]以降を読みます\n");
      $time_old        =  $time_old4;
    }
    else                        {;}
    print encode("shift-jis","[$time_old]以降を読んでます\n");
    # open out_file ---------------------------------------------------------------
    $f_ou_csv         = $time_now . "_perl_net_get_news_01_002_htm2csv_035.htm";
    $f_ou_tbl         = $time_now . "_perl_net_get_news_01_002_htm2table_035.htm";
    open(OU_CSV,"> $f_ou_csv");
    open(OU_TABLE,"> $f_ou_tbl");
# 1 html2csv ---------------------------------------------------------
    # input ---------------------------------------------------------------
#   opendir(DRC,".");@f_htm = grep(/^temp/ and /__[a-z]+\.htm$/,readdir(DRC));closedir(DRC);
    opendir(DRC,".");@f_htm = grep(/__[a-z]+\.htm$/,readdir(DRC));closedir(DRC);
#print "a_f_htm[@f_htm]";<stdin>;
    @out              = @out2 = @out3 = ();
    %mark             = ();
foreach $f_htm (@f_htm) {
   ($name)            = ($f_htm  =~  m#__(.+?)\.htm#);
    print encode("shift-jis","[$name]を処理しています\n");
    open(IN,"< $f_htm");
    @line             = <IN>;close(IN);
my  $line             = join("",@line);
    $line             =~ s/[\t\r\n]+//g;$line   =~ s/> +</></g;
    # 文字コード--------------------------------------------------
my  $enc              = guess_encoding($line, qw/euc-jp shiftjis 7bit-jis/);
    if(ref($enc)){    # guessに成功したら
      $line           = decode($enc->name, $line);
    }
    $line             =~ s#charset="*(.+?)"##;
my  $charset          = $&;                                           # print "<br><br>name[$name]:[$charset]\n";#<stdin>;
    # 区切り単位を  [\n]で区切る------------------
    $line             =~  s#(<h\d>.+?</h\d>)#\n\n$1\n\n#g;
    $line             =~  s#(<h3 class="ttl">.+?</h\d>)#\n\n$1\n\n#g;
    $line             =~  s#(<li>*.+?</li>)#\n$1\n#g;
    $line             =~  s#(<p class="category">.+?</p>)#\n$1\n#g;
    # ------------------------------------------------------------
    @line             = split("\n",$line);
    # 社名,カテゴリ,<a href=".+?">文,時間(20180128_193000)形式,
    foreach $line(@line) {
      if($name        eq "yomiuri") {
        if ($line     =~  m#<li>*.+?</li># and $line =~  m#\d+:\d+#) {
          $line       =~  s#<img.+?>##;
          $line       =~  s#(<a href=".+?").+?">#$1>#;
          $line       =~  s#<span class="rankNum">.+?<span class="ttl">##;
          $line       =~  s#<span class="cap">.+?<span class="ttl">##;
                                   #<a href="http://www.yomiuri.co.jp/economy/20180126-OYT1T50121.html
         ($class)     = ($line =~ m#<a href="http://www.yomiuri.co.jp/(.+?)/#);
         ($a_href)    = ($line =~ m#(<a href=".+?">)#);
          # 50074.html    ?from=ytop_ylist">小規模飲食店は「喫煙可」…客離れ懸念受け修正</span>,20180130_135400 ,<br>
          $a_href     =~ s#\?from=.+?">#">#;
         ($nengappi)  = ($a_href  =~ m#(\d\d\d\d\d\d\d\d)\-#);
         ($bun)       = ($line    =~ m#<a href=".+?">(.+?)</a>#);
         ($ji,$hun)   = ($line    =~ m#<span class="update">（(\d+):(\d+)）</span>#);
          $time       = sprintf("%08d_%02d%02d00",$nengappi,$ji,$hun);          #  print "yomiuri_time:[$time]:";<stdin>;
          $bun        =~ s#<span class="update">（(\d+):(\d+)）</span>##;
          $mark{$a_href}++;
          if($time gt $time_old and $mark{$a_href} == 1) {
            $csv      = "$name,$class,$a_href,$bun,$time ,";
            push(@out,"$csv");
          }
        }
      }
      elsif($name     eq "asahi") {
        if( $line     =~  m#<li>*.+?</li># and $line =~  m#\d\d:\d\d#) {
          $line       =~  s#<a href="/#<a href="http://www.asahi.com/#;
         ($class)     = ($line =~ m#<li class="(.+?)"#                  );
         ($a_href)    = ($line =~ m#(<a href=".+?">)#                   );
         ($bun)       = ($line =~ m#<a href=".+?">(.+?)<#               );
#        ($time)      = ($line =~ m#<span class="Time">\((.+?)\)</span>#);        print "asahi_time[$time]\n";
         ($month,$day,$hours,$minutes)  = ($line =~ m#(\d+)/(\d+) +(\d+):(\d+)#);
          if($month_now == 1 and $month == 12) {$year_befor = $year_now - 1;}
          else                                 {$year_befor = $year_now;    }
          $time       = sprintf("%04d%02d%02d_%02d%02d00",$year_befor,$month,$day,$hours,$minutes);  # print "asahi_time:[$time]:time2[$time2]";<stdin>;
          $mark{$a_href}++;
          if($time gt $time_old and $mark{$a_href} == 1) {
# print "($time gt $time_old and $mark{$a_href} ";<stdin>;
            if(length($bun) > 10) {
              $csv    = "$name,$class,$a_href,$bun,$time ,";
              $csv    =~ s#,+#,#g;
              push(@out,"$csv");
            }
          }
        }
      }
      elsif($name     eq "mainichi") {
        if( $line     =~  m#<li>*.+?</li># and $line =~  m#\d\d:\d\d#) {
          $line       =~ s#<a href="/articles/#<a href="http://mainichi.jp/articles/#i;
          ($class)    = ($line =~ m#/00[a-z]/(\d+)/#);
          ($a_href)   = ($line =~ m#<li.+?(<a href=".+?">)#);
          ($bun)      = ($line =~ m#<span class="keyword">(.+?)<span class="date">#);
          ($time)     = ($line =~ m#<span class="date">(.+?)</span>#);
           $time      =~ s# +#_#;
           $time      =~ s#[年月日:]##g;
           $time     .= "00";
          $mark{$a_href}++;
          if($time gt $time_old and $mark{$a_href} == 1) {
            if(length($bun) > 10) {
              $csv    = "$name,$class,$a_href,$bun,$time ,";
              $csv    =~ s#,+#,#g;
              push(@out,"$csv");
            }
          }
        }
      }
      elsif($name     eq "iza") {
        $line         =~ s#<img.+?">##;
        if( $line     =~  m#<li>*.+?</li># and $line =~  m#\d\d:\d\d#) {
           $line      =~ s#<a href="./kiji/#<a href="http://www.iza.ne.jp/kiji/#i;
          ($class)    = ($line  =~ m#/kiji/([a-z]+)/news/#);
          ($a_href)   = ($line  =~ m#(<a href=".+?">)#                   );
          ($bun)      = ($line  =~ m#<a href=".+?">(.+?)<#               );
          ($time)     = ($line  =~ m#<time class="article-date">(.+?)</time>#);
           $time      =~ s# +#_#;
           $time      =~ s#[\.:]##g;
           $time     .= "00";
          $mark{$a_href}++;
          if($time gt $time_old and $mark{$a_href} == 1) {
            if(length($bun) > 10 and $time ne "") {
              $csv    = "$name,$class,$a_href,$bun,$time ,";
#             $csv    =~ s#,+#,#g;
              push(@out,"$csv");
            }
          }
        }
      }
      elsif($name     eq "chunichi") {
        $line         =~ s#<a href="/s/#<a href="http://www.chunichi.co.jp/s/#i;
        if($line      =~  m#<h2><a href="/article/.+?/">#){
           ($class)   = ($line      =~  m#<h2><a href="/article/(.+?)/">#);
        }
        elsif( $line  =~  m#<li>*.+?</li># and $line =~  m#\d\d:\d\d#) {
          ($gatu,$hi,$ji,$hun)  = ($line =~ m#(\d+)月(\d+)日 +(\d+):(\d+)#);
          if($month_now == 1 and $month == 12) {$year_befor = $year_now - 1;}
          else                                 {$year_befor = $year_now;    }
          $time       = sprintf("%04d%02d%02d_%02d%02d00",$year_befor,$gatu,$hi,$ji,$hun);
         ($a_href)    = ($line =~ m#(<a href=".+?">)#                   );
         ($bun)       = ($line =~ m#<a href=".+?">(.+?)<#               );
          $bun        =~ s#（\d+月\d+日 +\d+:\d+）##;
          $mark{$a_href}++;
          if($time gt $time_old and $mark{$a_href} == 1) {
            if(length($bun) > 10) {
              $csv    = "$name,$class,$a_href,$bun,$time ,";
              $csv    =~ s#,+#,#g;
              push(@out,"$csv");
            }
          }
        }
      }
      elsif  ($name      eq "yahoo") {
        if    ($line  =~ m#<h3 class="ttl">(.+?)</h3>#) {$class = $1;}
        elsif ($line  =~  m#<li>*.+?</li># and $line =~  m#\d+:\d+#) {
          $line       =~  s#<img.+?>##;
          $line       =~  s#(<a href=".+?").+?">#$1>#;
          $line       =~  s#<span class="rankNum">.+?<span class="ttl">##;
          $line       =~  s#<span class="cap">.+?<span class="ttl">##;
         ($a_href)    = ($line =~ m#(<a href=".+?">)#);
         ($bun)       = ($line =~ m#<a href=".+?">(.+?)</a>#);
          $bun        =~ s#<span class="date">(.+?)</span>##;
                                  # <span class="date">1/29(月) 10:06</span>
         ($time)      = ($line =~ m#<span class="date">(.+?)</span>#);
         ($gatu,$hi)  = ($time =~ m#(\d+)/(\d+)#);
         ($ji,$hun)   = ($time =~ m#(\d+):(\d+)#);
          if($month_now == 1 and $month == 12) {$year_befor = $year_now - 1;}
          else                                 {$year_befor = $year_now;    }
          $time       = sprintf("%04d%02d%02d_%02d%02d00",$year_befor,$gatu,$hi,$ji,$hun);
          $csv        = "$name,$class,$a_href,$bun,$time ,";
          $mark{$a_href}++;
          if($time gt $time_old and $mark{$a_href} == 1) {
            push(@out,"$csv");
          }
        }
      }
      elsif  ($name      eq "livedoor") {
        if    ($line  =~ m#<h1 class="mainTtl">(.+?)</h1>#) {$class = $1;}
        elsif ($line  =~  m#<li>*.+?</li># and $line =~  m#\d+:\d+#) {
          $line       =~ s#</h3><p.+?</p>>##g;
          $line       =~  s#<p class="articleListImg"></p><div class="articleListBody">##;
          $line       =~  s#<p class="articleListSummary">.+?</p>##;
          $line       =~  s#<img.+?>##;
          $line       =~  s#(<a href=".+?").+?">#$1>#;
         ($a_href)    = ($line =~ m#(<a href=".+?">)#);
         ($bun)       = ($line =~ m#<a href=".+?">(.+?)</a>#);
          $bun        =~ s#<p class="articleListImg"></p><div class="articleListBody"><h3 class="articleListTtl">##;
          $bun        =~ s#<time datetime=".+?</time></div>##;
          $bun        =~ s#<div class="articleListBody"><h3 class="articleListTtl">##;
                          #</h3><p class="articleListVender">ハリウッドニュース</p>
          $bun        =~ s#</h3><p .+?</p>##g;
          $bun        =~ s#<time datetime=".+?">.+?</time>##;
         ($time)      = ($line =~ m#<time datetime=".+?">(.+?)</time>#);
         ($year,$mon,$day,$hour,$min)      = 
         ($time       =~ m#(\d+)年(\d+)月(\d+)日 +(\d+)時(\d+)分#);
           # 2018年1月30日 10時15分 ,<br>
          $time      = sprintf("%04d%02d%02d_%02d%02d00",$year,$mon,$day,$hour,$min);
          $csv        = "$name,$class,$a_href,$bun,$time,";
          $mark{$a_href}++;
          if($time gt $time_old and $mark{$a_href} == 1) {            # print "liv:$time gt $time_old";<stdin>;
            push(@out,"$csv");
          }
        }
      }
    }
    # -----------------------------------------------------
    close(IN);
}
    print OU_CSV join("<br>\n",@out) ,"<br>\n";
    close(OU_CSV);                                                    #    print "[html2csv]end";<stdin>;
#-----------------------------------------
# 2 csv2table ======================================================================
    # header & index prin ---------------------------------------------------------------
    &cotegry;
    &header_prin;
    &body_index_prin;
    # data prin ---------------------------------------------------------------
my  @contents_u      = ();
    foreach $_(@out) { 
      $contents_u    = $_;                                                      # print encode("shift-jis","1:contents[$contents_u]\n");<stdin>;
      next if($contents_u  =~ m#^,+$#);
      ($name,$cotegry,$ahref,$bun,$time) =  split(",",$contents_u);
      if($cotegry_j{$cotegry{$cotegry}} ne "")  {$cotegry_j      = $cotegry_j{$cotegry{$cotegry}};}
      else                                      {$cotegry_j      = $cotegry;}
      push(@out2,"$cotegry_j,$bun,$name,$cotegry_j,$ahref,$bun,$time");
    }
    @out  = ();
    @out3 = sort @out2;
    @out2 = ();
    # カテゴリで並び替え------------------------------------------
    $i    = 0;
    foreach $out3(@out3) {
      ($dumy,$dumy2,$name,$cotegry_j,$ahref,$bun,$time) = split(",",$out3);
       $day_kiji    = $time;
        if($day_kiji >= $time_old) {
          $i++;
          &body_jisseki($cotegry_j,"$ahref$bun",$name,$time);
        }
    }
    # futer_prn ---------------------------------
    &futer_prn;
    close(OU_TABLE);
    print encode("shift_jis","[$i]記事を表示します。\n");
    system("start $f_ou_tbl");
}
# sub begin -------------------------------------------
sub cotegry {
  %cotegry_j  =  (
    'culture','文化'    ,
    'entame' ,'エンタメ',
    'keizai' ,'IT 経済' ,
    'other'  ,'その他'  ,
    'others' ,'その他'  ,
    'seiji'  ,'政治'    ,
    'shakai' ,'社会'    ,
    'sports' ,'スポーツ',
    'world'  ,'国際'    ,
'アクセスランキング:映像'            ,'アクセスランキング（エンタメ）',
'アクセスランキング:雑誌'            ,'アクセスランキング',
'アクセスランキング:雑誌（スポーツ）','アクセスランキング（スポーツ）',
'アクセスランキング:雑誌（ライフ）'  ,'アクセスランキング（ライフ）',
'アクセスランキング:雑誌（国際）'    ,'アクセスランキング（国際）',
  );
  %cotegry    =  (
    '010'           ,'seiji'  ,
    '020'           ,'keizai' ,
    '030'           ,'world'  ,
    '040'           ,'shakai'  ,
    '050'           ,'sports' ,
    '060'           ,'others' ,
    'business'      ,'keizai' ,
    'IT 経済'       ,'keizai' ,
    'column'        ,'others' ,
    'culture'       ,'culture',
    'economics'     ,'keizai' ,
    'economy'       ,'keizai' ,
    'entertainments','entame' ,
    'events'        ,'shakai' ,
    'international' ,'world'   ,
    'keizai'        ,'keizai' ,
    'life'          ,'shakai' ,
    'national'      ,'shakai' ,
    'others'        ,'others' ,
    'election'      ,'seiji'  ,
    'politics'      ,'seiji'  ,
    'seiji'         ,'seiji'  ,
    'shakai'        ,'shakai' ,
    'shamen'        ,'others' ,
    'shasetsu'      ,'others' ,
    'sports'        ,'sports' ,
    'world'         ,'world'  ,
    '海外'          ,'world'  ,
    '国内'          ,'shakai' ,
'雑誌アクセスランキング'            ,'アクセスランキング:雑誌',
'映像アクセスランキング'            ,'アクセスランキング:映像',
'雑誌アクセスランキング（スポーツ）','アクセスランキング:雑誌（スポーツ）',
'雑誌アクセスランキング（ライフ）'  ,'アクセスランキング:雑誌（ライフ）',
'雑誌アクセスランキング（国際）'    ,'アクセスランキング:雑誌（国際）',
  );
}
# -----------------------------------------
sub body_index_prin {
my  $body_index = << "EOF";

<![body index]-->
<body marginheight=0 topmargin=0>
  <center>
  <h1><span style="color: #ff0000;">ネット情報は、プログラムで処理！</span></h1>
  <h2><span style="color: #0000ff;"> [ $time_old ～ $time_new ]間のニュースです。</span></h2>
  <h3>・複数のニュースサイトをまとめて掲載しています。</h3>
  </center>
<table border=1 cellpadding=4 cellspacing=0>
    <colgroup>
     <col style="width:10%;">
     <col style="width:70%;">
     <col style="width:10%;">
     <col style="width:10%;">
    </colgroup>
  <tr class=chartbg>
    <th nowrap>カテゴリ</th>
    <th nowrap>記事</th>
    <th nowrap>社名</th>
    <th nowrap>タイム</th>
  </tr>
EOF
  print OU_TABLE encode("utf-8",$body_index);                               # print     "body_index END\n";
}
# -----------------------------------------
sub body_jisseki {
($cotegry,$ahref,$name,$time) = @_;
my  $body_jisseki = << "EOF";
  <![data]-->
      <tr align=right>
        <td nowrap align=left>$cotegry</td>
        <td ~~~ style="word-wrap:break-word;" align=left>$ahref</td>
        <td nowrap align=left>$name</td>
        <td nowrap align=left>$time</td>
      </tr>
<![data end]-->
EOF
  print OU_TABLE encode("utf-8",$body_jisseki);
}
# -----------------------------------------
sub time_request {
my ($time_request)  = @_;
my  @time           = localtime($time_request); #作成日付
    @time           = reverse(@time);
    $time[3]       += 1900;
    $time[4]       += 1;
my  $time           = sprintf("%4s%02s%02s_%02s%02s%02s",@time[3..8]) ;
    return $time;
}


sub header_prin {
print OU_TABLE <<EOF0;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="content-language" content="ja" />
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<meta http-equiv="Content-Style-Type" content="text/css" />
<title>ニュースを効率よく掲載!!</title>
</head>

EOF0

}


sub futer_prn {
print OU_TABLE << 'EOF2';
<br>
</body>
</html>

EOF2

}

# html2table_end------------------------------------------
# sub ================================================================
sub news_get {
  # old temp move and delete  ---------------------------------------------
    opendir(DRC,".");@f_temp = grep(/^temp/ && /\.htm$/,readdir(DRC));closedir(DRC);  
#    print "1:f_old[@f_temp]";<stdin>;
    $f_old        = $f_temp[0];
    $drc          = "_kiji_01";   mkdir($drc,"0644");
    open(IN,"< $f_old");      open(OU,"> $drc/$f_old"); while(<IN>) {print OU;} 
    close(IN);                close(OU);                unlink($f_old);
    # delete temp htm ------------------------------------------------
    $f_old        = pop(@f_temp);
    foreach $f_temp(@f_temp) {unlink($f_temp);}
  # check proxy -----------------------------------------------------
my  $set          = `set`;  chomp($set);
    if($set       =~ /http_proxy/i) {
      print encode("shift-jis","[proxy]には対応していません！！！\n");
      print encode("shift-jis","スクリプト内の[proxy サーバ]を記述してください\n");
      # $ua->proxy('http', 'http://10.1.101.15:8080/');
      print encode("shift-jis","２０秒後に終了します！\n");#<stdin>;
      sleep(20);
      exit;
    }
    else                            {print "[not proxy]\n";}
my  $ua           = new LWP::UserAgent;
                    $ua->timeout(100);                                #タイムアウトを設定
                    $ua->agent('Mozilla');                            #ユーザエージェントを設定
    # get news -------------------------------------------------------
    &url;
    foreach my $url (@url) {
        print encode("shift-jis","[$url]サイトを読んでいます\n");#<stdin>;
        if    ($url =~ /asahi/)     {$name = "asahi";}
        elsif ($url =~ /mainichi/)  {$name = "mainichi";}
        elsif ($url =~ /iza/)       {$name = "iza";}
        elsif ($url =~ /chunichi/)  {$name = "chunichi";}
        elsif ($url =~ /yomiuri/)   {$name = "yomiuri";}
        elsif ($url =~ /livedoor/)  {$name = "livedoor";}
        elsif ($url =~ /yahoo/)     {$name = "yahoo";}
        $mark{$name}++;
        # get ------------------------------------------------------------
    my  $t          = time();
#       $url       .= '?' . $t;
    my  $req        = HTTP::Request->new(GET => $url);
        $req->referer('http://referrer.asahi.com');                             # リファラーを設定
    my  $res        = $ua->request($req);
        # requestメソッドではリダイレクトも自動的に処理するため、
        # そうしたくない場合はsimple_requestメソッドを使用するとよい。
        # is_successの他にis_redirect、is_errorなどがある
        # is_redirectを判定する場合、simple_requestメソッドを使用
        if ($res->is_success) {$content = $res->content;}
        else                  {$content = $res->status_line . "\n";}
        # out ------------------------------------------------------------
       ($time)      =  &get_time;
        $time       =~ s#\-+##g;
        $time       =~ s#:+##g;                                                 # print encode("shift-jis","今の時間($time):");
        $f_out      = "temp_" . "$time" . "_01_get_news__" . "$name.htm";       # print "f_out[$f_out]\n";#<stdin>;
        $f_out      =~ s#:#_#g;
        if    ($mark{$name} == 1) {open(OU,">  $f_out");}
        elsif ($mark{$name}  > 1) {open(OU,">> $f_out");}
        print OU $res->content;
        close(OU);
    }
    print "[get_news_END]\n";#<stdin>;
}
sub get_time {
 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  $year          += 1900;
  $mon           += 1;
  $time           = sprintf("%02s-%02s-%02s_%02s:%02s:%02s",$year,$mon,$mday,$hour,$min,$sec);
  return $time;
}
sub url {
@url  = qw (
http://www.asahi.com/news/
http://www.chunichi.co.jp/
http://www.iza.ne.jp/
http://www.yomiuri.co.jp/
http://mainichi.jp/flash/1
http://news.livedoor.com/article/category/52/
http://news.livedoor.com/topics/category/dom/
http://news.livedoor.com/topics/category/eco/
http://news.livedoor.com/topics/category/en
http://news.livedoor.com/topics/category/gourmet/
http://news.livedoor.com/topics/category/love/
http://news.livedoor.com/topics/category/sports/
http://news.livedoor.com/topics/category/trend/
http://news.livedoor.com/topics/category/world/
https://news.yahoo.co.jp
https://news.yahoo.co.jp/hl?c=bus
https://news.yahoo.co.jp/hl?c=c_ent
https://news.yahoo.co.jp/hl?c=c_int
https://news.yahoo.co.jp/hl?c=c_life
https://news.yahoo.co.jp/hl?c=c_sci
https://news.yahoo.co.jp/hl?c=c_spo
https://news.yahoo.co.jp/hl?c=dom
https://news.yahoo.co.jp/hl?c=loc
  );
}
# get_news_end--------------------------------------------
# tk begin -----------------------------------------------
sub message_manual {                                                  # プログラムの使用についてを表示する
  system("start $f_read_prog_s");                                     # 注意事項_プログラム使用
}
sub change_number {                                                   # 行番号の処理
my  ($txt,$number_flag) = @_;
my  $line = $txt->index( 'end' );
my  $i;
    if( $number_flag ){for $i (1 .. $line){$txt->insert( "$i.0", sprintf( "%6d:", $i ), 'LINENUM' );}} 
    else              {for $i (1 .. $line){$txt->delete( "$i.0", "$i.7" );}}
}

# ----------------------------------------------------------------------------------
sub message_about {
my  $sub_win =  $top->Toplevel();                                     # ウィンドウを何回も生成 
    $sub_win->title("Perl/Tk Version Info");
    ShowVersion($sub_win,"Perl version"     , $]);                    # ラベルを定義
    ShowVersion($sub_win,"Perl/Tk version"  , $Tk::VERSION);
    ShowVersion($sub_win,"Tk patchLevel"    , $Tk::patchLevel);
    ShowVersion($sub_win,"perltk make kml"  , "make_kml_launcher3_win32_13_010.pl");
    ShowVersion($sub_win,"Copy right"       , "はやしひろし:geg01137\@nifty.com");
    ShowVersion($sub_win,"fontsize"         , $fontsize);
    ShowVersion($sub_win,"height  "         , $scrolled_height);
    ShowVersion($sub_win,"width   "         , $scrolied_width);
}
sub ShowVersion {
my ($sub_win,$descr, $ver_info) = @_;
    $sub_win->Label(
      -font   => $font1,
      -text   => "$descr\t:\t$ver_info",
      -relief => 'ridge',
      -padx   => 10,
      -anchor => 'w'
    )->pack(-fill => 'x');
}

# ----------------------------------------------------------------------------
1;