#!/usr/bin/perl use strict; use CGI; use CGI::Carp qw/fatalsToBrowser/; use Time::Local; use Encode qw/from_to/; use lib qw(./ D:/sitedata/Domains/mot-school.jp/ROOT/Inetpub/wwwroot/cgi-bin); use Topics; use Topics::Conf; use utf8; binmode STDOUT, ':utf8'; my $WEB_BASE = '/'; my $query = new CGI; my $cgi = {}; $cgi->{GENRE_ID} = $query->param('GENRE_ID'); $cgi->{GENRE_ID} = undef unless $cgi->{GENRE_ID} =~ /^\d+$/; $cgi->{GENRE_ID} ||= 3; $cgi->{TOPICS_ID} = $query->param('TOPICS_ID'); $cgi->{TOPICS_ID} = 0 unless $cgi->{TOPICS_ID} =~ /^\d+$/; my %GENRE_ATTR = ( 2 => [ 'common', '全　般', '01' ] ,3 => [ 'osaka', '大阪校', '02' ] ,4 => [ 'tokyo', '東京校', '04' ] ,5 => [ 'nagoya', '名古屋校', '03' ] ); my $dbh = &dbh; my $get_topics = $dbh->prepare( <{TOPICS_ID} ) { $get_topics->execute( $tid ); $get_topics->bind_columns( undef, \( $t_id, $t_date, $t_title, $t_sdate, $t_edate, $t_desc, $t_cont, $t_dlink, $t_link) ); my $topics = $get_topics->fetchrow_arrayref(); $t_id = undef unless $t_title; # if ( $t_sdate && ( time < to_epoch( $t_sdate ) ) ) { # $t_id = undef; # } # if ( $t_edate && ( time > to_epoch( $t_edate, [(59,59,23)] ) ) ) { # $t_id = undef; # } $t_date =~ s/ \d\d:\d\d:\d\d(\.\d\d\d)?//; $t_date =~ s/\-/./g; # from_to( $t_title, 'sjis', 'utf-8' ); # from_to( $t_desc, 'sjis', 'utf-8' ); # from_to( $t_cont, 'sjis', 'utf-8' ); $t_cont =~ s/\x0D\x0A|\x0D|\x0A/
/g; $t_cont = make_link( $t_cont ); $d_link = <>> 詳細はこちら

EOF } #$body ||= <{GENRE_ID} != 2 ? < EOF1 お知らせ EOF2 $t_title ||= '最新情報(詳細)'; my $html = < $t_title｜MOT（技術経営）スクールの大阪ガスビジネスクリエイト株式会社
  • HOME
  • MOTスクール
  • イノベーション短期集中コース
  • 企業研修
  • ＭＯＴとは
  • 受講お申し込み
  • お客さまの声
  • 講師のご紹介
  • 最新情報
  • アクセスマップ
  • よくあるご質問
  • 受講生専用ページ
  • 資料ダウンロード
  • お問い合せ
お電話でのお問い合せ 06-6446-4321
EOF2 print $html; $dbh->disconnect; 1; sub to_epoch { my ( $ymd, $hms ) = @_; $hms ||= [ 0, 0, 0 ]; my ( $y, $m, $d ); if ( $ymd =~ /^(\d\d\d\d)[^\d](\d\d)[^\d](\d\d)/ ) { ( $y, $m, $d ) = ( $1, $2, $3 ); } return undef unless $y && $m && $d; $_ = timelocal( @$hms, $d, $m - 1, $y - 1900 ); } sub make_link { my $str = shift; my $http_URL_regex = q{\b(?:https?|shttp)://(?:(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f} . q{][0-9A-Fa-f])*@)?(?:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)} . q{*[a-zA-Z](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.} . q{[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f]} . q{[0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-} . q{Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f} . q{])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)} . q{*)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])} . q{*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} . q{)?}; my $ftp_URL_regex = q{\bftp://(?:(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} . q{(?::(?:[-_.!~*'()a-zA-Z0-9;&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)?@)?(?} . q{:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)*[a-zA-Z](?:[-a-zA-} . q{Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)(?::[0-9]*)?} . q{(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*(?:/(?} . q{:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*(?:;type=[} . q{AIDaid])?)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9} . q{A-Fa-f])*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A} . q{-Fa-f])*)?}; my $mail_regex = q{(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\\} . q{\[\]\000-\037\x80-\xff])|"[^\\\\\x80-\xff\n\015"]*(?:\\\\[^\x80-\xff][} . q{^\\\\\x80-\xff\n\015"]*)*")(?:\.(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x} . q{80-\xff]+(?![^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff])|"[^\\\\\x80-} . q{\xff\n\015"]*(?:\\\\[^\x80-\xff][^\\\\\x80-\xff\n\015"]*)*"))*@(?:[^(} . q{\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\\\[\]\0} . q{00-\037\x80-\xff])|\[(?:[^\\\\\x80-\xff\n\015\[\]]|\\\\[^\x80-\xff])*} . q{\])(?:\.(?:[^(\040)<>@,;:".\\\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,} . q{;:".\\\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\\\x80-\xff\n\015\[\]]|\\\\[} . q{^\x80-\xff])*\]))*}; my $tag_regex_ = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; #'}}}} my $comment_tag_regex = '-]*(?:-[^>-]+)*?)??)*(?:>|$(?!\n)|--.*$)'; my $tag_regex = qq{$comment_tag_regex|<$tag_regex_}; my $text_regex = q{[^<]*}; my $result = ''; my $skip = 0; while ($str =~ /($text_regex)($tag_regex)?/gso) { last if $1 eq '' and $2 eq ''; my $text_tmp = $1; my $tag_tmp = $2; if ($skip) { $result .= $text_tmp . $tag_tmp; $skip = 0 if $tag_tmp =~ /^<\/[aA](?![0-9A-Za-z])/; } else { $text_tmp =~ s{($http_URL_regex|$ftp_URL_regex|($mail_regex))} {my($org, $mail) = ($1, $2); (my $tmp = $org) =~ s/"/"/g; '$org"}ego; $result .= $text_tmp . $tag_tmp; $skip = 1 if $tag_tmp =~ /^<[aA](?![0-9A-Za-z])/; if ($tag_tmp =~ /^<(XMP|PLAINTEXT|SCRIPT)(?![0-9A-Za-z])/i) { $str =~ /(.*?(?:<\/$1(?![0-9A-Za-z])$tag_regex_|$))/gsi; $result .= $1; } } } $result; }