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 @@ + + + + Hello + + +

Hello, world!

+ + \ 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 = <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 = <{'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(){ + print $_; +} + +__END__ + +=head1 'Hello World' Program +=over 4 +=item * option 1 +=item * option 2 +=back +=begin html +

Hello, World!

+=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 0000000..97f118d Binary files /dev/null and b/test.db differ