+#!/usr/bin/env -S perl -w
+
+ sub usage {print Encode::decode('UTF-8',<<'_END_OF_USAGE_');
+get-nhk-title.pl ---- NHK番組表 取得ツール
+ (https://satomichan.jp/rec-radiko)
+
+NHKオンライン テキスト版 (https://k.nhk.jp/) で提供されている
+番組表から 番組情報(放送長さ・タイトル・プレイリスト等の詳細情報) を
+取得するツールです.
+
+使い方:
+ get-nhk-title.pl [--short | -s] [--escape | -e]
+ [--li <line_numbers>] [--nominutes | -m]
+ <station> <start_date> <start_time>
+
+ <station> には放送局を指定します. 指定できるのは,
+ r2 (第2放送),
+ sapporo-r1, sendai-r1, tokyo-r1, nagoya-r1, osaka-r1,
+ hiroshima-r1, matsuyama-r1, fukuoka-r1 (ここまで第1放送),
+ sapporo-fm, sendai-fm, tokyo-fm, nagoya-fm, osaka-fm,
+ hiroshima-fm, matsuyama-fm, fukuoka-fm (ここまでFM放送) です.
+
+ <start_date> には番組開始の日付(暦日)を指定します.
+ 書式は YYYY-MM-DD です. 例) 2025-09-01 (2025年9月1日の場合)
+
+ <start_time> には番組開始の時刻を指定します.
+ 書式は [h]h:mm または [h]hmm です (24時間制).
+ 深夜24時以降を指定する場合は, 日付を翌日にし,
+ 0:00 以降の時刻を指定します.
+ コロンはあってもなくても構いません. 時の先頭の 0 は省略可能です.
+ 指定の日時にちょうど始まる番組の情報が取得されます.
+ 例) 12:30 (昼の12時半の場合), 905 (午前9時05分の場合),
+ 1515 (午後3時15分の場合), 0305 (深夜3時05分の場合)
+
+ --short または -s を指定しないと Long出力モードになります.
+ 放送長さ・番組タイトル・プレイリスト等の詳細情報が複数行にわたって
+ 出力されます.
+
+ --short または -s を指定すると Short出力モードになります.
+ 放送長さ・番組タイトルが 1つの半角スペースで区切って出力されます.
+
+ Short出力モード のときに --escape または -e も指定されていると,
+ 番組タイトルのうち スペース類を _ に, 半角の記号類を全角に変換し,
+ 両端を ' で挟んで 出力します.
+
+ Short出力モード のときに --li <line_numbers> も指定されていると,
+ 番組タイトルに使われる 番組表内部 HTML の li要素 が <line_numbers>
+ 番目のものに変更されます.
+ デフォルトでは 1 行目となっています(--li 1 と等価).
+ <line_numbers> には 1 以上の自然数を指定します. カンマ(,)で区切って
+ 複数指定することも出来ます. 例) --li 3,4
+
+ Short出力モード のときに --shinyabin を指定すると,
+ 番組が ラジオ深夜便 だった場合に 番組タイトルを 3,4行目などを組み
+ 合わせたものを出力します (1行目のみだと特集内容がわからないため).
+
+
+ --nominutes または -m を指定されていると, 放送長さ を出力しません.
+ (Long出力モード, Short出力モード ともに)
+
+実行例:
+ get-nhk-title.pl -s -e --shinyabin tokyo-r1 2025-09-08 1230
+
+留意事項:
+ 当然ですが, 現行法規で認められた範囲内かつ NHK が認める範囲内で
+ ご使用ください.
+_END_OF_USAGE_
+}
+
+# Copyright 2025 FUKUDA Satomi (https://satomichan.jp/)
+#
+# Licensed under the Apache License, Version 2.0 (the “License”);
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an “AS IS” BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#
+# See the License for the specific language governing permissions and
+# limitations under the License.
+
+use strict;
+use warnings;
+
+use utf8;
+binmode STDOUT, ":utf8";
+binmode STDERR, ":utf8";
+
+use HTTP::Tiny; #sudo apt install libhttp-tiny-perl
+use Encode;
+use HTML::Entities;
+use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat);
+
+
+
+#オプション解析
+my %option = (li => 1);
+GetOptions( \%option, ('short|s', 'li=s', 'nominutes|m', 'escape|e', 'shinyabin') );
+
+my ($station, $date, $time) = @ARGV;
+
+usage(), exit unless ($station && $date && $time);
+
+my ($day) = $date =~ /^\d{4}-\d{2}-(\d{2})$/ or die "Date Format Error ('$date' must be YYYY-MM-DD)";
+my ($h, $m) = $time =~ /^(\d{1,2}):?(\d{2})$/ or die "Time Format Error ('$time' must be HHMM or HH:MM)";
+
+my ($area, $ch) = @{station2area_channel($station)};
+
+
+#午前0時-4時台のときは前日の番組表を参照する
+if ($h < 5) {
+ use Time::Piece;
+ my $t = Time::Piece->strptime($date, '%Y-%m-%d');
+ $t -= Time::Seconds::ONE_DAY;
+ $date = $t->ymd;
+}
+
+#番組情報(長さ・タイトル・詳細)出力
+my $program = get_timetable($area, $ch, $date, $day, $h, $m);
+if ($program) {
+ if ($option{short}) {
+ #Short 表示モード
+ print "$program->{minutes} " unless $option{nominutes};
+
+ my $title = '';
+
+ #ラジオ深夜便対策
+ if ($option{shinyabin} && $program->{list}[0] =~ /^ラジオ深夜便/) {
+ $title = 'ラジオ深夜便';
+ $option{li} = '3,4';
+ }
+
+ #タイトル取得・エスケープ
+ $title .= $program->{list}[$_ -1] for split(/,/, $option{li});
+ $title = "'". escape($title). "'" if $option{escape};
+
+ print "$title";
+
+ }else{
+ #Long 表示モード
+ print $option{nominutes} ? "" : "$program->{minutes}分間\n";
+ print "$_\n" for @{$program->{list}};
+ }
+}
+
+exit;
+
+
+
+#番組表 GET
+sub get_timetable {
+ my ($area, $ch, $tt_ymd, $d, $h, $m) = @_;
+ # └番組表の年月日, └暦日
+
+ my $kanji_time = kanji_time($d, $h, $m);
+ my $url = "https://k.nhk.jp/timetable/read/c.html?a=$area&c=$ch&d=$tt_ymd&f=top";
+
+ my $resp = HTTP::Tiny->new->get($url);
+
+ if ($resp->{success}) {
+ my $body = Encode::decode('UTF-8', $resp->{content});
+
+ my ($minutes, $entry) =
+ $body =~ m|<div><span>${kanji_time}から.+?分(放送時間(\d{1,3})分間)</span><ul>(.+?)</ul></div>|
+ or die "Cannot get program info starting at the specified date-time. TIME: ${kanji_time} URL: $url";
+
+ $entry = HTML::Entities::decode_entities($entry); #HTML文字実体参照(&xxxx;) デコード
+ $entry =~ s/<br>/\n/g;
+
+ my @list = $entry=~ m|<li>(.+?)</li>|sg;
+ return {minutes => $minutes, list => \@list};
+
+ }else{
+ die "Not success GET : $url";
+ }
+}
+
+
+
+#「日・時・分」から 「(0日)?(午前|午後)0時00分」文字列を生成
+sub kanji_time {
+ my ($d, $h, $m) = @_;
+
+ my $day = '';
+ my $ampm;
+
+ if ($h < 5) {
+ $day = sprintf('%i日', $d);
+ $ampm = '午前';
+
+ }elsif ($h <= 11) {
+ $ampm = '午前';
+
+ }else{
+ $ampm = '午後';
+ $h -= 12;
+ }
+
+ return sprintf("%s%s%i時%02i分", $day, $ampm, $h, $m);
+}
+
+
+
+#エリアコード・チャンネルコード
+sub station2area_channel {
+ my ($station) = @_;
+
+ return ['001','06'] if $station eq 'r2';
+
+ my ($base, $channel) = $station =~ /^(.\w+)-(r1|fm)$/ or die "'$station' : Unknown station.";
+
+ my %area_code = (
+ sapporo => '700',
+ sendai => '600',
+ tokyo => '001',
+ nagoya => '300',
+ osaka => '200',
+ hiroshima => '400',
+ matsuyama => '800',
+ fukuoka => '501',
+ );
+
+ die "'$station' : Unknown area." unless $area_code{$base};
+
+
+ my %channel_code = (
+ r1 => '05',
+ fm => '07',
+ );
+
+ die "'$station' : Unknown area." unless $channel_code{$channel};
+
+
+ return [$area_code{$base}, $channel_code{$channel}];
+}
+
+
+
+#ファイル名不適記号類を全角文字化
+sub escape {
+ my($str) = @_;
+
+ #空白 -> _ にする
+ $str =~ s/\s+/_/g;
+ $str =~ s/ +/_/g;
+
+ #半角記号類 -> 全角にする
+ for ($str) {
+ s/"/”/g;
+ s/'/’/g;
+ s/`/`/g;
+ s/,/,/g;
+ s/\././g;
+ s/</</g;
+ s/>/>/g;
+ s/\|/|/g;
+ s/:/:/g;
+ s/;/;/g;
+ s/\?/?/g;
+ s/!/!/g;
+ s/&/&/g;
+ s/%/%/g;
+ s/~/ ̄/g;
+ s/\$/$/g;
+ s/\*/*/g;
+ s/\\/¥/g;
+ s/\////g;
+ s/\././g;
+ s/\+/+/g;
+ s/\(/(/g;
+ s/\)/)/g;
+ s/\[/[/g;
+ s/]/]/g;
+ s/{/{/g;
+ s/}/}/g;
+ }
+
+ return $str;
+}
+