-------------------------
$ perl -wc co_jest_nie_tak.pl
-------------------------
while (<$file_list>)
 {
     warn "Przetwarzam $_";
     next unless -e $_;
     process_file( $_ );
 }
-------------------------
while (<$file_list>)
 {
     warn "Przetwarzam '$_'";
     next unless -e $_;
     process_file( $_ );
 }
-------------------------
while (<$file_list>)
 {
     chomp;
     next unless -e $_;
     process_file( $_ );
 }
-------------------------
 my @ranked;

 for my $rank ( 1 .. 10 )
 {
     $ranked[$rank] = pobierz_gracza_wg_rankingu( $rank );
 }
-------------------------
 for my $rank ( 1 .. 10 )
 {
     $ranked[$rank] = pobierz_gracza_wg_rankingu( $rank );
 }

 warn "Ranking: [@ranked]\n";
-------------------------
local $" = '] [';
warn "Ranking: [@ranked]\n";
-------------------------
 my $user = User->load( id => 54272 );
 warn Dump( $user );
-------------------------
 my @elements =
 (
     [ 2, 2 ], [ 2, 1 ], [ 2, 0 ],
     [ 1, 0 ], [ 1, 1 ], [ 1, 2 ],
 );

 my @sorted   = sort { $a->[0] <=> $b->[0] } @elements;

 local $"     = ', ';
 print "[ @$_ ]\n" for @sorted;
-------------------------
 [ 1, 0 ]
 [ 1, 1 ]
 [ 1, 2 ]
 [ 2, 2 ]
 [ 2, 1 ]
 [ 2, 0 ]
-------------------------
 use Test::More tests => 4;

 my @elements =
 (
     [ 2, 2 ], [ 2, 1 ], [ 2, 0 ],
     [ 1, 0 ], [ 1, 1 ], [ 1, 2 ],
 );
 my @sorted   = sort { $a->[0] <=> $b->[0] } @elements;

 is( $sorted[0][0], 1, 'sortowanie liczb powinno umieszcza 1 przed 2'     );
 is( $sorted[0][1], 0, '... zachowuje stabilno wzldem oryginalnej listy' );
 is( $sorted[2][1], 2, '... dla wszystkich elementw'               );
 is( $sorted[3][1], 2, '... elementy nie s sortowane przypadkowo'      );
-------------------------
 my $call       = "26, 17, 22, but!";
 my @play_calls = split /\s*,?\s*/, $call;
-------------------------
 # niech '###' oznacza inteligentne komentarze... 
 use Smart::Comments;

 my $call       = "26, 17, 22, but!";

 ### $call

 my @play_calls = split /\s*,?\s*/, $call;

 ### @play_calls
-------------------------
$ perl play_book.pl

 ### $call: '26, 17, 22, but!'

 ### @play_calls: [
 ###                '2',
 ###                '6',
 ###                '1',
 ###                '7',
 ###                '2',
 ###                '2',
 ###                'b',
 ###                'u',
 ###                't',
 ###                '!'
 ###              ]

 $
-------------------------
 use Smart::Comments;

 my $call       = "26, 17, 22, but!";

 ### dane: $call

 my @play_calls = split /\s*,?\s*/, $call;

 ### rozbite na: @play_calls
-------------------------
 $ perl play_book.pl

 ### dane: '26, 17, 22, hut!'

 ### rozbite na: [
 ###             '2',
 ###             '6',
 ###             '1',
 ###             '7',
 ###             '2',
 ###             '2',
 ###             'h',
 ###             'u',
 ###             't',
 ###             '!'
 ###           ]

 $
-------------------------
 use Smart::Comments;

 my $call       = "26, 17, 22, but!";

 my @play_calls = split /\s*,?\s*/, $call;

 #### wymagane: @play_calls =  = 4
-------------------------
 $ perl play_book_with_assertion.pl

 ### @play_calls =  = 4 was not true at play_book_with_assertion.pl line 7.
 ###     @play_calls was: [
 ###                        '2',
 ###                        '6',
 ###                        '1',
 ###                        '7',
 ###                        '2',
 ###                        '2',
 ###                        'b',
 ###                        'u',
 ###                        't',
 ###                        '!'
 ###                      ]

 $
-------------------------
 # use Smart::Comments;

 my $call       = "26, 17, 22, but!";

 ### dane: $call

 my @play_calls = split /\s*,?\s*/, $call;

 ### rozbite na: @play_calls
-------------------------
 $ perl play_book.pl

 $
-------------------------
 use Smart::Comments '####';   # Tylko komentarze ####... s "inteligentne"
                               # Wszelkie komentarze ###... s ignorowane

 my $call       = "26, 17, 22, but!";

 ### $call

 my @play_calls = split /\s*,?\s*/, $call;

 ### @play_calls

 #### require: @play_calls =  = 4
-------------------------
$ perl -MSmart::Comments split_test.pl
-------------------------
$ perl -MSmart::Comments="" split_test.pl
-------------------------
package SourceCarp;

 use strict;
 use warnings;

 sub import
 {
     my ($class, %args) = @_;

     $SIG{_ _DIE_ _}  = sub { report( shift, 2 ); exit } if $args{fatal};
     $SIG{_ _WARN_ _} = \&report                         if $args{warnings};
 }

 sub report
 {
     my ($message, $level)  = @_;
     $level               ||= 1;
     my ($filename, $line)  = ( caller( $level - 1 ) )[1, 2];
     warn $message, show_source( $filename, $line );
 }

 sub show_source
 {
     my ($filename, $line) = @_;
     return '' unless open( my $fh, $filename );

     my $start = $line - 2;
     my $end   = $line + 2;

     local $.;
     my @text;
     while (<$fh>)
     {
         next unless $. >= $start;
         last if     $. >  $end;
         my $highlight   = $. =  = $line ? '*' : ' ';
         push @text, sprintf( "%s%04d: %s", $highlight, $., $_ );
     }

     return join( '', @text, "\n" );
 }

 1;
-------------------------
#!/usr/bin/perl

 use strict;
 use warnings;

 use lib 'lib';
 use SourceCarp fatal => 1, warnings => 1;

 # zwracamy ostrzeenie
 open my $fh, '<', '/no/file';
 print {$fh}...

 # raportujemy z procedury
 report_with_level(  );

 sub report_with_level
 {
     SourceCarp::report( "raportuj kod przywoujcy, nie siebie\n", 2 );
 }

 # zwracamy bd
 die "Oops!";
-------------------------
sub filter
 {
     my ($filter) = @_;

     if ('Regexp' eq ref $filter)
     {
         return sub
         {
             my $fh = shift;
             return grep { /$filter/ } <$fh>;
         };
     }
     else
     {
         return sub
         {
             my $fh = shift;
             return grep { 0 <= index $_, $filter } <$fh>;
         };
     }	
 }
-------------------------
 my $filter = filter(/\d/);
 my @lines  = $filter->($file_handle);
-------------------------
 use Data::Dumper;
 print Dumper( $filter );
-------------------------
$VAR1 = sub { "DUMMY" };
-------------------------
 use Data::Dump::Streamer;
 Dump( $filter );
-------------------------
 my ($filter);
 $filter = undef;
 $CODE1 = sub {
            my $fh = shift @_;
            return grep({0 <= index($_, $filter);} <$fh>);
          };
-------------------------
 my $filter = filter(qr /\d/);
 my @lines  = $filter->($file_handle);
-------------------------
 use B::Deparse;
 my $deparse = B::Deparse->new(  );
 print $deparse->coderef2text($filter);
-------------------------
{
     my $fh = shift @_;
     return grep({0 <= index($_, $filter);} <$fh>);
 }
-------------------------
Denominator must not be zero! at anon_subs.pl line 11
       main::_ _ANON_ _(0) called at anon_subs.pl line 17
-------------------------
use Carp;

 sub divide_by
 {
     my $numerator = shift;
     return sub
     {
         my $denominator = shift;
         croak "Mianownik uamka musi by rny od zera!" unless $denominator;
         return $numerator / $denominator;
     };
 }

 my $seven_divided_by = divide_by(7);
 my $answer           = $seven_divided_by->(0);
-------------------------
sub divide_by
 {
     my $numerator = shift;
     my $name      = (caller(0))[3];
     return sub
     {
         local *_ _ANON_ _ = "_ _ANON_ _$name";
         my $denominator = shift;
         croak "Mianownik uamka musi by rny od zera!" unless $denominator;
         return $numerator / $denominator;
     };
 }
-------------------------
Mianownik uamka musi by rny od zera! at anon_subs.pl line 12
       _ _ANON_ _main::divide_by(0) called at anon_subs.pl line 18
-------------------------
use Carp;

 sub divide_by
 {
     my ($name, $numerator) = @_;
     return sub
     {
         local *_ _ANON_ _ = "_ _ANON_ _$name";
         my $denominator = shift;
         croak "Mianownik uamka musi by rny od zera!" unless $denominator;
         return $numerator / $denominator;
     };
 }

 my $three_divided_by = divide_by( 'divide_by_three', 3 );
 my $answer           = $three_divided_by->(0);
-------------------------
Mianownik uamka musi by rny od zera! at anon_subs.pl line 12
       _ _ANON_ _main::divide_by_three(0) called at anon_subs.pl line 18
-------------------------
my $old_p;
BEGIN { $old_p = $^P; $^P &= ~0x200; }

sub divide_by
{
     # ...
}

BEGIN { $^P = $old_p; }
-------------------------
package My::Package;

 use Sub::Identify ':all';
 use HTML::Entities 'encode_entities';
 print stash_name( \&encode_entities );
-------------------------
package Devel::Command::HelloWorld;
 use base 'Devel::Command';

 sub command
 {
     print DB::OUT "Hello world! - Witam wszystkich!\n";
     1;
 }

 1;
-------------------------
flatbox ~ $ perl -de0
 Default die handler restored.
 Patching with Devel::Command::DBSub::DB_5_8

 Loading DB routines from perl5db.pl version 1.07
 Editor support available.

 Enter h or 'h h' for help, or 'man perldebug' for more help.

 main::(-e:1):    0
   DB<1> cmds
 cmds
 helloworld
   DB<2> helloworld
 Hello world! - Witam Wszystkich!
   DB<3> q
 flatbox ~ $
-------------------------
 package Devel::Command::X;

 use base 'Devel::Command';

 sub command
 {
     my ($cmd) = @_;

     if ($cmd  =~ /x marks/)
     {
         print DB::OUT "Arrrrr....\n";
         return 1;
     }
     else
     {
         return 0;
     }
 }

 1;
-------------------------
 flatbox ~ $ perl -de0
 Default die handler restored.
 Patching with Devel::Command::DBSub::DB_5_8

 Loading DB routines from perl5db.pl version 1.07
 Editor support available.

 Enter h or 'h h' for help, or 'man perldebug' for more help.

 main::(-e:1):    0
   DB<1> $x = [1,2,3]

   DB<2> x $x
 0  ARRAY(0x804e2f4)
    0  1
    1  2
    2  3
   DB<3> x marks the spot
 Arrrrr....
   DB<4> q
 flatbox ~ $
-------------------------
use Devel::Command;
-------------------------
 flatbox ~ $ perl5.8.5 -de0
 Patching with Devel::Command::DBSub::DB_5_8_5

 Loading DB routines from perl5db.pl version 1.27
 Editor support available.

 Enter h or 'h h' for help, or 'man perldebug' for more help.

 main::(-e:1):    0
   DB<1> use WWW::Mechanize

   DB<2> $m = WWW::Mechanize->new(  )

   DB<3> viz $m
-------------------------

