Perl simple intro

#Материалы к курсу Основы языка Perl. Примеры кода.
----------------------------------------------------------------------------
    #Общая структура программы, комментарии, переводы строк, quoting (" vs ')
        #!/usr/bin/perl
        use strict;
         
        use warnings;
         
        print "Hello, world";
         
        # This is a comment
         
        print
         
          "Hello, world"
             ;
         
        # this would print with a linebreak in the middle
        print "Hello
        world";
         
        print "Hello, $name\n";     # works fine
        print 'Hello, $name\n';     # prints $name\n literally
         
        print("Hello, world\n");
         
        print "Hello, world\n";
--------------------------------------------------------------------------         
    #Скаляры
        my $animal = "camel";
        my $answer = 42;
         
        print $animal;
        print "The animal is $animal\n";
        print "The square of $answer is ", $answer * $answer, "\n";
--------------------------------------------------------------------------         
    #Массивы. Скалярный и списочный контекст.
        my @animals = ("camel", "llama", "owl");
        my @numbers = (23, 42, 69);
        my @mixed   = ("camel", 42, 1.23);
         
        print $animals[0];              # prints "camel"
        print $animals[1];              # prints "llama"
         
        print $mixed[$#mixed];       # last element, prints 1.23
         
        if (@animals < 5) { ... }
         
        @animals[0,1];                  # gives ("camel", "llama");
        @animals[0..2];                 # gives ("camel", "llama", "owl");
        @animals[1..$#animals];         # gives all except the first element
         
        my @sorted    = sort @animals;
        my @backwards = reverse @numbers;
---------------------------------------------------------------------------         
    #Хеши
        my %fruit_color = ("apple", "red", "banana", "yellow");
         
        my %fruit_color = (
                        apple  => "red",
                        banana => "yellow",
                        );
         
        $fruit_color{"apple"};           # gives "red"
         
        my @fruits = keys %fruit_colors;
        my @colors = values %fruit_colors;
  ---------------------------------------------------------------------------       
    #Вложенные структуры. Создание ссылки на хеш и ссылки на массив. Операторы => и ->.
        my $variables = {
                scalar  =>  {
                        description => "single item",
                        sigil => '$',
                },
                array   =>  {
                        description => "ordered list of items",
                        sigil => '@',
                },
                hash    =>  {
                        description => "key/value pairs",
                        sigil => '%',
                },
        };
         
        print "Scalars begin with a $variables->{'scalar'}->{'sigil'}\n";
 ----------------------------------------------------------------------------        
    #Слайсы массивов. Оператор .. в списочном контексте.
        for (101 .. 200) { print; } # print $_ 100 times
        @foo = @foo[0 .. $#foo];    # an expensive no-op
        @foo = @foo[$#foo-4 .. $#foo];      # slice last 5 items
         
        @alphabet = ('A' .. 'Z');
         
        $hexdigit = (0 .. 9, 'a' .. 'f')[$num & 15];
         
        @z2 = ('01' .. '31');  print $z2[$mday];
 ------------------------------------------------------------------------------        
    #Условные выражения. Префиксная и постфиксная формы.
        if ( condition ) {
                ...
        } elsif ( other condition ) {
                ...
        } else {
                ...
        }
        unless ( condition ) {
                ...
        }
         
        # the traditional way
        if ($zippy) {
                print "Yow!";
        }
         
        # the Perlish post-condition way
        print "Yow!" if $zippy;
        print "We have no bananas" unless $bananas;
----------------------------------------------------------------------------         
    #Примеры циклов.
        while ( condition ) {
                ...
        }
        until ( condition ) {
                ...
        }
        for ($i = 0; $i <= $max; $i++) {
                ...
        }
        foreach (@array) {
                print "This element is $_\n";
        }
         
        print $list[$_] foreach 0 .. $max;
         
        # you don't have to use the default $_ either...
        foreach my $key (keys %hash) {
                print "The value of $key is $hash{$key}\n";
        }
-----------------------------------------------------------------------         
    #Циклы: redo, next, continue, last.
        while (EXPR) {
        ### redo always comes here
                do_something;
        } continue {
        ### next always comes here
                do_something_else;
        # then back the top to re-check EXPR
        }
        ### last always comes here
  -----------------------------------------------------------------------       
    #Метки, реализация switch, given/when .
        SWITCH: {
                if (/^abc/) { $abc = 1; last SWITCH; }
                if (/^def/) { $def = 1; last SWITCH; }
                if (/^xyz/) { $xyz = 1; last SWITCH; }
                $nothing = 1;
        }
         
        use feature ":5.10";
        given($_) {
                when (/^abc/) { $abc = 1; }
                when (/^def/) { $def = 1; }
                when (/^xyz/) { $xyz = 1; }
                default { $nothing = 1; }
        }
 --------------------------------------------------------------------------        
    #Smart match operation ~~
        use feature ":5.10";
        given($foo) {
                when (undef) {
                        say '$foo is undefined';
                }
         
                when ("foo") {
                        say '$foo is the string "foo"';
                }
         
                when ([1,3,5,7,9]) {
                        say '$foo is an odd digit';
                        continue; # Fall through
                }
         
                when ($_ < 100) {
                        say '$foo is numerically less than 100';
                }
         
                when (\&complicated_check) {
                        say 'complicated_check($foo) is true';
                }
         
                default {
                        die q(I don't know what to do with $foo);
               }
        }
   ----------------------------------------------------------------------      
    #Пользовательские функции. Передача параметров.
        sub logger {
            my $logmessage = shift;
            open my $logfile, ">>", "my.log" or die "Could not open my.log: $!";
            print $logfile $logmessage;
        }
   ---------------------------------------------------------------------      
    #Циклы и условные выражения.
        if (EXPR) BLOCK
        if (EXPR) BLOCK else BLOCK
        if (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK
        LABEL while (EXPR) BLOCK
        LABEL while (EXPR) BLOCK continue BLOCK
        LABEL until (EXPR) BLOCK
        LABEL until (EXPR) BLOCK continue BLOCK
        LABEL for (EXPR; EXPR; EXPR) BLOCK
        LABEL foreach VAR (LIST) BLOCK
        LABEL foreach VAR (LIST) BLOCK continue BLOCK
        LABEL BLOCK continue BLOCK
  ---------------------------------------------------------------------------       
    #Чтение данных
        LINE: while (<STDIN>) {
            next LINE if /^#/;      # discard comments
            ...
        }
         
         
        LINE: while (<STDIN>) {
            last LINE if /^$/;      # exit when done with header
            ...
        }
    #Poor man's grep
        # poor man's grep
        $arg = shift;
        while (<>) {
            print if /$arg/o;       # compile only once
        }
  ----------------------------------------------------------------------------       
    #Читаем файлы в которых \ в конце строки является переносом
        while (<>) {
            chomp;
            if (s/\\$//) {
                $_ .= <>;
                redo unless eof();
            }
            # now process $_
        }
         
        # the same:
         
        LINE: while (defined($line = )) {
            chomp($line);
            if ($line =~ s/\\$//) {
                  $line .= ;
                  redo LINE unless eof(); # not eof(ARGV)!
            }
            # now process $line
        }
 -------------------------------------------------------------------------------        
    #split/join/reverse
        #!/usr/bin/perl
         
        use strict;
        use warnings;
         
        use feature qw(say);
         
        my $a = "1234567890";
         
        say join "#", reverse split "", $a;
         
        # Prints: 0#9#8#7#6#5#4#3#2#1
         
        say join("#", reverse(split("", $a)));
  ----------------------------------------------------------------------------       
        # the same
    #map/grep
        #!/usr/bin/perl
         
        use strict;
        use warnings;
         
        use feature qw(say);
         
        my $a = "1234567890";
         
        say join "#", reverse grep { $_ % 3 == 1 } split "", $a;
        # Prints: 7#4#1
         
        $, = "#";
        say reverse grep { $_ % 3 == 1 } split "", $a;
        # The same
         
        say map { $_ * 7 } grep { $_ % 3 == 1 } split "", $a;
        # Prints: 7#28#49
         
  ---------------------------------------------------------------------------       
    #map/foreach
        #!/usr/bin/perl
         
        use strict;
        use warnings;
         
        use feature qw(say);
         
        my @aa = (1 .. 99);
         
        my $sum = 0;
        map {
            $sum += $_;
        } @aa;
         
        say $sum;
         
        $sum = 0;
        foreach (@aa) {
            $sum += $_;
        }
         
        say $sum;
    #sort------------------------------------------------------
        #!/usr/bin/perl
         
        use strict;
        use warnings;
         
        use feature qw(say);
         
        my @aa = qw(1 2 3 4 100 101 110 200);
         
        $, = "#";
         
        say @aa;
         
        say sort @aa;
         
        say sort { $a <=> $b } @aa
         
        # 1#2#3#4#100#101#110#200
        # 1#100#101#110#2#200#3#4
        # 1#2#3#4#100#101#110#200
    #Exceptions: die / eval--------------------------------------------------
        #!/usr/bin/perl
         
        use strict;
        use warnings;
         
        use feature qw(say);
         
        my $res = eval {
                die "test1";
        };
         
        say "msg1: $res#$@" ;
         
        eval {
                1/0
        };
        say "msg2: ",$@ ;
         
        eval " this_is_not_a_code ";
        say "msg3: ", $@;
         
        __END__
        Prints:
        Useless use of division (/) in void context at examples/p5.5.pl line 15.
        Use of uninitialized value $res in concatenation (.) or string at examples/p5.5.pl line 12.
        msg1: #test1 at examples/p5.5.pl line 9.
         
        msg2: Illegal division by zero at examples/p5.5.pl line 15.
         
        msg3: Bareword "this_is_not_a_code" not allowed while "strict subs" in use at (eval 1) line 1.
    ------------------------------------------------------------------------------     
         
    #Threading example 1
        #!/usr/bin/perl
         
        use strict;
        use warnings;
         
        use threads;
         
        sub run() {
                my $a = "123456";
                while(1) {
                        my $c;
                        for(my $i = 0; $i < 1_000_000 ; $i++) {
                                $c = $a;
                        }
                        print "Loop finished";
                }
         
        }
         
        my $t1 = threads->create(\&run);
        my $t2 = threads->create(\&run);
        sleep (10);
     ----------------------------------------------------------------------------    
    #Threading example 2
        #!/usr/bin/perl
         
        use strict;
        use warnings;
         
        use threads;
        use threads::shared;
         
        my @queue : shared;
         
        my $counter : shared = 0;
         
        my $done : shared;
         
        sub reader() {
                unless(open(FI, "<", "ac.log")) {
                        warn ("Failed to open log: $!");
                        exit 2;
                }
                while(my $l = <FI>) {
                        {
                                lock @queue;
                                push(@queue, $l);
                                cond_signal(@queue);
                        }
                }
                $done = 1;
                {
                        cond_broadcast(@queue);
                }
        }
         
         
        sub parser() {
                my $local_counter = 0;
                while(not $done) {
                        my $line;
                        {
                                lock @queue;
                                unless (@queue) {
                                        cond_wait(@queue);
                                }
                                $line = pop(@queue);
         
                        }
                        if ($line) {
                                $local_counter += length($line);
                        }
                }
                {
                        lock $counter;
                        $counter += $local_counter;
                        print "THread counted: ", $local_counter,"\n";
                }
         
        }
         
        my $t1 = threads->create(\&reader);
        my $t2 = threads->create(\&parser);
        my $t3 = threads->create(\&parser);
        $t1->join;
        $t2->join;
        $t3->join;
        print $counter,"\n";