Top image

Perl Monk

主にPerlとRaspberryPiの個人的技術研鑽

ChatGPTのAPIを使って、Perlでrole処理しながらチャットサイトを作ってみる。

2024/03/26 20:00
category:Perl

通常のWEBでアクセスしてチャットするみたいなのをAPIつかって自前で作成してみました。

ATL

そんなの普通に使えば必要ないじゃんって事ですが、複数人数で利用する場合一つのアカウントを使いまわすことは規約的にNGなので、社内用に作ってみました。

そこからシンプルな形に一部削って掲載してます。

GPT4をAPIで叩くには、一度課金が発生しないと使えない場合があるそうなので一旦ガンガン回して課金してから有効にする必要があるかもです。

以下ソースコード。細かい処理は適当です、参考程度に。

#!/usr/bin/perl
use strict;
use warnings;
use FindBin;
use LWP::UserAgent;
use JSON;
use Encode;
use Time::HiRes;
use CGI qw(:standard);
# ------------------------------------------------------------------------ #
# 可変パラメータ
my $API_KEY = "【取得したAPIキー】";
my $max_role_count = 100;
my $max_tokens = 4096;
my $graf_width = 500;
my @model_list = ('gpt-4-turbo-preview', 'gpt-4', 'gpt-3.5-turbo');
my $program = "./index.cgi";
# ------------------------------------------------------------------------ #
my $tokens = 0;
my $role_count;
my $hash_question;
my $hash_answer;
my $standby_data = '';
# param
my $model = param('model');
if ( ! $model ) {
	$model = $model_list[0];
}
print "Content-Type: text/html; charset=UTF-8\n\n";
print "<!DOCTYPE html>\n";
print "<html>\n";
print "<head>\n";
print "<title>ChatGPT</title>\n";
print "<style type=\"text/css\">\n";
print "body {\n";
print "background-color:#333333;\n";
print "color:#FFFFFF;\n";
print "padding:20px;\n";
print "margin:0px;\n";
print "}\n";
print "A {text-decoration:underline;color:#EE0099}\n";
print "A:hover{text-decoration:underline; color:#EE0099;}\n";
print "A:active{text-decoration:underline; color:#EE0099;}\n";
print ".tablestyle {\n";
print "	width:400;\n";
print "	border-collapse: collapse;\n";
print "}\n";
print ".tablestyle td {\n";
print "	border:1px solid #999999;\n";
print "	background-color:#FFFFFF;;\n";
print "	color:#000000;\n";
print "	padding:2px 5px;\n";
print "	text-align:left;\n";
print "	font-size:12px;\n";
print "}\n";
print ".tablestyle th {\n";
print "	border:1px solid #999999;\n";
print "	background-color:#DDDDDD;\n";
print "	color:#000000;\n";
print "	padding:2px 5px;\n";
print "	text-align:left;\n";
print "	font-size:14px;\n";
print "	nowrap;\n";
print "}\n";
print "</style>\n";
print "</head>\n";
print "<body>\n";
# role_count
if ( ! param('role_count') or param('role_count') !~ /^\d+$/ ) {
	$role_count = 0;
} else {
	$role_count = param('role_count');
}
for ( my $i = 1 ; $i <= $role_count ; $i++ ) {
	if ( param('role_question_'.$i) ) {
		$hash_question->[$i] = param('role_question_'.$i);
	} else {
		$hash_question->[$i] = 'no_data';
	}
	if ( param('role_answer_'.$i) ) {
		$hash_answer->[$i] = param('role_answer_'.$i);
	} else {
		$hash_answer->[$i] = 'no_data';
	}
}
# ChatGPT APIアクセス
eval {
	if ( $max_role_count < $role_count ) {
		$role_count--;
		print "<span style=\"color:#FF3333;font-weight:bold;\">ロールカウント上限に達しました</span>\n";
		print "<div style=\"width:10px;height:30px;\"></div>\n";
	} elsif ( param('role_question_'.$role_count) ) {
		my $ua = LWP::UserAgent->new( timeout => 180 );
		my $req = HTTP::Request->new(
			POST => 'https://api.openai.com/v1/chat/completions'
		);
		$req->header('Content-Type' => 'application/json');
		$req->header('Authorization' => 'Bearer '.$API_KEY);
		my %post_data = (
			"model" => $model,
			"max_tokens" => $max_tokens,
		);
		for ( my $i = 1 ; $i <= $role_count ; $i++ ) {
			if ( 1 < $i ) {
				push @{$post_data{"messages"}},{
					"role" => "assistant",
					"content" => Encode::decode('utf-8',$hash_answer->[$role_count-1]),
				};
			}
			push @{$post_data{"messages"}},{
				"role" => "user",
				"content" => Encode::decode('utf-8',$hash_question->[$role_count]),
			};
		}
		$req->content(encode_json(\%post_data));
		my $resp = $ua->request($req);
		if ($resp->is_success) {
			my $resp_data = decode_json($resp->decoded_content);
			$hash_answer->[$role_count] = Encode::encode('utf-8',$resp_data->{choices}->[0]->{message}->{content});
			if ( $resp_data->{usage}->{total_tokens} ) {
				$tokens = $resp_data->{usage}->{total_tokens};
			}
		} else {
			print "<span style=\"color:#FF3333;font-weight:bold;\">APIリクエストに失敗しました。</span>\n";
			print $resp->status_line."\n";
			print "</body>\n";
			print "</html>\n";
			exit;
		}
	}
};
if ($@) {
	print "<span style=\"color:#FF3333;font-weight:bold;\">APIリクエストに失敗しました。</span>\n";
	print "</body>\n";
	print "</html>\n";
	exit;
}
{
	print "<span style=\"font-size:12px;\">ロールカウント:".$role_count."</span>\n";
	print "<table class=\"tablestyle\">";
	print "<tr>";
	print "<td>トークン量</td>";
	print "<td style=\"width:".int($graf_width)."px;\">";	
	my $width = ($tokens/$max_tokens)*$graf_width;
	if ( 500 < $width ) {
		$width = 500;
	}
	print "<div style=\"background:#00DDAA;width:".int($width)."px;white-space:nowrap;\">".$tokens." / ".$max_tokens." (".int($tokens/$max_tokens*100)."%)</div>";
	print "</td>";
	print "</tr>";
	print "</table>";
}
# フォーム開始
print "<div style=\"width:10px;height:10px;\"></div>\n";
print "<form method=\"post\" action=\"".$program."\">\n";
# role表示
for ( my $i = 1 ; $i <= $role_count ; $i++ ) {
	# question
	{
		print "<div style=\"width:100%;color:#9999FF;\">\n";
		print "You ><br>\n";
		print "<div style=\"width:10px;height:3px;\"></div>\n";
		my $tmp_data = html_escape($hash_question->[$i]);
		$tmp_data =~ s/\&\#013\;/<br>/g;
		print $tmp_data."\n";
		print "</div>\n";
		print "<input type=\"hidden\" name=\"role_question_".$i."\" value=\"".html_escape($hash_question->[$i])."\">\n";
		print "<div style=\"width:10px;height:10px;\"></div>\n";
	}
	# answer
	{
		print "<div style=\"width:100%;color:#99FF99;\">\n";
		print "ChatGPT ><br>\n";
		print "<div style=\"width:10px;height:3px;\"></div>\n";
		my $tmp_data = html_escape($hash_answer->[$i]);
		$tmp_data =~ s/\&\#013\;/<br>/g;
		print $tmp_data."\n";
		print "</div>\n";
		print "<input type=\"hidden\" name=\"role_answer_".$i."\" value=\"".html_escape($hash_answer->[$i])."\">\n";
		print "<div style=\"width:10px;height:10px;\"></div>\n";
	}
	print "<div style=\"width:10px;height:20px;\"></div>\n";
}
$role_count++;
print "<input type=\"hidden\" name=\"role_count\" value=\"".$role_count."\">\n";
# 入力
if ( $max_tokens <= $tokens ) {
	print "<span style=\"color:#FF3333;font-weight:bold;\">トークン上限に達した為、これ以上入力できません。</span>\n";
	print "<div style=\"width:10px;height:30px;\"></div>\n";
} else {
	# model
	print "<div>\n";
	print "使用モデル:<select name=\"model\" style=\"width:200px;\">";
	foreach my $value ( @model_list ) {
		if ( $model and $value eq $model ) {
			print "<option value=\"".$value."\" selected>".$value;
		} else {
			print "<option value=\"".$value."\">".$value;
		}
	}
	print "</select>\n";
	print "</div>\n";
	print "<div style=\"width:10px;height:10px;\"></div>\n";
	# input
	if ( $standby_data ) {
		print "<textarea  style=\"width:800px;\" rows=\"3\" name=\"role_question_".$role_count."\" autocomplete=\"off\">".html_escape($standby_data)."</textarea >\n";
	} else {
		print "<textarea  style=\"width:800px;\" rows=\"3\" name=\"role_question_".$role_count."\" autocomplete=\"off\" placeholder=\"質問を入力して下さい\"></textarea >\n";
	}
	print "<div style=\"width:10px;height:3px;\"></div>\n";
	print "<input style=\"width:100px;height:30px;\" type=\"submit\" value=\"入力\">\n";
	print "<div style=\"width:10px;height:3px;\"></div>\n";
}
print "<div style=\"width:10px;height:50px;\"></div>\n";
print "</form>\n";
print "</body>\n";
print "</html>\n";
exit;
# HTMLエスケープ表示
sub html_escape {
	my $data = shift;
	my $length = shift;
	if ( ! $data ) {
		return;
	}
	if ( $length and $length =~ /^\d+$/ ) {
		$data = Encode::encode('utf-8',substr(Encode::decode('utf-8',$data),0,$length));
	}
	$data =~ s/\t/\&\#009\;/g;
	$data =~ s/\r\n/\&\#013\;/g;
	$data =~ s/\n\r/\&\#013\;/g;
	$data =~ s/\r/\&\#013\;/g;
	$data =~ s/\n/\&\#013\;/g;
	$data =~ s/\s/\&\#032\;/g;
	$data =~ s/\!/\&\#033\;/g;
	$data =~ s/\"/\&\#034\;/g;
#	$data =~ s/\#/\&\#035\;/g;
	$data =~ s/\$/\&\#036\;/g;
	$data =~ s/\%/\&\#037\;/g;
#	$data =~ s/\&/\&\#038\;/g;
	$data =~ s/\'/\&\#039\;/g;
	$data =~ s/\(/\&\#040\;/g;
	$data =~ s/\)/\&\#041\;/g;
	$data =~ s/\*/\&\#042\;/g;
	$data =~ s/\+/\&\#043\;/g;
	$data =~ s/\,/\&\#044\;/g;
	$data =~ s/\-/\&\#045\;/g;
	$data =~ s/\./\&\#046\;/g;
	$data =~ s/\//\&\#047\;/g;
	$data =~ s/\:/\&\#058\;/g;
#	$data =~ s/\;/\&\#059\;/g;
	$data =~ s/\</\&\#060\;/g;
	$data =~ s/\=/\&\#061\;/g;
	$data =~ s/\>/\&\#062\;/g;
	$data =~ s/\?/\&\#063\;/g;
	$data =~ s/\@/\&\#064\;/g;
	$data =~ s/\[/\&\#091\;/g;
	$data =~ s/\\/\&\#092\;/g;
	$data =~ s/\]/\&\#093\;/g;
	$data =~ s/\^/\&\#094\;/g;
	$data =~ s/\_/\&\#095\;/g;
	$data =~ s/\`/\&\#096\;/g;
	$data =~ s/\{/\&\#123\;/g;
	$data =~ s/\|/\&\#124\;/g;
	$data =~ s/\}/\&\#125\;/g;
	$data =~ s/\~/\&\#126\;/g;
	return $data;
}