Merge remote-tracking (subtree) branch 'PracticingPerl/master'

PracticingPerl/.gitignore

@@ -0,0 +1,9 @@
+*/*.log
+*/*.pid
+*/*.sock
+
+web/nginx.conf
+web/lighttpd.conf
+web/cgiwrap-fcgi.pl
+web/*_temp/*
+web/lighttpd-*/

PracticingPerl/README.pod

@@ -0,0 +1,7 @@
+=encoding utf8
+
+=head1 I'm learning me some perl!
+
+After a long absence from having anything to do with
+"da camel," I'm getting familiar again.
+

PracticingPerl/cli/argv.pl

@@ -0,0 +1,10 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+foreach my $a (@ARGV) {
+    printf("$a\n");
+}
+
+1;
+__END__

PracticingPerl/cli/array_variables.pl

@@ -0,0 +1,48 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+my ($length, $width, $depth) = (10, 20, 15);
+
+print "The values are: ", $length, $width, $depth, "\n";
+
+my ($name1, $name2, $name3, $name4) = ('Paul', 'Michael', 'Jessica', 'Megan');
+
+print "Names are: $name1, $name2, $name3, $name4\n";
+
+($name1, $name2, $name3, $name4) = qw/Paul Michael Jessica Megan/;
+
+print "Names are: $name1, $name2, $name3, $name4\n";
+
+($name1, $name2, $name3, $name4) = qw(Paul Michael Jessica Megan);
+
+print "Names are: $name1, $name2, $name3, $name4\n";
+
+
+my @nums = (1, 2, 3, 4, 5);
+print "\@nums=@nums\n";
+my @more = 6 .. 1000;
+print "\@more=@more\n";
+my @none = ();
+print "\@none=@none\n";
+my @names = qw/Paul Michael Jessica Megan/;
+print "\@names=@names\n";
+my @all = (@nums, @more);
+print "\@all=@all\n";
+my @nested = (@nums, \@more);
+print "\@nested=@nested\n";
+
+my $all_len = @all;
+my $nested_len = @nested;
+
+print "\@all has length $all_len\n";
+print "\@nested has length $nested_len\n";
+
+
+my @array = (1, 2, 3, 4, 5);
+print $array[0] . "\n";
+print $array[3] . "\n";
+print $array[-1] . "\n";
+print $array[4] . "\n";
+print $array[-1] . "\n";
+print $array[$#array] . "\n";

PracticingPerl/cli/datatypes.pl

@@ -0,0 +1,19 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+my $foo = 'foo';
+print "\$foo=$foo\n";
+
+my @foo = (1, 2, 3);
+print "\@foo=@foo\n";
+
+my %foo = (
+    1 => 'one',
+    2 => 'two',
+    3 => 'three',
+);
+print "\%foo=" . %foo . "\n";
+
+my $log = *STDIN;
+print $log . "\n";

PracticingPerl/cli/ex01/a.pl

@@ -0,0 +1,10 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+
+print "Hello world\n";
+
+
+1;
+__END__

PracticingPerl/cli/ex01/b.pl

@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+
+my $num = 4000 / 7;
+print "$num\n";
+
+print int($num + 0.005) . "\n";
+
+printf("%.3f\n", $num);
+
+printf("00%.3f\n", $num);
+
+
+sub show_signed {
+    my ($num) = @_;
+    if ($num gt 0) {
+        printf("+%.3f\n", $num);
+    } else {
+        printf("%.3f\n", $num);
+    }
+}
+
+show_signed($num);
+show_signed($num - 1000);
+
+
+1;
+__END__

PracticingPerl/cli/ex01/c.pl

@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Math::Complex;
+
+
+sub quad {
+    my ($a, $b, $c) = @_;
+    my $positive = (
+        ($b * -1) - sqrt(($b ** 2) - (4 * ($a * $c))) / (2 * $a)
+    );
+    my $negative = (
+        ($b * -1) + sqrt(($b ** 2) - (4 * ($a * $c))) / (2 * $a)
+    );
+
+    return ($positive, $negative);
+}
+
+
+my @xx0 = quad(1, 2, 3);
+printf("%s, %s\n", $xx0[0], $xx0[1]);
+
+my @xx1 = quad(4, 5, 6);
+printf("%s, %s\n", $xx1[0], $xx1[1]);
+
+my @xx2 = quad(7, 8, 9);
+printf("%s, %s\n", $xx2[0], $xx2[1]);
+
+
+1;
+__END__

PracticingPerl/cli/ex01/d.pl

@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Math::Complex;
+
+
+print "Entrez-vous\n";
+
+my ($a, $b, $c) = (rand(100), rand(100), rand(100));
+
+print "\$a=$a\n";
+print "\$b=$b\n";
+print "\$c=$c\n";
+
+
+sub quad {
+    my ($a, $b, $c) = @_;
+    my $positive = (
+        ($b * -1) - sqrt(($b ** 2) - (4 * ($a * $c))) / (2 * $a)
+    );
+    my $negative = (
+        ($b * -1) + sqrt(($b ** 2) - (4 * ($a * $c))) / (2 * $a)
+    );
+
+    return ($positive, $negative);
+}
+
+
+my @result = quad($a, $b, $c);
+printf("%s, %s\n", $result[0], $result[1]);
+
+
+1;
+__END__
+
+
+
+1;
+__END__

PracticingPerl/cli/ex02/input.pl

@@ -0,0 +1,22 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+
+my @inlines = ();
+my $i = 0;
+
+for ($i = 0; $i < 3; $i++) {
+    print "input please: ";
+    my $inline = <STDIN>;
+    $inline =~ s/\s*$//;
+    $inlines[$i] = $inline;
+}
+
+
+print "You said:\n";
+print join("|", $inlines[0], $inlines[1], $inlines[2] . "\n");
+
+
+1;
+__END__

PracticingPerl/cli/ex02/input_argv.pl

@@ -0,0 +1,11 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+foreach my $inline (@ARGV) {
+    print $inline . "\n";
+}
+
+
+1;
+__END__

PracticingPerl/cli/ex02/input_fromfile.pl

@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use IO::File;
+use File::Basename;
+
+
+my $script = basename($0);
+my $USAGE = <<USAGE
+Usage: $script <infile>
+USAGE
+;
+
+if (!defined $ARGV[0]) {
+    die $USAGE;
+}
+
+my $infile = $ARGV[0];
+open(DAT, $infile) or die "$infile: $!";
+my @cleaned = ();
+foreach my $line (<DAT>) {
+    $line =~ s/\s*$//;
+    $cleaned[++$#cleaned] = $line;
+}
+
+print join("|", @cleaned) . "\n";
+
+close(DAT);
+
+
+1;
+__END__

PracticingPerl/cli/ex02/quadratic.pl

@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Math::Complex;
+use File::Basename;
+
+
+my $prog = basename($0);
+my $USAGE = <<USAGE
+Usage: $prog <a> <b> <c>
+USAGE
+;
+
+
+sub quad {
+    my ($a, $b, $c) = @_;
+    my $positive = (
+        ($b * -1) - sqrt(($b ** 2) - (4 * ($a * $c))) / (2 * $a)
+    );
+    my $negative = (
+        ($b * -1) + sqrt(($b ** 2) - (4 * ($a * $c))) / (2 * $a)
+    );
+
+    return ($positive, $negative);
+}
+
+foreach my $arg (@ARGV) {
+    if (($arg eq "-h") || ($arg eq "--help")) {
+        die $USAGE;
+    }
+}
+
+my ($a, $b, $c) = @ARGV;
+if (!defined $a) {
+    print '$a = ';
+    $a = <STDIN>;
+}
+if (!defined $b) {
+    print '$b = ';
+    $b = <STDIN>;
+}
+if (!defined $c) {
+    print '$c = ';
+    $c = <STDIN>;
+}
+
+my @result = quad($a, $b, $c);
+printf("%s, %s\n", $result[0], $result[1]);
+
+
+1;
+__END__

PracticingPerl/cli/ex03/rwfakegrep.pl

@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use File::Basename;
+use English qw/$PROGRAM_NAME/;
+
+my $basename = basename($0);
+my $USAGE = <<USAGE
+Usage: $basename <infile> <outfile>
+USAGE
+;
+
+
+sub show_last_chapter_with_nlines {
+    my ($ch, $nlines) = @_;
+    print "Chapter $ch has $nlines lines\n";
+}
+
+
+sub main {
+    open(INFILE, '<', $ARGV[0]) or die "$USAGE\n$!";
+    open(OUTFILE, '>', $ARGV[1]) or die "$USAGE\n$!";
+
+    my $have_seen_firstchapter = 'no';
+    my $nlines = 0;
+    my $chline = '';
+    my $ch = '';
+
+    foreach my $inline (<INFILE>) {
+        if ($inline =~ /^\s*CHAPTER.*$/) {
+
+            $chline = "$inline";
+            $ch = "$chline";
+            $ch =~ s/^\s*CHAPTER\s*([0-9]*).*/$1/;
+            $ch =~ s/[\r\n]//;
+
+            if ($have_seen_firstchapter eq 'yes') {
+                show_last_chapter_with_nlines($ch - 1, $nlines);
+                $nlines = 0;
+            } else {
+                $have_seen_firstchapter = 'yes';
+                $nlines = 0;
+            }
+            print OUTFILE $inline;
+        }
+        $nlines++;
+    }
+
+    show_last_chapter_with_nlines($ch, $nlines);
+
+}
+
+
+if ($PROGRAM_NAME eq __FILE__) {
+    main();
+}
+
+
+1;
+__END__

PracticingPerl/cli/ex03/rwfiles.pl

@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use File::Basename;
+
+my $basename = basename($0);
+my $USAGE = <<USAGE
+Usage: $basename <infile> <outfile>
+USAGE
+;
+
+open(INFILE, '<', $ARGV[0]) or die "$USAGE\n$!";
+open(OUTFILE, '>', $ARGV[1]) or die "$USAGE\n$!";
+
+foreach my $inline (<INFILE>) {
+    print OUTFILE $inline;
+}
+
+
+
+1;
+__END__

PracticingPerl/cli/filehandles.pl

@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use IO::File;
+use Data::Dumper;
+
+open(my $fh, '<', 'foo.txt');
+
+my @lines = <$fh>;
+
+print Data::Dumper->Dump([\@lines], [qw(lines)]);
+
+
+open(my $fh2, '<', 'foo.txt');
+
+while(my $line = <$fh2>) {
+    print $line;
+}
+
+
+my $fh3 = IO::File->new('foo.txt', 'r');
+
+while(my $line = $fh3->getline()) {
+    print $line;
+}
+
+
+my $fh4 = IO::File->new('foo.txt', 'r');
+my @lines4 = $fh4->getlines();
+
+print @lines4;
+print Data::Dumper->Dump([\@lines4], [qw(lines)]);
+
+
+1;
+__END__

PracticingPerl/cli/foo.txt

@@ -0,0 +1,6 @@
+these
+runes
+are
+dusty
+sir
+?

PracticingPerl/cli/functions.pl

@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+sub print_error_message {
+    my ($message) = @_;
+    print STDOUT "ERROR: " . $message . "!!!\n";
+}
+
+
+print_error_message("something bad happened");
+print_error_message("something really horrible happened");
+print_error_message("something sort of annoying happened");
+
+
+sub add_two_numbers {
+    my ($x, $y) = @_;
+    my $sum = $x + $y;
+    return $sum;
+}
+
+print add_two_numbers(3, 4) . "\n";
+print add_two_numbers(5, 6) . "\n";
+print add_two_numbers(7, 8) . "\n";
+
+
+sub add_two_numbers_and_mult_by_three {
+    my ($x, $y) = @_;
+    my $sum = add_two_numbers($x, $y);
+    my $sum_times_three = $sum * 3;
+    return $sum_times_three;
+}
+
+print add_two_numbers_and_mult_by_three(3, 4) . "\n";
+print add_two_numbers_and_mult_by_three(5, 6) . "\n";
+print add_two_numbers_and_mult_by_three(7, 8) . "\n";
+
+
+sub factorial {
+    my ($num) = @_;
+    if ($num == 1) {
+        return 1;
+    } else {
+        return $num * factorial($num - 1);
+    }
+}
+
+foreach my $n (1 .. 10) {
+    print factorial($n) . "\n";
+}
+
+
+1;
+__END__

PracticingPerl/cli/hash_variables.pl

@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Data::Dumper;
+
+
+my %petsounds = (
+    "cat" => "meow",
+    "dog" => "woof",
+    "snake" => "hiss"
+);
+
+
+print "The cat goes " . $petsounds{"cat"} . ".\n";
+
+
+$petsounds{"mouse"} = "squeak!";
+$petsounds{"dog"} = "arf!";
+
+
+delete($petsounds{"cat"});
+
+
+print "The mouse goes " . $petsounds{"mouse"} . ".\n";
+
+
+print Dumper(\%petsounds) . "\n";
+
+
+my %a = ();
+$a{1}{"a"}{"A"} = "FIRST";
+$a{1}{"c"}{"B"} = "THIRD";
+$a{1}{"b"}{"C"} = "SECOND";
+
+foreach my $k1 (sort keys %a) {
+    foreach my $k2 (sort keys %{$a{$k1}}) {
+        foreach my $k3 (sort keys %{$a{$k1}{$k2}}) {
+            print "$k1\t$k2\t$k3\t$a{$k1}{$k2}{$k3}\n";
+        }
+    }
+}
+
+print Dumper(\%a);
+
+
+1;
+__END__

PracticingPerl/cli/heredoc.pl

@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+print <<EOF
+this
+is a
+multiline
+string
+yes?
+EOF
+;

PracticingPerl/cli/myprog.pl

@@ -0,0 +1,5 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+print "Hello World\n";

PracticingPerl/cli/numbers.pl

@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+my $a = 4;
+
+print "\$a = $a\n";
+print "\$a++ = " . $a++ . "\n";
+print "++\$a = " . ++$a . "\n";
+print "\$a-- = " . $a-- . "\n";
+print "--\$a = " . --$a . "\n";
+print "\$a += 5 = " . ($a += 5) . "\n";
+print "\$a -= 2 = " . ($a -= 2) . "\n";

PracticingPerl/cli/operators.pl

@@ -0,0 +1,154 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.0100;
+
+
+sub println {
+    local $, = "";
+    print +(@_ ? @_ : $_), $/;
+}
+
+
+println(4 % 3);
+
+println(4 % 2);
+
+println(-4 % 3);
+
+println(4 ** 2);
+
+println(2 ** (1/2));
+
+my $foo = 1;
+
+println($foo--);
+
+println($foo);
+
+println("dog");
+
+$foo = 1;
+
+println(--$foo);
+
+println($foo);
+
+$foo = 'd';
+
+println(--$foo);
+
+println($foo);
+
+$foo = 'Z';
+
+println($foo++);
+
+println($foo);
+
+$foo = 'Hello';
+$foo .= ', world';
+println($foo);
+
+my $bar = '+';
+$bar x= 6;
+println($bar);
+
+print '$a = ';
+my $a = <STDIN>;
+print '$b = ';
+my $b = <STDIN>;
+print '$c = ';
+my $c = <STDIN>;
+
+
+my $ncookies = 0;
+
+sub printcookies {
+    println("I like cookies " . $ncookies++);
+}
+
+
+if ($a == 5 && $b == 2) {
+    printcookies();
+}
+
+
+if ($a == 5 && $b == 2 || $c == 2) {
+    printcookies();
+}
+
+
+if ($a == 5 and ($b == 2 || $c == 3)) {
+    printcookies();
+}
+
+
+if ($a == 5 && $b == 2 or $c == 3) {
+    printcookies();
+}
+
+
+if ($a == 5 && $b == 2 or $c == 3) {
+    printcookies();
+}
+
+
+if (($a == 5 && $b == 2) or $c == 3) {
+    printcookies();
+}
+
+
+($a, $b) = (5, 2);
+if ($a == 4 && $b < 3) {
+    printcookies();
+}
+
+sub foo {
+    return ($c eq 0);
+}
+
+foo() or print "foo() failed\n";
+
+
+print 'Hello' . ' world';
+print "\n";
+
+my $str = "hi";
+my $repeated_str = $str x 5;
+println("$repeated_str");
+
+println($repeated_str eq 'hihihihihi');
+
+println($str ne 'hi');
+
+$str =~ s/i/m/g;
+println($str);
+
+
+print 'A' .. 'Z', "\n";
+print 'a' .. 'z', "\n";
+print 'A' .. 'z', "\n";
+print 1 .. 20, "\n";
+print '&' .. '!', "\n";
+print 10 .. -10, "\n";
+print "$_\n" foreach 1 .. 10, "\n";
+
+
+my $scalar = 'hi';
+my @array = qw(one two three);
+my %hash = (
+    hi => 1,
+    ho => 2,
+    he => 3,
+);
+
+if ($scalar ~~ @array) {
+    print "scalar matches array\n";
+}
+if ($scalar ~~ %hash) {
+    print "scalar matches hash\n";
+}
+if (@array ~~ %hash) {
+    print "array matches hash\n";
+}

PracticingPerl/cli/quoting.pl

@@ -0,0 +1,34 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+
+print qq{I said "They're the most delicious fruits!".\n};
+print q/I said "They're the most delicious fruits!"./ . "\n";
+
+
+print <<OUTPUT
+I said "They're the most delicious fruits!".
+OUTPUT
+;
+
+my $one = 'mangoes';
+
+print "I like $one.\n";
+print 'I like $one.' . "\n";
+print qq/I love $one.\n/;
+print q#I love $one.# . "\n";
+
+print <<OUT
+I <3 $one
+OUT
+;
+
+print <<'OUT'
+I <3 $one
+OUT
+;
+
+
+1;
+__END__

PracticingPerl/cli/raw_printing.pl

@@ -0,0 +1,8 @@
+#!/usr/bin/perl
+
+my $forename = "John";
+my $message = "Hello ";
+
+print $message;
+print $forename;
+print "\n";

PracticingPerl/cli/scalar_numbers.pl

@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+my $age = 30;
+
+print "Hello $age year old.\n";
+
+
+
+my $x = 10;
+my $y = $x + 1;
+
+print "Using a number $x + 1 = $y.\n";
+
+$x = "10";
+$y = $x + 1;
+
+print "Using a string $x + 1 = $y.\n";
+
+$x = "ten";
+$y = $x + 1;
+
+print "Using an English word, $x + 1 = $y.\n";
+
+$x = "2ten";
+$y = $x + 1;
+
+print "Using a funny string, $x + 1 = $y.\n";
+
+
+1;

PracticingPerl/cli/stdio.pl

@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+
+print "What is your name?: ";
+
+my $name = <STDIN>;
+$name =~ s/\n//;
+
+print "Your name is $name\n";
+
+
+1;
+__END__

PracticingPerl/cli/string_operators.pl

@@ -0,0 +1,6 @@
+#!/usr/bin/perl
+
+print "Hello" . "World\n";
+print "Hello" . " " . "World\n";
+
+print "Hello" x 5, "\n";

PracticingPerl/cli/variables.pl

@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+my $firstname = "Jonathan";
+
+print "Hello, $firstname\n";
+
+$firstname = "John";
+
+print "Goodbye, $firstname\n";
+
+
+my $variable = "\0";
+my $another_variable = 2;
+my @array_variable = qw(one two three);
+
+$variable = 3;
+print "$variable\n";
+$variable = 3.1415926;
+print "$variable\n";
+$variable = 3.402823669209384634633e+38;
+print "$variable\n";
+$variable = $another_variable + 1;
+print "$variable\n";
+$variable = 'Can contain text';
+print "$variable\n";
+$variable = \$another_variable;
+print "$variable\n";
+$variable = \@array_variable;
+print "$variable\n";
+
+
+my @Array1 = (1, 2, 3);
+my @Array2 = (4, 5, 6);
+my @Array3 = (7, 8, 9);
+
+@array_variable = (1, 2, 3, 4, 5, 6, 7, 8, 9, 10);
+print "@array_variable\n";
+@array_variable = (1 .. 10);
+print "@array_variable\n";
+@array_variable = ('John', 'Paul', 'George', 'Ringo');
+print "@array_variable\n";
+@array_variable = qw/John Paul George Ringo/;
+print "@array_variable\n";
+@array_variable = qw/red blue 1 green 5/;
+print "@array_variable\n";
+@array_variable = (\@Array1, \@Array2, \@Array3);
+print "@array_variable\n";
+
+my $idx = 2;
+
+$array_variable[0] = 1;
+print "@array_variable\n";
+$array_variable[$idx] = 1;
+print "@array_variable\n";
+
+my %hash = (
+    'key1' => 'value1',
+    'key2' => 'value2',
+    'key3' => 'value3',
+);
+print %hash, "\n";
+
+$hash{'key1'} = 'newval1';
+print %hash, "\n";
+
+
+sub fib {
+    my $n = shift();
+    return $n if $n < 2;
+    return fib($n - 1) + fib($n - 2);
+}
+
+print fib(14), "\n";

PracticingPerl/web/Makefile

@@ -0,0 +1,39 @@
+
+ROOT ?= $(PWD)
+HTTP_PORT ?= 49228
+NGINX_CONF_IN := nginx.conf.in
+ALL_NGINX_CONF_INPUTS := \
+	$(NGINX_CONF_IN) \
+	$(wildcard perl_requirements.d/*) \
+	$(wildcard perl_locations.d/*)
+
+
+serve-lighttpd: lighttpd.conf
+	lighttpd -D -f $(ROOT)/$<
+
+
+serve-nginx: nginx.conf
+	nginx -p $(ROOT)/ -c $(ROOT)/$<
+
+
+nginx.conf: $(ALL_NGINX_CONF_INPUTS)
+	cat $< |  \
+	sed -e 's@__ROOT__@$(ROOT)@g' \
+	    -e 's@__HTTP_PORT__@$(HTTP_PORT)@g' > $@
+
+
+lighttpd.conf: lighttpd.conf.in
+	cat $< |  \
+	sed -e 's@__ROOT__@$(ROOT)@g' \
+	    -e 's@__HTTP_PORT__@$(HTTP_PORT)@g' > $@
+
+
+serve-cgiwrap: cgiwrap-fcgi.pl
+	perl $<
+
+
+cgiwrap-fcgi.pl: cgiwrap-fcgi.pl.in
+	cat $< | sed -e 's@__ROOT__@$(ROOT)@g' > $@
+
+
+.PHONY: serve-nginx serve-lighttpd serve-cgiwrap

PracticingPerl/web/cgiwrap-fcgi.pl.in

@@ -0,0 +1,155 @@
+#!/usr/bin/env perl
+
+use FCGI;
+use Socket;
+use FCGI::ProcManager;
+sub shutdown { FCGI::CloseSocket($socket); exit; }
+sub restart  { FCGI::CloseSocket($socket); &main; }
+use sigtrap 'handler', \&shutdown, 'normal-signals';
+use sigtrap 'handler', \&restart,  'HUP';
+require 'syscall.ph';
+use POSIX qw(setsid);
+ 
+END()   { }
+BEGIN() { }
+{
+  no warnings;
+  *CORE::GLOBAL::exit = sub { die "fakeexit\nrc=" . shift() . "\n"; };
+};
+ 
+eval q{exit};
+if ($@) {
+  exit unless $@ =~ /^fakeexit/;
+}
+&main;
+ 
+sub daemonize() {
+  chdir '/' or die "Can't chdir to /: $!";
+  defined( my $pid = fork ) or die "Can't fork: $!";
+  exit if $pid;
+  setsid() or die "Can't start a new session: $!";
+  umask 0;
+}
+ 
+sub main {
+  $proc_manager = FCGI::ProcManager->new( {n_processes => 5} );
+  $socket = FCGI::OpenSocket("__ROOT__/nginx-cgiwrap-dispatch.sock", 10 )
+  ; #use UNIX sockets - user running this script must have w access to the 'nginx' folder!!
+  $request =
+  FCGI::Request( \*STDIN, \*STDOUT, \*STDERR, \%req_params, $socket,
+  &FCGI::FAIL_ACCEPT_ON_INTR );
+  $proc_manager->pm_manage();
+  if ($request) { request_loop() }
+  FCGI::CloseSocket($socket);
+}
+ 
+sub request_loop {
+  while ( $request->Accept() >= 0 ) {
+    $proc_manager->pm_pre_dispatch();
+ 
+    #processing any STDIN input from WebServer (for CGI-POST actions)
+    $stdin_passthrough = '';
+    { no warnings; $req_len = 0 + $req_params{'CONTENT_LENGTH'}; };
+    if ( ( $req_params{'REQUEST_METHOD'} eq 'POST' ) && ( $req_len != 0 ) ) {
+      my $bytes_read = 0;
+      while ( $bytes_read < $req_len ) {
+        my $data = '';
+        my $bytes = read( STDIN, $data, ( $req_len - $bytes_read ) );
+        last if ( $bytes == 0 || !defined($bytes) );
+        $stdin_passthrough .= $data;
+        $bytes_read += $bytes;
+      }
+    }
+ 
+    #running the cgi app
+    if (
+      ( -x $req_params{SCRIPT_FILENAME} ) &&    #can I execute this?
+      ( -s $req_params{SCRIPT_FILENAME} ) &&    #Is this file empty?
+      ( -r $req_params{SCRIPT_FILENAME} )       #can I read this file?
+    ) {
+      pipe( CHILD_RD,   PARENT_WR );
+      pipe( PARENT_ERR, CHILD_ERR );
+      my $pid = open( CHILD_O, "-|" );
+      unless ( defined($pid) ) {
+        print("Content-type: text/plain\r\n\r\n");
+        print "Error: CGI app returned no output - Executing $req_params{SCRIPT_FILENAME} failed !\n";
+        next;
+      }
+      $oldfh = select(PARENT_ERR);
+      $|     = 1;
+      select(CHILD_O);
+      $| = 1;
+      select($oldfh);
+      if ( $pid > 0 ) {
+        close(CHILD_RD);
+        close(CHILD_ERR);
+        print PARENT_WR $stdin_passthrough;
+        close(PARENT_WR);
+        $rin = $rout = $ein = $eout = '';
+        vec( $rin, fileno(CHILD_O),    1 ) = 1;
+        vec( $rin, fileno(PARENT_ERR), 1 ) = 1;
+        $ein    = $rin;
+        $nfound = 0;
+ 
+        while ( $nfound = select( $rout = $rin, undef, $ein = $eout, 10 ) ) {
+          die "$!" unless $nfound != -1;
+          $r1 = vec( $rout, fileno(PARENT_ERR), 1 ) == 1;
+          $r2 = vec( $rout, fileno(CHILD_O),    1 ) == 1;
+          $e1 = vec( $eout, fileno(PARENT_ERR), 1 ) == 1;
+          $e2 = vec( $eout, fileno(CHILD_O),    1 ) == 1;
+ 
+          if ($r1) {
+            while ( $bytes = read( PARENT_ERR, $errbytes, 4096 ) ) {
+              print STDERR $errbytes;
+            }
+            if ($!) {
+              $err = $!;
+              die $!;
+              vec( $rin, fileno(PARENT_ERR), 1 ) = 0
+              unless ( $err == EINTR or $err == EAGAIN );
+            }
+          }
+          if ($r2) {
+            while ( $bytes = read( CHILD_O, $s, 4096 ) ) {
+              print $s;
+            }
+            if ( !defined($bytes) ) {
+              $err = $!;
+              die $!;
+              vec( $rin, fileno(CHILD_O), 1 ) = 0
+              unless ( $err == EINTR or $err == EAGAIN );
+            }
+          }
+          last if ( $e1 || $e2 );
+        }
+        close CHILD_RD;
+        close PARENT_ERR;
+        waitpid( $pid, 0 );
+      } else {
+        foreach $key ( keys %req_params ) {
+          $ENV{$key} = $req_params{$key};
+        }
+ 
+        # cd to the script's local directory
+        if ( $req_params{SCRIPT_FILENAME} =~ /^(.*)\/[^\/] +$/ ) {
+          chdir $1; 
+        }
+        close(PARENT_WR);
+        #close(PARENT_ERR);
+        close(STDIN);
+        close(STDERR);
+ 
+        #fcntl(CHILD_RD, F_DUPFD, 0);
+        syscall( &SYS_dup2, fileno(CHILD_RD),  0 );
+        syscall( &SYS_dup2, fileno(CHILD_ERR), 2 );
+ 
+        #open(STDIN, "<&CHILD_RD");
+        exec( $req_params{SCRIPT_FILENAME} );
+        die("exec failed");
+      }
+    } else {
+      print("Content-type: text/plain\r\n\r\n");
+      print "Error: No such CGI app - $req_params{SCRIPT_FILENAME} may not exist or is not executable by this process.\n";
+    }
+  }
+}

PracticingPerl/web/fastcgi_params

@@ -0,0 +1,19 @@
+fastcgi_param GATEWAY_INTERFACE CGI/1.1;
+fastcgi_param SERVER_SOFTWARE nginx;
+fastcgi_param QUERY_STRING $query_string;
+fastcgi_param REQUEST_METHOD $request_method;
+fastcgi_param CONTENT_TYPE $content_type;
+fastcgi_param CONTENT_LENGTH $content_length;
+fastcgi_param SCRIPT_FILENAME $document_root$fastcgi_script_name;
+fastcgi_param SCRIPT_NAME $fastcgi_script_name;
+fastcgi_param REQUEST_URI $request_uri;
+fastcgi_param DOCUMENT_URI $document_uri;
+fastcgi_param DOCUMENT_ROOT $document_root;
+fastcgi_param SERVER_PROTOCOL $server_protocol;
+fastcgi_param REMOTE_ADDR $remote_addr;
+fastcgi_param REMOTE_PORT $remote_port;
+fastcgi_param SERVER_ADDR $server_addr;
+fastcgi_param SERVER_PORT $server_port;
+fastcgi_param SERVER_NAME $server_name;
+
+# vim:filetype=nginx

PracticingPerl/web/html/cgi-bin/query.cgi

@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use CGI;
+use CGI::Carp qw(carpout fatalsToBrowser);
+
+
+BEGIN {
+    use CGI::Carp qw(carpout);
+    open(LOG, ">>/home/me/tmp/mycgi-log") or
+        die("Unable to open mycgi-log: $!\n");
+    carpout(*LOG);
+}
+
+
+sub main {
+    my $query = CGI->new();
+    print $query->header(-content_type => 'text/plain');
+
+    my $search = $query->param('q');
+
+    if (!$search eq undef) {
+        printf("You searched for: %s\n", $query->escapeHTML($search));
+    } else {
+        printf("Invalid search? You must provide a 'q' argument.\n");
+    }
+}
+
+
+main();
+
+
+1;
+__END__

PracticingPerl/web/html/cgi-bin/test.cgi

@@ -0,0 +1,7 @@
+#!/usr/bin/env perl
+
+printf("Content-Type: text/plain\n\n");
+printf("Hello Test\n");
+
+1;
+__END__

PracticingPerl/web/lib/perl/base.pm

@@ -0,0 +1,38 @@
+package base;
+
+use strict;
+use warnings;
+use nginx;
+
+
+sub handler {
+    my $r = shift();
+
+    $r->send_http_header("text/plain");
+    return OK if $r->header_only();
+
+    $r->print("Hello There!\n");
+    $r->rflush();
+
+    if (-f $r->filename or -d _) {
+        $r->print($r->uri, " exists!\n");
+    } else {
+        $r->print($r->uri, " does not exist!\n");
+    }
+
+    my $directory = '/home/me/tmp';
+    # '/home/me/src/LearningPerl/src/web';
+
+    my $didopen = opendir(DIR, $directory);
+    if ($didopen) {
+        while (my $file = readdir(DIR)) {
+            $r->print("$file\n");
+        }
+
+        closedir(DIR);
+    }
+}
+
+
+1;
+__END__

PracticingPerl/web/lighttpd.conf.in

@@ -0,0 +1,119 @@
+## modules to load
+server.modules = (
+            "mod_alias",
+            "mod_compress",
+            "mod_cgi",
+#           "mod_rewrite",
+#           "mod_redirect",
+#           "mod_usertrack",
+#           "mod_expire",
+#           "mod_flv_streaming",
+#           "mod_evasive"
+)
+
+## a static document-root, for virtual-hosting take look at the
+## server.virtual-* options
+server.document-root = "__ROOT__/html"
+
+## where to upload files to, purged daily.
+server.upload-dirs = ("__ROOT__/lighttpd-uploads")
+
+## where to send error-messages to
+server.errorlog = "__ROOT__/lighttpd-error.log"
+
+## files to check for if .../ is requested
+index-file.names = (
+    "index.php",
+    "index.cgi",
+    "index.py",
+    "index.pl",
+    "index.html",
+    "index.htm",
+    "default.htm",
+    "index.lighttpd.html",
+)
+
+## Use the "Content-Type" extended attribute to obtain mime type if possible
+# mimetype.use-xattr = "enable"
+
+##
+# which extensions should not be handle via static-file transfer
+#
+# .php, .pl, .fcgi are most often handled by mod_fastcgi or mod_cgi
+static-file.exclude-extensions = (".php", ".pl", ".fcgi")
+
+
+cgi.assign = (
+    ".pl" => "/usr/bin/perl",
+    ".php" => "/usr/bin/php-cgi",
+    ".py" => "/usr/bin/python",
+)
+
+
+$HTTP["url"] =~ "^/cgi-bin/" {
+    cgi.assign += ("" => "")
+}
+
+
+
+
+
+######### Options that are good to be but not neccesary to be changed #######
+
+## Use ipv6 only if available. (disabled for while, check #560837)
+#include_shell "/usr/share/lighttpd/use-ipv6.pl"
+
+## bind to port (default: 80)
+server.port = __HTTP_PORT__
+
+## bind to localhost only (default: all interfaces)
+server.bind = "localhost"
+
+## error-handler for status 404
+#server.error-handler-404  = "/error-handler.html"
+#server.error-handler-404  = "/error-handler.php"
+
+## to help the rc.scripts
+server.pid-file = "__ROOT__/lighttpd.pid"
+
+##
+## Format: <errorfile-prefix><status>.html
+## -> ..../status-404.html for 'File not found'
+#server.errorfile-prefix    = "/var/www/"
+
+## virtual directory listings
+dir-listing.encoding = "utf-8"
+server.dir-listing = "enable"
+
+### only root can use these options
+#
+# chroot() to directory (default: no chroot() )
+#server.chroot            = "/"
+
+## change uid to <uid> (default: don't change)
+# server.username            = "www-data"
+
+## change gid to <gid> (default: don't change)
+# server.groupname           = "www-data"
+
+#### compress module
+compress.cache-dir = "__ROOT__/lighttpd-compress/"
+compress.filetype = ("text/plain", "text/html", "application/x-javascript", "text/css")
+
+#### url handling modules (rewrite, redirect, access)
+# url.rewrite                 = ( "^/$"             => "/server-status" )
+# url.redirect                = ( "^/wishlist/(.+)" => "http://www.123.org/$1" )
+
+#### expire module
+# expire.url                  = ( "/buggy/" => "access 2 hours", "/asdhas/" => "access plus 1 seconds 2 minutes")
+
+#### external configuration files
+## mimetype mapping
+include_shell "/usr/share/lighttpd/create-mime.assign.pl"
+
+## load enabled configuration files,
+## read /etc/lighttpd/conf-available/README first
+# include_shell "/usr/share/lighttpd/include-conf-enabled.pl"
+
+
+# vim:filetype=lighttpd

PracticingPerl/web/mime.types

@@ -0,0 +1,71 @@
+
+types {
+    text/html                             html htm shtml;
+    text/css                              css;
+    text/xml                              xml rss;
+    image/gif                             gif;
+    image/jpeg                            jpeg jpg;
+    application/x-javascript              js;
+    application/atom+xml                  atom;
+
+    text/mathml                           mml;
+    text/plain                            txt;
+    text/vnd.sun.j2me.app-descriptor      jad;
+    text/vnd.wap.wml                      wml;
+    text/x-component                      htc;
+
+    image/png                             png;
+    image/tiff                            tif tiff;
+    image/vnd.wap.wbmp                    wbmp;
+    image/x-icon                          ico;
+    image/x-jng                           jng;
+    image/x-ms-bmp                        bmp;
+    image/svg+xml                         svg svgz;
+
+    application/java-archive              jar war ear;
+    application/mac-binhex40              hqx;
+    application/msword                    doc;
+    application/pdf                       pdf;
+    application/postscript                ps eps ai;
+    application/rtf                       rtf;
+    application/vnd.ms-excel              xls;
+    application/vnd.ms-powerpoint         ppt;
+    application/vnd.wap.wmlc              wmlc;
+    application/vnd.wap.xhtml+xml         xhtml;
+    application/x-7z-compressed           7z;
+    application/x-cocoa                   cco;
+    application/x-java-archive-diff       jardiff;
+    application/x-java-jnlp-file          jnlp;
+    application/x-makeself                run;
+    application/x-perl                    pl pm;
+    application/x-pilot                   prc pdb;
+    application/x-rar-compressed          rar;
+    application/x-redhat-package-manager  rpm;
+    application/x-sea                     sea;
+    application/x-shockwave-flash         swf;
+    application/x-stuffit                 sit;
+    application/x-tcl                     tcl tk;
+    application/x-x509-ca-cert            der pem crt;
+    application/x-xpinstall               xpi;
+    application/zip                       zip;
+
+    application/octet-stream              bin exe dll;
+    application/octet-stream              deb;
+    application/octet-stream              dmg;
+    application/octet-stream              eot;
+    application/octet-stream              iso img;
+    application/octet-stream              msi msp msm;
+
+    audio/midi                            mid midi kar;
+    audio/mpeg                            mp3;
+    audio/x-realaudio                     ra;
+
+    video/3gpp                            3gpp 3gp;
+    video/mpeg                            mpeg mpg;
+    video/quicktime                       mov;
+    video/x-flv                           flv;
+    video/x-mng                           mng;
+    video/x-ms-asf                        asx asf;
+    video/x-ms-wmv                        wmv;
+    video/x-msvideo                       avi;
+}

PracticingPerl/web/nginx.conf.in

@@ -0,0 +1,63 @@
+worker_processes 1;
+error_log __ROOT__/error.log;
+pid __ROOT__/server.pid;
+daemon off;
+ 
+
+events {
+    worker_connections 4096;
+}
+
+ 
+http {
+    include __ROOT__/mime.types;
+
+    perl_modules __ROOT__/lib/perl;
+    include __ROOT__/perl_requirements.d/*;
+    
+    default_type application/octet-stream;
+    log_format main '$remote_addr - $remote_user [$time_local] $status '
+        '"$request" $body_bytes_sent "$http_referer" '
+        '"$http_user_agent" "$http_x_forwarded_for"';
+    sendfile on;
+    tcp_nopush on;
+    autoindex on;
+
+    server {
+        root __ROOT__/html;
+        index index.html;
+
+        listen __HTTP_PORT__;
+        server_name localhost;
+        access_log __ROOT__/access.log main;
+
+        include __ROOT__/perl_locations.d/*;
+
+        location ~ ^/cgi-bin/.*\.cgi$ {
+            gzip off;
+            fastcgi_pass  unix:__ROOT__/nginx-cgiwrap-dispatch.sock;
+            fastcgi_index index.cgi;
+            fastcgi_param SCRIPT_FILENAME __ROOT__/html$fastcgi_script_name;
+            fastcgi_param QUERY_STRING $query_string;
+            fastcgi_param REQUEST_METHOD $request_method;
+            fastcgi_param CONTENT_TYPE $content_type;
+            fastcgi_param CONTENT_LENGTH $content_length;
+            fastcgi_param GATEWAY_INTERFACE CGI/1.1;
+            fastcgi_param SERVER_SOFTWARE nginx;
+            fastcgi_param SCRIPT_NAME $fastcgi_script_name;
+            fastcgi_param REQUEST_URI $request_uri;
+            fastcgi_param DOCUMENT_URI $document_uri;
+            fastcgi_param DOCUMENT_ROOT $document_root;
+            fastcgi_param SERVER_PROTOCOL $server_protocol;
+            fastcgi_param REMOTE_ADDR $remote_addr;
+            fastcgi_param REMOTE_PORT $remote_port;
+            fastcgi_param SERVER_ADDR $server_addr;
+            fastcgi_param SERVER_PORT $server_port;
+            fastcgi_param SERVER_NAME $server_name;
+        }
+    }
+
+}
+
+
+# vim:filetype=nginx

PracticingPerl/web/perl_locations.d/base.conf

@@ -0,0 +1,5 @@
+location /embedded {
+    perl base::handler;
+}
+
+# vim:filetype=nginx

PracticingPerl/web/perl_requirements.d/base.conf

@@ -0,0 +1 @@
+perl_require base.pm;