elex/perl-examples
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

2023-03-05 23:42:45

Browse Source
This commit is contained in:
Elex
2023-03-05 23:42:45 +09:00
parent 25b3c0eb79
commit 9e97869a9d
15 changed files with 326 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
.vscode/settings.json vendored Normal file
View File

@@ -0,0 +1,24 @@
{
"sqltools.connections": [
{
"mysqlOptions": {
"authProtocol": "default"
},
"previewLimit": 50,
"server": "localhost",
"port": 3306,
"driver": "MariaDB",
"name": "DockerLocal",
"database": "finance",
"username": "elex",
"password": "test"
},
{
"previewLimit": 50,
"driver": "SQLite",
"name": "test",
"database": "${workspaceFolder:perl-examples}/test.db"
}
],
"sqltools.useNodeRuntime": true
}

16
README.md
View File

@@ -1 +1,17 @@
# Perl Examples # Perl Examples
## JSON
https://metacpan.org/pod/JSON
```bash
sudo cpanm JSON
```
### decode_json
* pass a json string
* returns a reference to a hash
### encode_json
* pass a reference to a hash
* returns a json string

23
src/cgi/Dockerfile Normal file
View File

@@ -0,0 +1,23 @@
FROM nginx:latest
RUN apt-get clean && \
apt-get update && \
apt-get install -y spawn-fcgi fcgiwrap wget curl cpanminus build-essential
RUN cpanm JSON
RUN sed -i 's/www-data/nginx/g' /etc/init.d/fcgiwrap
RUN chown nginx:nginx /etc/init.d/fcgiwrap
ADD ./vhost.conf /etc/nginx/conf.d/default.conf
RUN apt-get clean && \
rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/*
WORKDIR /var/www
EXPOSE 80
CMD /etc/init.d/fcgiwrap start && \
nginx -g 'daemon off;'

51
src/cgi/cgi-bin/hello.pl Executable file
View File

@@ -0,0 +1,51 @@
#!/usr/bin/perl
use warnings;
use strict;
use JSON;
my $buffer;
$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
if ($ENV{'REQUEST_METHOD'} eq "GET") {
$buffer = $ENV{'QUERY_STRING'};
my $params_ref = &parse_query($buffer);
print "$ENV{SERVER_PROTOCOL} 200 OK\r\n";
print "Content-type:text/plain\r\n";
print "\r\n";
print "Hello\n";
for my $key (keys %$params_ref) {
print "$key => $params_ref->{$key}\r\n";
}
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
my $obj_ref = &parse_json_body($buffer);
print "$ENV{SERVER_PROTOCOL} 200 OK\r\n";
print "Server: $ENV{SERVER_SOFTWARE}\r\n";
print "Content-type:application/json\r\n";
print "\r\n";
print &encode_json($obj_ref)."\r\n";
print $obj_ref->{'name'};
}
sub parse_json_body {
return &decode_json($_[0]);
}
sub parse_query {
my %params;
my @pairs = split(/&/, $_[0]);
foreach my $pair (@pairs) {
my ($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%(..)/pack("C", hex($1))/eg;
$params{$name} = $value;
}
return \%params;
}
__END__

9
src/cgi/index.html Normal file
View File

@@ -0,0 +1,9 @@
<!DOCTYPE html>
<html>
<head>
<title>Hello</title>
</head>
<body>
<p>Hello, world!</p>
</body>
</html>

28
src/cgi/launcher.pl Executable file
View File

@@ -0,0 +1,28 @@
#!/usr/bin/perl
use warnings;
use strict;
my $name = 'perl-cgi';
my $version = '1.0.2';
my $sh_build = <<SHELL;
docker build --pull -f "Dockerfile" -t $name:$version .
SHELL
my $sh_run = <<SHELL;
docker run -d --name=$name --network=skynet --restart=always
-p 9998:80
-v /media/elex/UltraFit/Workspace/ELEX/perl-examples/src/cgi/vhost.conf:/etc/nginx/conf.d/default.conf
-v /media/elex/UltraFit/Workspace/ELEX/perl-examples/src/cgi:/var/www
-e TZ=Asia/Seoul
-e LANG=ko_KR.UTF-8
--log-opt max-size=10m --log-opt max-file=3
$name:$version
SHELL
if ($ARGV[0] eq 'build') {
system($sh_build);
} elsif ($ARGV[0] eq 'run') {
$sh_run =~ tr/\n/ /;
system($sh_run);
}

12
src/cgi/vhost.conf Normal file
View File

@@ -0,0 +1,12 @@
server {
listen 80;
index index.html;
root /var/www;
location ~ \.pl$ {
gzip off;
fastcgi_param SERVER_NAME $http_host;
fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name;
include /etc/nginx/fastcgi_params;
fastcgi_pass unix:/var/run/fcgiwrap.socket;
}
}

42
src/database.pl Executable file
View File

@@ -0,0 +1,42 @@
#!/usr/bin/perl
use warnings;
use strict;
use DBI;
my $dbFile = 'test.db';
my $dbUsername = '';
my $dbPassword = '';
#
my $dbh = DBI->connect("DBI:SQLite:dbname=$dbFile", $dbUsername, $dbPassword);
my $table = 'test';
my $sth = $dbh->do("CREATE TABLE IF NOT EXISTS $table (id INTEGER PRIMARY KEY AUTOINCREMENT, name TEXT, age INTEGER);");
$sth = $dbh->prepare("INSERT INTO $table (name, age) VALUES (?,?);");
$sth->execute('Charlie', 13);
$sth->execute('Steve', 34);
$sth->execute('Mary', 34);
$dbh->commit() or die $DBI::errstr;
$sth = $dbh->prepare("SELECT * FROM $table WHERE age=?;");
$sth->execute(34);
while(my @row = $sth->fetchrow_array()){
my ($id, $name, $age) = @row;
print "$id | $name | $age\n";
}
$sth = $dbh->prepare("SELECT * FROM $table WHERE name=?;");
$sth->execute('Charlie');
my ($id, $name, $age);
$sth->bind_columns(\$id, \$name, \$age);
while($sth->fetch()){
print "$id | $name | $age\n";
}
$sth = $dbh->prepare("SELECT * FROM $table WHERE name=?;");
$sth->execute('Steve');
while(my $row = $sth->fetchrow_hashref()){
print "$row->{id} | $row->{name} | $row->{age}\n";
}
my $rc = $dbh->disconnect or warn $dbh->errstr;

23
src/http.pl Executable file
View File

@@ -0,0 +1,23 @@
#!/usr/bin/perl
use warnings;
use strict;
use URI::URL;
use HTTP::Headers;
use HTTP::Request;
use LWP::UserAgent;
my $url = new URI::URL('https://www.the-kn.com');
my $headers = new HTTP::Headers(
'Accept' => 'text/html',
'User-Agent' => 'Elex/1.0'
);
my $request = new HTTP::Request('GET', $url, $headers);
my $user_agent = new LWP::UserAgent;
my $response = $user_agent->request($request);
if ($response->is_success) {
print $response->content;
} else {
print $response->message;
}

22
src/json.pl Executable file
View File

@@ -0,0 +1,22 @@
#! /usr/bin/perl
use strict;
use JSON; # https://metacpan.org/pod/JSON
# sudo cpanm JSON
## from json to hash
my $json = <<JSON;
{
"name":"charlie",
"age":13
}
JSON
my $obj = &decode_json($json); # returns a reference to a hash
print "NAME: $obj->{'name'}\n";
print "AGE: $obj->{'age'}\n";
## from hash to json
my %person = ('name'=>'Steve', 'age'=>34);
my $text = &encode_json(\%person); # pass a reference to a hash
print "JSON TEXT: $text\n";

13
src/mail.pl Executable file
View File

@@ -0,0 +1,13 @@
#!/usr/bin/perl
use warnings;
use strict;
use Mail::Send;
my $mail = Mail::Send->new;
$mail->set('To', ('you@example.com', 'another@example.com'));
$mail->to('you@example.com');
$mail->subject('Sample Mail');
my $fh = $mail->open('sendmail');
print $fh "This is the message.\n";
$fh->close or die $!;

21
src/pod.pl Executable file
View File

@@ -0,0 +1,21 @@
#!/usr/bin/perl
use warnings;
use strict;
print "Hello, World!";
while(<DATA>){
print $_;
}
__END__
=head1 'Hello World' Program
=over 4
=item * option 1
=item * option 2
=back
=begin html
<p>Hello, <strong>World</strong>!</p>
=end html
=cut

22
src/socket_client.pl Executable file
View File

@@ -0,0 +1,22 @@
#!/usr/bin/perl
use strict;
use warnings;
use Socket;
my $port = 9999;
my $host = "localhost";
my $socket;
my $iaddr = inet_aton($host);
my $paddr = sockaddr_in($port, $iaddr);
socket($socket, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
connect($socket, $paddr) or die $!;
my $line;
while ($line = <$socket>){
print "$line\n";
}
close $socket or die "close : $!";
exit(0);

20
src/socket_server.pl Executable file
View File

@@ -0,0 +1,20 @@
#!/usr/bin/perl
use strict;
use warnings;
use Socket;
my $port = 9999;
my $server;
socket($server, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
bind($server, sockaddr_in($port, INADDR_ANY)) or die $!;
listen($server, 10);
while(1){
my $client;
my $paddr = accept($client, $server);
my ($port, $iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr, AF_INET);
print $client "Smile from the server.";
print "Connection received from $name\n";
close $client;
}

BIN
test.db Normal file
View File

Binary file not shown.