質問編集履歴

2

Perlのコードを修正しました。

2022/03/07 23:32

投稿

snow2021
snow2021

スコア12

test CHANGED
File without changes
test CHANGED
@@ -53,8 +53,8 @@
53
53
  use strict;
54
54
  use DBI;
55
55
 
56
- require 'init.pl';
56
+ require 'data.pl';
57
- require 'db_setuzoku.pl';
57
+ require 'db.pl';
58
58
  my %out = &out_set;
59
59
  my %in = &parse_deco;
60
60
 

1

要請により、質問の内容を加筆、修正しました。

2022/03/07 23:09

投稿

snow2021
snow2021

スコア12

test CHANGED
File without changes
test CHANGED
@@ -29,3 +29,128 @@
29
29
  plファイルの中身は、設定ファイルになっており、web siteの名前とか、site管理者の名前などがハッシュに格納されています。
30
30
  大体が、「ブログ」という感じで表示されています。
31
31
 
32
+ +------+------------+----+----+-------+----------------+
33
+ |Field -|Type -------|Null| Key|Default| Extra |
34
+ +------+------------+----+----+-------+----------------+
35
+ |id |int(6): | NO | PRI| NULL | auto_increment|
36
+ +------+------------+----+----+-------+----------------+
37
+ |t_bi |datetime | NO | | NULL | |
38
+ +------+------------+----+----+-------+----------------+
39
+ |ca_no |int(2) | NO | | NULL | |
40
+ +------+------------+----+----+-------+----------------+
41
+ |title |varchar(400)| NO | | NULL | |
42
+ +------+------------+----+----+-------+----------------+
43
+ |kizi |text | NO | | NULL | |
44
+ +------+------------+----+----+-------+----------------+
45
+ |k_bi |datetime |YES | | NULL | |
46
+ +------+------------+----+----+-------+----------------+
47
+ |iine |int(10) | NO | | 0 | |
48
+ +------+------------+----+----+-------+----------------+
49
+ |user |varchar(100)| NO | | NULL | |
50
+ +------+------------+----+----+-------+----------------+
51
+
52
+ ```perl
53
+ use strict;
54
+ use DBI;
55
+
56
+ require 'init.pl';
57
+ require 'db_setuzoku.pl';
58
+ my %out = &out_set;
59
+ my %in = &parse_deco;
60
+
61
+ my $data_source = $out{"data_source"};
62
+ my $username = $out{"username"};
63
+ my $password = $out{"password"};
64
+ my $user_nm = $in{"user_name"};
65
+ my $categpry = 1;
66
+
67
+ # DB接続
68
+ my $dbh = DBI->connect($data_source, $username, $password,{mysql_enable_utf8 => 1}) or die $DBI::errstr;
69
+
70
+ my $sth = $dbh->prepare(qq{
71
+ SELECT * FROM blog WHERE user = '$user_nm' AND ca_no = '$categpry' ORDER BY id DESC LIMIT 1
72
+ });
73
+
74
+ $sth->execute;
75
+ my %row;
76
+ my $i = 0;
77
+ while (my $ary_ref = $sth->fetchrow_arrayref){
78
+ ($row{"id_$i"},$row{"t_bi_$i"},$row{"ca_no_$i"},$row{"title_$i"},$row{"kizi_$i"},$row{"k_bi_$i"},$row{"iine_$i"},$row{"user_$i"}) = @$ary_ref;
79
+ $i++;
80
+ }
81
+ $sth->finish;
82
+
83
+ my $sth2 = $dbh->prepare(qq{
84
+ SELECT t_bi FROM blog WHERE user = '$user_nm' AND ca_no = '$categpry'
85
+ });
86
+ $sth2->execute;
87
+
88
+ my @tourokubi = ();
89
+ my $t = 0;
90
+ while (my $ary_ref = $sth2->fetchrow_arrayref){
91
+ ($tourokubi[$t]) = @$ary_ref;
92
+ $t++;
93
+ }
94
+ $sth2->finish;
95
+
96
+ my $sth3;
97
+ my ($yaer,$month);
98
+ my %month;
99
+ foreach(@tourokubi){
100
+ $_ =~ /(\d\d\d\d)-(\d\d)-(\d\d)/;
101
+ $yaer = $1;
102
+ $month = $2;
103
+ $sth3 = $dbh->prepare(qq{
104
+ SELECT COUNT(*) FROM blog WHERE user = '$user_nm' AND ca_no = '$categpry' AND t_bi LIKE '%$yaer-$month%'
105
+ });
106
+ $sth3->execute;
107
+ while (my $ary_ref = $sth3->fetchrow_arrayref){
108
+ ($month{"$yaer-$month"}) = @$ary_ref;
109
+ $t++;
110
+ }
111
+ $sth3->finish;
112
+ $sth3 = "";
113
+ }
114
+
115
+
116
+
117
+
118
+ # DB切断
119
+ $dbh->disconnect;
120
+
121
+ # HTML表示
122
+
123
+ print <<"TAG";
124
+ Content-type:text/html
125
+
126
+ <html>
127
+ <head>
128
+ <meta http-equiv="content-type" content="text/html; charset=UTF-8">
129
+ <title>DB test</title>
130
+ </head>
131
+ <body>
132
+ TAG
133
+
134
+ my $key;
135
+ foreach $key( keys %row){
136
+ print qq|$key = $row{"$key"}<br>\n|;
137
+ }
138
+
139
+ my $key2;
140
+ my $yyyymm;
141
+ foreach $key2( sort keys %month){
142
+ $yyyymm = $key2;
143
+ $yyyymm =~ s/(\d\d\d\d)-(\d\d)/$1年$2月/;
144
+ print "$yyyymm($month{$key2})<br>\n"; # count
145
+ }
146
+
147
+
148
+
149
+ print <<"TAG2";
150
+ </body>
151
+ </html>
152
+ TAG2
153
+
154
+ exit;
155
+ ```
156
+