Carp::Always, Devel::KYTProf, Devel::REPL, Carp::REPL

Carp::Always
– エラーやスタックトレースの可視化
– useするだけ
warnまたはdieが出た時に、スタックトレースを引数付きで表示

Devel::KYTProf
– SQLの可視化
– useするだけ

Devel::REPL
– プロンプトで構文や式の動作を確認
– re.plコマンド

Carp::REPL
– プログラムの途中でプロンプトを起動
– dieしたところで使うなら、 perl -MCarp::REPL script.plまたはuseするだけ
– rep関数を使って任意の場所で起動

うーん、これは困った。。ログ出力か。。

Perl debug

#!/usr/bin/perl --

use strict;
use warnings;

my $message = 'Hello';
my @nums = (1, 2, 3);
my %scores = (math => 80, english => 77);

my $twice = twice(5);

$DB::single = 1;

for my $num (@nums){
	if ($num == 2) { $DB::single = 1}
	print "$num\n";
}

sub twice {
	my $num = shift;

	return $num * 2;
}

[vagrant@localhost cgi-bin]$ perl -d app.cgi

Loading DB routines from perl5db.pl version 1.32
Editor support available.

Enter h or `h h’ for help, or `man perldebug’ for more help.

main::(app.cgi:6): my $message = ‘Hello’;
DB<1> q

-dオプションでデバッガの起動ということだが、うむ、イマイチよくわからん。
q でデバック終了。
n でシングルステップ

違う例で見てみる。


#!/usr/bin/perl —

use strict;
use warnings;

my $num = 3;
for(my $i=1;$i<=3;$i++){ print $num*$i."\n"; } [/perl]

[vagrant@localhost cgi-bin]$ perl app.cgi
3
6
9
[vagrant@localhost cgi-bin]$ perl -d app.cgi

Loading DB routines from perl5db.pl version 1.32
Editor support available.

Enter h or `h h’ for help, or `man perldebug’ for more help.

main::(app.cgi:6):      my $num = 3;
  DB<1> n
main::(app.cgi:9):      }
  DB<1> n
main::(app.cgi:7):      for(my $i=1;$i<=3;$i++){
  DB<1> n
main::(app.cgi:8):              print $num*$i.”\n”;
  DB<1> n
3
main::(app.cgi:8):              print $num*$i.”\n”;
  DB<1> n
6
main::(app.cgi:8):              print $num*$i.”\n”;
  DB<1> n
9
Debugged program terminated.  Use q to quit or R to restart,
  use o inhibit_exit to avoid stopping after program termination,
  h q, h R or h o to get additional info.
  DB<1> q

なるほど、1行ずつ見ていくのね。

Perl’s sysopen

Perl’s sysopen is a function equivalent to C’s fopen. Specify a file handle for the first argument, a file name for the second argument, and an open flag for the third argument. If necessary, you can specify the permission in octal in the fourth argument, and the default permission is 0666.

#!/usr/bin/perl --

use strict;
use warnings;

print "Content-type:text/html\n\n";
use Fcntl;

my $file = test;

sysopen(my $fh, $file, O_WRONLY | O_EXCL | O_CREAT)
  or die "Couldn't open $file : $!";
close($fh);

あれ、上手くいかない。。
sysopen関数を使えば、オープンモードを細かく指定できるらしいが。。ぬぬ。

perl undef

Undefined values can be set using the undef function. Alternatively, the value of the variable specified in the argument is undefined.

#!/usr/bin/perl --

use strict;
use warnings;

print "Content-type:text/html\n\n";
my $name = "Kimoto";
$name = undef;

if (defined $name){
	print "defined";
} else {
	print "Undef";
}

なるほどー

Perl DBIでselect

mysql> use test
Reading table information for completion of table and column names
You can turn off this feature to get a quicker startup with -A

Database changed
mysql> show tables;
+----------------+
| Tables_in_test |
+----------------+
| items          |
| name           |
| news           |
| user           |
+----------------+
4 rows in set (0.00 sec)

mysql> select * from items;
+---------+---------+-------+
| item_id | name    | price |
+---------+---------+-------+
|       1 | U+1F363 |  NULL |
+---------+---------+-------+
1 row in set (0.00 sec)

#!/usr/bin/perl --

use CGI;
use DBI;

print "Content-type:text/html\n\n";
print "hello";
my $user = 'root';
my $passwd = '';
my $db = DBI->connect('DBI:mysql:test:localhost', $user, $passwd);
my $sth = $db->prepare("select * from items;");
$sth->execute();
while (my $ary_ref = $sth->fetchrow_arrayref){
	my($a, $b) = @$ary_ref;
	print "$a, $b\n";
}
$sth->finish;
$dbh->disconnect;

OKなんだけど、これ、tableで表示するとき、whileが2つになるけど、どうするんだっけ?

print "<table>";
while (my $ary_ref = $sth->fetchrow_arrayref){
	my($a, $b) = @$ary_ref;
	print "<tr><td>$a</td><td>$b</td></tr>\n";
}
print "</table>";

tableはtableで良いんだが。。

Perl mysqlで文字化けするとき

Perlで入れて、文字化けしてる!?

my $user = 'root';
my $passwd = '';
my $db = DBI->connect('DBI:mysql:click:localhost', $user, $passwd);
my $sth = $db->prepare("INSERT INTO _mng(user_id, password, last_name, first_name, dept) VALUES (?, ?, ?, ?, ?)");
$sth->execute($user_id, $password, $last_name, $first_name, $dept);
+---------+----------+----------------+--------------+---------------------+----------------------+------------------------+----------------+----------------------+-----------------------+---------------------------+---------------+-------------+---------------+-------------+
| aaa     | hoge     | �田         | 太郎       | 管�部           | NULL                 | NULL                   |           NULL | NULL                 | NULL                  | NULL                      | NULL          | NULL        | NULL          | NULL        |
| eda     | hoge     | 江藤         | �          | 管�部           | NULL                 | NULL                   |           NULL | NULL                 | NULL                  | NULL                      | NULL          | NULL        | NULL          | NULL        |
| hoge    | hoge     | 山田         | 太郎       | 管�部           | NULL                 | NULL                   |           NULL | NULL                 | NULL                  | NULL                      | NULL          | NULL        | NULL          | NULL        |
| ykk     | hoge     | 高橋         | �          | 管�部           | NULL                 | NULL                   |           NULL | NULL                 | NULL                  | NULL                      | NULL          | NULL        | NULL          | NULL        |
+---------+----------+----------------+--------------+---------------------+----------------------+------------------------+----------------+----------------------+-----------------------+---------------------------+---------------+-------------+---------------+-------------+
4 rows in set (0.00 sec)

set name utf8がない模様


my $user = ‘root’;
my $passwd = ”;
my $db = DBI->connect(‘DBI:mysql:click:localhost’, $user, $passwd);
my $sth = $db->prepare(“INSERT INTO mng(user_id, password, last_name, first_name, dept) VALUES (?, ?, ?, ?, ?)”);
$db->do(“set names utf8”);
$sth->execute($user_id, $password, $last_name, $first_name, $dept);


+———+———-+—————-+————–+———————+———————-+————————+—————-+———————-+———————–+—————————+—————+————-+—————+————-+
| aaa | hoge | �田 | 太郎 | 管�部 | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL |
| eda | hoge | 江藤 | � | 管�部 | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL |
| hoge | hoge | 山田 | 太郎 | 管�部 | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL |
| sakura | sakura | さくら | たかし | 管理部 | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL |
| ykk | hoge | 高橋 | � | 管�部 | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL | NULL |
+———+———-+—————-+————–+———————+———————-+————————+—————-+———————-+———————–+—————————+—————+————-+—————+————-+
5 rows in set (0.00 sec)

日本語で入りましたねー

Perl Scalars

Perl has three basic data types: scalars, scalar arrays, and scalar associative arrays. In this context, scalar data refers to simple data such as numbers and strings. Also, as an essential element of programming, there is the concept of variables. Variables are “value containers” that are used to temporarily store various values.
In Perl, there are three variables, scalar variable, array, and associative array respectively, in the form corresponding to each data type, and the scalar variable is the most basic one among them, and stores numerical value and character string can do.
Scalar variable names can start with $ (dollar) + one alphabetic character, and can use numbers, alphabetic characters and underscores thereafter. Also, because it is cause sensitive, $ a and $ A, for example, are treated as different things.

OK
$abc123
$abc_123

NG
$123abc
$abc-123

Perlで日付を表示

Time::Pieceを使う方法

#!/usr/bin/perl --
use Time::Piece;

my $t = localtime;
print $t->ymd;

上手くいかない。。

unixのdateコマンドを使用

#!/usr/bin/perl --

print qx(date "+%Y/%m/%d %H:%M:%S");

ちゃんと表示はされます。

2019/04/02 09:00:25

#!/usr/bin/perl --

my ($sec, $min, $hour, $mday, $mon, $year) = (localtime(time))[0..5];
print "Content-type:text/html\n\n";
printf("%d/%02d/%02d %02d:%02d:%02d\n", $year + 1900, $mon + 1, $mday, $hour, $min, $sec);

こちらも行けますねー

DBIで、mysqlにinsert

mysql> create table name(
-> name varchar(255),
-> password varchar(255)
-> );
Query OK, 0 rows affected (0.07 sec)

#!/usr/bin/perl --
use strict;
use utf8;
use warnings;
use CGI;
use DBI;

my $q = new CGI;
my $param1 = $q->param('name');
my $param2 = $q->param('password');

print "Content-type:text/html\n\n";
print "<html>\n";
print "<head></head>\n";
print "<form action=\"/cgi-bin/test2.cgi\">";
print "<label for=\"name\">お名前:</label>";
print "$param1<br>";
print "<label for=\"password\">パスワード:</label>";
print "$param2<br>";
print "<input type=\"submit\" value=\"送信\">";
print "</form>";
print "</html>";

my $user = 'root';
my $passwd = '';
my $db = DBI->connect('DBI:mysql:test:localhost', $user, $passwd);
my $sth = $db->prepare("INSERT INTO name(name, password) VALUES (?, ?)");
# $db->do("set names utf8");
$sth->execute($param1, $param2);

$sth->finish;
$db->disconnect;

print("finish\n");

mysql> select * from name;
Empty set (0.00 sec)

mysql> select * from name;
+——+———-+
| name | password |
+——+———-+
| hoge | hogehoge |
+——+———-+
1 row in set (0.00 sec)

perlでhiddenで送付する

/var/www/html/test.html

<!DOCTYPE html>
<meta charset="utf-8">
<style>
#errorMessage {
	color: red;
}
</style>
<form action="/cgi-bin/test.cgi">
<div id="errorMessage"></div>

<label for="name">お名前:</label>
<input name="name" id="name" required><br>
<label for="password">パスワード:</label>
<input type="password" name="password" id="password" required><br>
<label for="passwordConfirm">パスワード(確認):</label>
<input type="password" name="confirm" id="confirm" oninput="CheckPassword(this)"><br>
<input type="submit" value="送信">
</form>
<script>
		function CheckPassword(confirm){
			var input1 = password.value;
			var input2 = confirm.value;

			if (input1 != input2){
				confirm.setCustomValidity("入力値が一致しません");
			} else{
				confirm.setCustomValidity('');
			}
		}
</script>

/var/www/cgi-bin/test.cgi

#!/usr/bin/perl --
use strict;
use utf8;
use warnings;
use CGI;

my $q = new CGI;
my $param1 = $q->param('name');
my $param2 = $q->param('password');

print "Content-type:text/html\n\n";
print "<html>\n";
print "<head></head>\n";
print "<form action=\"/cgi-bin/test2.cgi\">";
print "<input type=\"hidden\" value=\"$param1\" name=\"name\"></input>";
print "<input type=\"hidden\" value=\"$param2\" name=\"password\"></input>";
print "<label for=\"name\">お名前:</label>";
print "$param1<br>";
print "<label for=\"password\">パスワード:</label>";
print "$param2<br>";
print "<input type=\"submit\" value=\"送信\">";
print "</form>";
print "</html>";

/var/www/cgi-bin/test2.cgi

#!/usr/bin/perl --
use strict;
use utf8;
use warnings;
use CGI;

my $q = new CGI;
my $param1 = $q->param('name');
my $param2 = $q->param('password');

print "Content-type:text/html\n\n";
print "<html>\n";
print "<head></head>\n";
print "<form action=\"/cgi-bin/test2.cgi\">";
print "<label for=\"name\">お名前:</label>";
print "$param1<br>";
print "<label for=\"password\">パスワード:</label>";
print "$param2<br>";
print "<input type=\"submit\" value=\"送信\">";
print "</form>";
print "</html>";

hiddenで送ります。