今日は、Webインターフェースを介してシステムへのアクセスを整理する方法を説明します。
技術
ご存知のように、「スマートホーム」を管理するためのperlソフトウェアを作成します。 最新の情報システムは、データベースなしではほとんど考えられません。 私たちも傍観するつもりはなく、 MySQL DBMSを使用してデータを保存します。 Webサーバーを実装するために、サードパーティのソフトウェアではなく、perl- HTTP :: Server :: Simpleのモジュール、特に-HTTP :: Server :: Simple :: CGIを使用することにしました 。 なぜこれをしたのですか？ ほとんどの場合、興味のために;）しかし、理論的には、Apache / mod_perl複合体を積み上げることなく、HTTPリクエスト/レスポンスの低レベル処理にアクセスできます。 一般的に、望みと十分な時間があれば、プロジェクトをApacheに移動することを妨げるものは何もありません。
データベース
まず、MySQL DBMSをインストールし、db.sqlのテーブルを使用してデータベースを作成します。 リストは次のとおりです。
CREATE DATABASE ion; USE ion; # # Table structure for table 'calendar' # DROP TABLE IF EXISTS calendar; CREATE TABLE `calendar` ( `id` int(15) NOT NULL AUTO_INCREMENT, `date` datetime NOT NULL, `message` text, `nexttimeplay` datetime NOT NULL, `expired` datetime NOT NULL, `type` int(1) DEFAULT NULL, PRIMARY KEY (`id`) ) ENGINE=MyISAM DEFAULT CHARSET=latin1; # # Table structure for table 'commandslog' # DROP TABLE IF EXISTS commandslog; CREATE TABLE `commandslog` ( `id` int(15) NOT NULL AUTO_INCREMENT, `date` datetime NOT NULL, `cmd` varchar(255) NOT NULL, PRIMARY KEY (`id`) ) ENGINE=MyISAM AUTO_INCREMENT=1 DEFAULT CHARSET=latin1; # # Table structure for table 'log' # DROP TABLE IF EXISTS log; CREATE TABLE `log` ( `id` int(15) NOT NULL AUTO_INCREMENT, `date` datetime NOT NULL, `message` varchar(255) NOT NULL, `level` int(1) DEFAULT NULL, PRIMARY KEY (`id`) ) ENGINE=MyISAM AUTO_INCREMENT=1 DEFAULT CHARSET=latin1;
必要なアクションを実行します。
nix@nix-boss:~$ sudo apt-get install mysql-server
nix@nix-boss:~$ mysql -uroot -ppassword < db.sql
コードを修正する
次に、 lib 、 htmlおよびconfigフォルダー（ データフォルダーの横）を作成する必要があります。 libフォルダーに、Webサーバーの実装とHTTPリクエストの処理を担当するモジュールを配置します。
srv.plスクリプトを少し調整する必要があります 。 初期化ブロックに追加します。
our %cfg = readCfg("common.cfg"); our $dbh = dbConnect($cfg{'dbName'}, $cfg{'dbUser'}, $cfg{'dbPass'});
初期化ブロックの下に、HTTPサーバーの起動を担当する行を追加します。
## HTTP- ################################ my $pid = lib::HTTP->new($cfg{'httpPort'})->background(); print "HTTP PID: $pid\n"; logSystem(" HTTP - PID: $pid, : $cfg{'httpPort'}, : $cfg{'httpHost'}", 0); ################################
ここで、不足している関数をファイルの最後に追加します。
sub readCfg { my $file = shift; my %cfg; open(CFG, "<config/$file") || die $!; my @cfg = <CFG>; foreach my $line (@cfg) { next if $line =~ /^\#/; if ($line =~ /(.*?) \= \"(.*?)\"\;/) { chomp $2; $cfg{$1} = $2; } } close(CFG); return %cfg; } ######################################## sub dbConnect { my ($db, $user, $pass) = @_; return $dbh = DBI->connect("DBI:mysql:$db", $user, $pass) || die "Could not connect to database: $DBI::errstr"; } ######################################## sub logSystem { my ($text, $level) = @_; my %cfg = readCfg("common.cfg"); dbConnect($cfg{'dbName'}, $cfg{'dbUser'}, $cfg{'dbPass'}); $dbh->do("INSERT INTO log (date, message, level) VALUES (NOW(), '$text', $level)"); }
関数の名前からわかるように、dbConnect（）はDBMSへの接続を担当し、logSystem（）はログを記録し、readCfg（）は構成をロードします。 さらに詳しく見ていきましょう。 設定は、configディレクトリにある単純なテキストファイルです。 この例では、 common.cfgと呼ばれます 。 次のようになります。
## daemonMode = "undef"; logSystem = "1"; logUser = "1"; dbName = "ion"; dbUser = "root"; dbPass = "password"; camNumber = "4"; camMotionDetect = "1"; httpPort = "16100"; httpHost = "localhost"; telnetPort = "16000"; telnetHost = "localhost"; micThreads = "5";
その中のいくつかの行は後で使用されます。 これまでのところ、 dbプレフィックスで始まる行にのみ関心があります。 ご覧のとおり、これらはデータベースに接続するための設定です。
次に、複数のコマンドの実行を克服する方法について説明します。 関数checkcmd（）を編集します。
sub checkcmd { my $text = shift; chomp $text; $text =~ s/ $//g; print "+OK - Got command \"$text\" (Length: ".length($text).")\n"; if($text =~ //) { ################################################# my $sth = $dbh->prepare('SELECT cmd FROM commandslog WHERE DATE_SUB(NOW(),INTERVAL 4 SECOND) <= date LIMIT 0, 1'); $sth->execute(); my $result = $sth->fetchrow_hashref(); if($result->{cmd} ne "") { return; } $dbh->do("INSERT INTO commandslog (date, cmd) VALUES (NOW(), '$text')"); ################################################# if($text =~ //) { my $up = `uptime`; $up =~ /up (.*?),/; sayText(" - $1. - $parent."); } if($text =~ //) { my $up = `uptime`; $up =~ /(.*?) up/; sayText(" $1"); } if($text =~ // || $text =~ //) { sayText(" . !"); system("killall motion"); system("rm ./data/*.flac && rm ./data/*.wav"); system("killall perl"); exit(0); } if($text =~ //) { my ($addit, $mod); my %wh = lib::HTTP::checkWeather(); $wh{'condition'} = Encode::decode_utf8( $wh{'condition'}, $Encode::FB_DEFAULT ); $wh{'hum'} = Encode::decode_utf8( $wh{'hum'}, $Encode::FB_DEFAULT ); $wh{'wind'} = Encode::decode_utf8( $wh{'wind'}, $Encode::FB_DEFAULT ); if($wh{'temp'} < 0) { $mod = " "; } if($wh{'temp'} > 0) { $mod = " "; } $wh{'wind'} =~ s/: ,//; $wh{'wind'} =~ s/: ,//; $wh{'wind'} =~ s/: ,//; $wh{'wind'} =~ s/: ,//; $wh{'wind'} =~ s/: ,/-/; $wh{'wind'} =~ s/: ,/-/; $wh{'wind'} =~ s/: ,/-/; $wh{'wind'} =~ s/: ,/-/; sayText(" $wh{'condition'}, $wh{'temp'} $mod. $wh{'hum'}. $wh{'wind'}"); if ($wh{'temp'} <= 18) { $addit = sayText(" , !"); } if ($wh{'temp'} >= 28) { $addit = sayText(" !"); } } } #sayText(" - $text"); return; }
4秒間隔で実行された最後のコマンドを選択し、現在のコマンドと一致する場合は、関数を終了します。 ご覧のとおり、前回の記事で説明した機能と比較して、いくつかのコマンドを追加しました。 最も興味深いのは天気です。 彼女のデータ取得の実装はわずかに低くなります。
HTTP.pmモジュール
組み込みHTTPサーバーの実装に戻ります。 libディレクトリにHTTP.pmファイルを作成します。 そこで次のコードを記述します。
package lib::HTTP; use HTTP::Server::Simple::CGI; use LWP::UserAgent; use URI::Escape; use base qw(HTTP::Server::Simple::CGI); use Template; ######################################### ######################################### our %dispatch = ( '/' => \&goIndex, '/index' => \&goIndex, '/camers' => \&goCamers, ); our $tt = Template->new(); ######################################### ######################################### sub handle_request { my $self = shift; my $cgi = shift; my $path = $cgi->path_info(); my $handler = $dispatch{$path}; if ($path =~ qr{^/(.*\.(?:png|gif|jpg|css|xml|swf))}) { my $url = $1; print "HTTP/1.0 200 OK\n"; print "Content-Type: text/css\r\n\n" if $url =~ /css/; print "Content-Type: image/jpeg\r\n\n" if $url =~ /jpg/; print "Content-Type: image/png\r\n\n" if $url =~ /png/; print "Content-Type: image/gif\r\n\n" if $url =~ /gif/; print "Content-Type: text/xml\r\n\n" if $url =~ /xml/; print "Content-Type: application/x-shockwave-flash\r\n\n" if $url =~ /swf/; open(DTA, "<$url") || die "ERROR: $! - $url"; binmode DTA if $url =~ /jpg|gif|png|swf/; my @dtast = <DTA>; foreach my $line (@dtast) { print $line; } close(DTA); return; } if (ref($handler) eq "CODE") { print "HTTP/1.0 200 OK\r\n"; $handler->($cgi); } else { print "HTTP/1.0 404 Not found\r\n"; print $cgi->header, $cgi->start_html('Not found'), $cgi->h1('Not found'), $cgi->h2($cgi->path_info()); $cgi->end_html; } } ## / ######################################## sub goIndex { my $cgi = shift; # CGI.pm object return if !ref $cgi; my %w = checkWeather(); my $cmd; my $dbh = iON::dbConnect($iON::cfg{'dbName'}, $iON::cfg{'dbUser'}, $iON::cfg{'dbPass'}); my $sth = $dbh->prepare('SELECT cmd FROM commandslog WHERE id > 0 ORDER BY id DESC LIMIT 0, 1'); $sth->execute(); my $result = $sth->fetchrow_hashref(); if($result->{cmd} ne "") { $cmd = $result->{cmd}; } else { $cmd = " ..."; } print "Content-Type: text/html; charset=UTF-8\n\n"; my $uptime = `uptime`; $uptime =~ /up (.*?),/; $uptime = $1; my $videosys = `ps aux | grep motion`; if ($videosys =~ /motion -c/) { $videosys = "<font color=green></font>"; } else { $videosys = "<font color=red> </font>"; } my $micsys = `ps aux | grep mic`; if ($micsys =~ /perl mic\.pl/) { $micsys = "<font color=green></font>"; } else { $micsys = "<font color=red> </font>"; } my $vars = { whIcon => $w{'icon'}, whCond => $w{'condition'}, whTemp => $w{'temp'}, whHum => $w{'hum'}, whWind => $w{'wind'}, cmd => $cmd, uptime => $uptime, video => $videosys, mic => $micsys, threads => $iON::cfg{'micThreads'}, }; my $output; $tt->process('html/index', $vars, $output) || print $tt->error(), "\n"; } ## /camers ######################################## sub goCamers { my $cgi = shift; # CGI.pm object return if !ref $cgi; my %w = checkWeather(); my $cmd; my $dbh = iON::dbConnect($iON::cfg{'dbName'}, $iON::cfg{'dbUser'}, $iON::cfg{'dbPass'}); my $sth = $dbh->prepare('SELECT cmd FROM commandslog WHERE id > 0 ORDER BY id DESC LIMIT 0, 1'); $sth->execute(); my $result = $sth->fetchrow_hashref(); if($result->{cmd} ne "") { $cmd = $result->{cmd}; } else { $cmd = " ..."; } if($cgi->param("text") ne "") { my $txt = $cgi->param('text'); require Encode; $txt = Encode::decode_utf8( $txt, $Encode::FB_DEFAULT ); iON::sayText($txt); } print "Content-Type: text/html; charset=UTF-8\n\n"; my $vars = { camera1 => 'video-0/camera.jpg', camera2 => 'video-1/camera.jpg', camera3 => 'video-2/camera.jpg', camera4 => 'video-3/camera.jpg', whIcon => $w{'icon'}, whCond => $w{'condition'}, whTemp => $w{'temp'}, whHum => $w{'hum'}, whWind => $w{'wind'}, cmd => $cmd, }; my $output; $tt->process('html/camers', $vars, $output) || print $tt->error(), "\n"; } ## ######################################## sub checkWeather { my %wh; my $ua = LWP::UserAgent->new( agent => "Mozilla/5.0 (Windows NT 5.1; ru-RU) AppleWebKit/535.2 (KHTML, like Gecko) Chrome/15.0.872.0 Safari/535.2"); my $content = $ua->get("http://www.google.com/ig/api?hl=ru&weather=".uri_escape("-")); $content->content =~ /<current_conditions>(.*?)<\/current_conditions>/g; my $cond = $1; $cond =~ /<condition data="(.*?)"/g; $wh{'condition'} = $1; $cond =~ /temp_c data="(.*?)"/g; $wh{'temp'} = $1; $cond =~ /humidity data="(.*?)"/g; $wh{'hum'} = $1; $cond =~ /icon data="(.*?)"/g; $wh{'icon'} = $1; $cond =~ /wind_condition data="(.*?)"/g; $wh{'wind'} = $1; return %wh; } ######################################### ######################################### 1;
内容をさらに詳しく分析しましょう。 ％ディスパッチハッシュでは、URLと呼び出される関数を照合します。 このハッシュに記載されていない他のすべてのURLは、 404ページを返します。
強力で柔軟なTemplate Toolkitライブラリーがテンプレートエンジンになります。 次の行で初期化します。
our $tt = Template->new();
親クラスのhandle_request（）関数をオーバーロードすると、HTTPサーバーへのリクエストの処理を制御できます。 ブラウザに静的コンテンツ（png、gif、jpg、css、xml、swf）を提供するには、ブロックを使用します。
if ($path =~ qr{^/(.*\.(?:png|gif|jpg|css|xml|swf))}) { my $url = $1; print "HTTP/1.0 200 OK\n"; print "Content-Type: text/css\r\n\n" if $url =~ /css/; print "Content-Type: image/jpeg\r\n\n" if $url =~ /jpg/; print "Content-Type: image/png\r\n\n" if $url =~ /png/; print "Content-Type: image/gif\r\n\n" if $url =~ /gif/; print "Content-Type: text/xml\r\n\n" if $url =~ /xml/; print "Content-Type: application/x-shockwave-flash\r\n\n" if $url =~ /swf/; open(DTA, "<$url") || die "ERROR: $! - $url"; binmode DTA if $url =~ /jpg|gif|png|swf/; my @dtast = <DTA>; foreach my $line (@dtast) { print $line; } close(DTA); return; }
いくつかのMIMEタイプを取得したので、少しヒンズー教を書きました;）
次に、特定のURLのコンテンツを生成する機能があります。 これまでのところ、インデックスとカメラ付きのページの2つしかありません。
インデックスでは、ビデオやオーディオのキャプチャなどのサブシステムが機能するかどうかを確認できます。 別の行は次のとおりです。
my %w = checkWeather();
この関数は、都市の現在の天気データを含むハッシュを返します。これはページに表示されます。 そのような小さな素敵なパン;）
近くで、「スマートホーム」に対して最後に受信および認識されたコマンドを出力します。
次の関数goCamers（）は、インデックスと同じ機能を実行しますが、サブシステムのステータスに関する情報を表示する代わりに、カメラからの画像を表示し、「スマートホーム」によって合成および音声化されるテキストを書くことができます。
すべてのページは、 htmlフォルダー内のテンプレートに基づいています。 ここにリストをアップロードするのは不便なので 、アーカイブへのリンク-html.zipを提供します。
合計
すべての変更後、ポート16100で適切に機能するWebインターフェースを取得します。これにより、「スマートホーム」サブシステムのステータス、Webカメラからのデータ、入力したテキストの音声表示が可能になります。 将来的には、さらに重要な機能を追加します。
次の記事では、 X10デバイスを操作し、それらをスマートホームシステムに統合する方法について説明します。
upd ： 続き