#! /usr/local/bin/perl
use lib "./perllib";
use HTTP::Lite;
use Jcode;

$area = "319";
$url = "http://www.jma.go.jp/";
$week_url = $url."jp/week/".$area.".html";
$today_url = $url."jp/yoho/".$area.".html";
$LF="\n";	$CR="\r";
$day_plus=0;
&date;	$dtstamp=$year.$mon.$day."T".$hour.$min.$sec;
&week;
&today;
&print_ics;


sub print_ics{
	my $print_ics = <<END_OF_HEADER;
Content-type: text/calendar

BEGIN:VCALENDAR
VERSION:2.0
X-WR-CALNAME:週間天気予報
PRODID:-//Apple Computer\, Inc//iCal 2.0//EN
X-WR-RELCALID:6D77488D-1037-4047-A2F5-93D86F8C7ED5
X-WR-TIMEZONE:Asia/Tokyo
CALSCALE:GREGORIAN
METHOD:PUBLISH
END_OF_HEADER

	my $pre=$today_pre;
	if($weather[1][0]=~/^([0-9]+)/i){
		if(sprintf("%.2d",$1) ne $day){	$day_plus++;	&date($day_plus);	}
	}
	my $dtstart="T000000";
	for($i=1;$i<$#weather;$i++){
		my $sinyo="";	
		if($weather[$i][5]  ne "／"){	$sinyo="信頼度：".$weather[$i][5];	}
		$print_ics .= <<END_OF_LIST;
BEGIN:VEVENT
DTSTART;TZID=Asia/Tokyo:$year$mon$day$dtstart
SUMMARY:$weather[$i][1]
URL;VALUE=URI:$week_url
CONTACT: [気象庁]$url
DTSTAMP:$dtstamp
DESCRIPTION:降水確率：$weather[$i][2]％$CR
 気　温：$weather[$i][3]℃/$weather[$i][4]℃$CR
 $sinyo$CR
 $pre$CR
 $weather[$i][0]$CR
 [気象庁]$url
DURATION:PT1M
END:VEVENT
END_OF_LIST
		$pre=$week_pre;
		$day_plus++;	&date($day_plus);
	}

	$print_ics .=  "END:VCALENDAR".$LF;
	$body=Jcode->new($print_ics);
	Jcode::convert(\$body, 'utf8','euc');
	print $body;
}


sub week{
	$http = new HTTP::Lite;
	$req = $http->request($week_url)or die "Unable to get document: $!";
	die "Request failed ($req): ".$http->status_message()if $req ne "200";
	$j = $http->body();	$body=Jcode->new($j);
	
	#table抽出
	$flg = "0";	$pre="";
	$table_start= '<table id="infotablefont" class="forecast-top">';	$table_end='</table>';
	$pre_start= '<pre class="textframe">';	$pre_end='</pre>';
	foreach $line(split(/[\n\r]+/, $body)){
		if($line =~/$table_start/i){
			$flg = "table_on";
		}elsif($flg eq "table_on"){
			if($line=~/$table_end/i){	$flg = "table_off";	}else{	$table .= $line;	}
		}elsif($line =~/$pre_start/i){
			$flg = "pre_on";
		}elsif($flg eq "pre_on"){
			if($line=~/$pre_end/i){	last;	}else{	$pre .= $line;	}
		}
	}

	&deletetag($pre);#タグの除去
	$pre =~s/　+/$CR/gi;
	$week_pre =$pre;
	#table分解
	$i=0; 
	foreach $line(split(m#<tr(.*?)>#gi, $table)){
		if($line eq ""){ next;}
		$j=-1;
		foreach $tmp(split(m#</t[d|h]>#gi, $line)){
			if($i==3&&$j ==-1){ $j++;	next;}
			if($j ==-1){ $j++;	}
			&deletetag($tmp);#タグの除去
			if($i ==3 || $i ==4){	$tmp=~s/\((.*?)\)//;	}
			$weather[$j][$i]=$tmp;
			$j++;
		}
		$i++;
	}
}



sub today{
	$http = new HTTP::Lite;
	$req = $http->request($today_url)or die "Unable to get document: $!";
	die "Request failed ($req): ".$http->status_message()if $req ne "200";
	$j = $http->body();	$body=Jcode->new($j);
	
	#table抽出
	$flg = "0";	$pre="";
	$pre_start= '<pre class="textframe">';	$pre_end='</pre>';
	foreach $line(split(/[\n\r]+/, $body)){
		if($line =~/$pre_start/i){
			$flg = "pre_on";
		}elsif($flg eq "pre_on"){
			if($line=~/$pre_end/i){
				last;
			}else{
				if($line eq '天気概況'){	next;	}elsif($line =~/^平成/){	$pre_time = $line;		next;	}
				$pre .= $line;
			}
		}
	}
	&deletetag($pre);#タグの除去
	$today_pre =$pre.$CR.$CR.$pre_time;
	$today_pre  =~s/　+/$CR/gi;
}


sub deletetag{
	my $tag_regex_ = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; #'}}}}
	my $comment_tag_regex =
	    '<!(?:--[^-]*-(?:[^-]+-)*?-(?:[^>-]*(?:-[^>-]+)*?)??)*(?:>|$(?!\n)|--.*$)';
	$tag_regex = qq{$comment_tag_regex|<$tag_regex_};
	
	foreach(@_){	~s/$tag_regex//gi	}#タグの除去
}

sub date{
	#日付処理
	my $onedaysec=60 * 60 * 24;
	($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime(time+$day_plus*$onedaysec);
	$year = $year+1900;	$mon++;
	$mon=sprintf("%.2d",$mon);		$day=sprintf("%.2d",$day);
	$hour=sprintf("%.2d",$hour);	$min=sprintf("%.2d",$min);
	$sec=sprintf("%.2d",$sec);
}