From 9e97869a9dfb06140ab0ce47f242e2793609ccdc Mon Sep 17 00:00:00 2001
From: Elex <developer@elex-project.com>
Date: Sun, 5 Mar 2023 23:42:45 +0900
Subject: [PATCH] 2023-03-05 23:42:45

---
 .vscode/settings.json    |  24 ++++++++++++++++++
 README.md                |  16 ++++++++++++
 src/cgi/Dockerfile       |  23 ++++++++++++++++++
 src/cgi/cgi-bin/hello.pl |  51 +++++++++++++++++++++++++++++++++++++++
 src/cgi/index.html       |   9 +++++++
 src/cgi/launcher.pl      |  28 +++++++++++++++++++++
 src/cgi/vhost.conf       |  12 +++++++++
 src/database.pl          |  42 ++++++++++++++++++++++++++++++++
 src/http.pl              |  23 ++++++++++++++++++
 src/json.pl              |  22 +++++++++++++++++
 src/mail.pl              |  13 ++++++++++
 src/pod.pl               |  21 ++++++++++++++++
 src/socket_client.pl     |  22 +++++++++++++++++
 src/socket_server.pl     |  20 +++++++++++++++
 test.db                  | Bin 0 -> 12288 bytes
 15 files changed, 326 insertions(+)
 create mode 100644 .vscode/settings.json
 create mode 100644 src/cgi/Dockerfile
 create mode 100755 src/cgi/cgi-bin/hello.pl
 create mode 100644 src/cgi/index.html
 create mode 100755 src/cgi/launcher.pl
 create mode 100644 src/cgi/vhost.conf
 create mode 100755 src/database.pl
 create mode 100755 src/http.pl
 create mode 100755 src/json.pl
 create mode 100755 src/mail.pl
 create mode 100755 src/pod.pl
 create mode 100755 src/socket_client.pl
 create mode 100755 src/socket_server.pl
 create mode 100644 test.db

diff --git a/.vscode/settings.json b/.vscode/settings.json
new file mode 100644
index 0000000..e82a3aa
--- /dev/null
+++ b/.vscode/settings.json
@@ -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
+}
\ No newline at end of file
diff --git a/README.md b/README.md
index 32cfc96..ddc4382 100644
--- a/README.md
+++ b/README.md
@@ -1 +1,17 @@
 # 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
+
diff --git a/src/cgi/Dockerfile b/src/cgi/Dockerfile
new file mode 100644
index 0000000..f5098f1
--- /dev/null
+++ b/src/cgi/Dockerfile
@@ -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;'
diff --git a/src/cgi/cgi-bin/hello.pl b/src/cgi/cgi-bin/hello.pl
new file mode 100755
index 0000000..b30b36c
--- /dev/null
+++ b/src/cgi/cgi-bin/hello.pl
@@ -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__
+
diff --git a/src/cgi/index.html b/src/cgi/index.html
new file mode 100644
index 0000000..31d3c91
--- /dev/null
+++ b/src/cgi/index.html
@@ -0,0 +1,9 @@
+<!DOCTYPE html>
+<html>
+    <head>
+        <title>Hello</title>
+    </head>
+    <body>
+        <p>Hello, world!</p>
+    </body>
+</html>
\ No newline at end of file
diff --git a/src/cgi/launcher.pl b/src/cgi/launcher.pl
new file mode 100755
index 0000000..45fcf86
--- /dev/null
+++ b/src/cgi/launcher.pl
@@ -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);
+}
\ No newline at end of file
diff --git a/src/cgi/vhost.conf b/src/cgi/vhost.conf
new file mode 100644
index 0000000..c38a972
--- /dev/null
+++ b/src/cgi/vhost.conf
@@ -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;        
+    } 
+}
\ No newline at end of file
diff --git a/src/database.pl b/src/database.pl
new file mode 100755
index 0000000..0a7c75f
--- /dev/null
+++ b/src/database.pl
@@ -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;
diff --git a/src/http.pl b/src/http.pl
new file mode 100755
index 0000000..3b86efc
--- /dev/null
+++ b/src/http.pl
@@ -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;
+}
\ No newline at end of file
diff --git a/src/json.pl b/src/json.pl
new file mode 100755
index 0000000..99f7006
--- /dev/null
+++ b/src/json.pl
@@ -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";
\ No newline at end of file
diff --git a/src/mail.pl b/src/mail.pl
new file mode 100755
index 0000000..0d50441
--- /dev/null
+++ b/src/mail.pl
@@ -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 $!;
diff --git a/src/pod.pl b/src/pod.pl
new file mode 100755
index 0000000..50069f9
--- /dev/null
+++ b/src/pod.pl
@@ -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
\ No newline at end of file
diff --git a/src/socket_client.pl b/src/socket_client.pl
new file mode 100755
index 0000000..4df893c
--- /dev/null
+++ b/src/socket_client.pl
@@ -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);
\ No newline at end of file
diff --git a/src/socket_server.pl b/src/socket_server.pl
new file mode 100755
index 0000000..1ceedd8
--- /dev/null
+++ b/src/socket_server.pl
@@ -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;
+}
\ No newline at end of file
diff --git a/test.db b/test.db
new file mode 100644
index 0000000000000000000000000000000000000000..97f118de9f18f767ae90ba2bbbb10fe339bf6410
GIT binary patch
literal 12288
zcmeI&KTE?v9LDjxHfpOjzxpSpqQlXtVs&wHGfF5$TQx?oizVu*g{s&_#Zi0(j)E`1
zSK#goa2Ff}SHZze@FJ8XF0Lxik!y3|dl^34LDp868om^}N38?T7c(r&IA?Q0FvdpJ
zOsd%#T-|7$h58THKaEi~T_4Y=DnTVi*XjoY0uX=z1Rwwb2tWV=5P$##An<nuRubLj
z<Rq{8-d0n#kDKaDU2n_d6M4A(eVJTvY|FKUYt1j&;#*rd^bTZE?VOOj$21InG4=II
zU$*^VCSsd|C!)~U5#_3DmuyF@IOU4v)Wo7)6V|%BT&}9VVprXw2wp5)dqdrNd$O}*
zA~>7p^hZW-^g>VcK=*V<w{$~SbV+B_q)l?DM6)zSc^ama{-M9>&uRk(1Rwwb2tWV=
z5P$##AOHafK;Rb$q;ncGc*Sd-=X*_!nS9Ncr!wC^qOmc)u<x~+4Vg(BVKf|xhGNlR
z7!5?CY%HQM(j!qO7WIcwUnJ^{Md>g~MWUWq)E!1$kw}Y0$uLSpA|8!`^FOC|rY;N!
hKmY;|fB*y_009U<00Izz00jP(K#C^~9(+BJ`vgOHke2`e

literal 0
HcmV?d00001