-------------------------
use Tie::File;

 tie my @csv_lines, 'Tie::File', 'wielki_plik.csv'
     or die "Nie mona otworzy wielki_plik.csv: !$\n";
-------------------------
for my $i ( 0 .. $#csv_lines )
 {
     next unless my ($op, $num) = $csv_lines[ $i ] =~ /^(\w+):(\d+)/;
     next unless my $op_sub     = _ _PACKAGE_ _->can( 'op_' . $op );

     my $start                  = $i - $num;
     my $end                    = $i - 1;
     my @lines                  = @csv_lines[ $start .. $end ];
     my @newlines               = $op_sub->( @lines );

     splice @csv_lines, $start, $num + 1, @newlines;
 }
-------------------------
 #~/usr/bin/perl
 use strict;
 use warnings;

 use Time::HiRes 'sleep';

 local $| = 1;

 for ( 1 .. 10000 )
 {
     my $status = $_ % 10 ? 'up' : 'down';
     print "$status\n";
     sleep( 0.1 );
 }
-------------------------
$ perl write_fake_log.pl > status.log &
-------------------------
 use File::ReadBackwards;

 my $bw = File::ReadBackwards->new( 'status.log' )
     or die "Nie mog odczyta 'status.log': $!\n";

 exit( 0 ) if $bw->readline(  ) =~ /up/;

 # panic(  ) ...
-------------------------
 use Spreadsheet::Read;

 my $ref  = ReadData( 'test.xls' );
 my $fval = $ref->[1]{A3};
 my $uval = $ref->[1]{cell}[1][3];
-------------------------
 my $ref = ReadData( 'test.xls' );

 # lub
 my $ref = ReadData( 'test.sxc' );

 # lub
 my $ref = ReadData( 'test.csv' );
-------------------------
# Pobierz kolumn "B"
 my @colB = @{ $ref->[1]{cell}[2] };
 shift @colB;
-------------------------
my @colB = @{$ref->[1]{cell}[2]}[1..$#{$ref->[1]{cell}[2]}];
-------------------------
# Pobierz wiersz 4
my @row4 = map { $ref->[1]{cell}[$_][4] } 1..$ref->[1]{maxcol};
-------------------------
 use Spreadsheet::Read qw( rows );

 # Pobierz wszystkie dane z uporzdkowanej wierszami listy 
 my @rows = rows( $ref->[1] );

 # A3 jest teraz w $rows[2][0]
-------------------------
 use Spreadsheet::Read;

 my $file        = 'test.xls';
 my $spreadsheet = ReadData( $file )         or die "Nie mona odczyta pliku $file\n";
 my $sheet_count = $spreadsheet->[0]{sheets} or die "Brak arkuszy w pliku $file\n";

 for my $sheet_index (1 .. $sheet_count)
 {
     # Pomijamy puste arkusze kalkulacyjne
     my $sheet = $spreadsheet->[$sheet_index] or next;

     printf( "%s - %02d: [ %-12s ] %3d Cols, %5d Rows\n", $file,
         $sheet_index, $sheet->{label}, $sheet->{maxcol}, $sheet->{maxrow} );

     for my $row ( 1 .. $sheet->{maxrow} )
     {
         print join "\t" => map {
         $sheet->{cell}[$_][$row] // "-" } 1 .. $sheet->{maxcol};
         print "\n";
     }
 }
-------------------------
test.xls - 01: [ Sheet1       ]   4 Cols,     4 Rows
 A1      B1      -       D1
 A2      B2      -       -
 A3      -       C3      D3
 A4      B4      C4      -
 test.xls - 02: [ Second Sheet ]   5 Cols,     3 Rows
 x       -       x       -       x
 -       x       -       x
 x               x               x
-------------------------
print join "\t" => map
 {
     my $val = $sheet->{cell}[$_][$row];
     defined $val ? $val : "-";
 } 1 .. $sheet->{maxcol};
-------------------------
sub install_nodemethods
 {
     my $dbh = shift;

     my $sth = $dbh->prepare(<<'END_SQL');
 SELECT
     types.title AS class, methods.title AS method, nodemethod.code AS code
 FROM
     nodemethod
 LEFT JOIN
     node AS types ON types.node_id = nodemethod.supports_nodetype
 END_SQL

     $sth->execute(  );

     # ... zrb co z danymi
 }
-------------------------
package Masa::Kodu::SQL;

 use base 'Exporter';
 use vars '@EXPORT';

 @EXPORT = 'select_nodemethod_attributes';

 sub select_nodemethod_attributes (  )
 {
     return <<'END_SQL';
     SELECT
         types.title     AS class,
         methods.title   AS method,
         nodemethod.code AS code
     FROM
         nodemethod
     LEFT JOIN
         node AS types ON types.node_id = nodemethod.supports_nodetype
     END_SQL
 }
-------------------------
use Masa::Kodu::SQL;

 sub install_nodemethods
 {
     my $dbh = shift;

     my $sth = $dbh->prepare( select_nodemethod_attributes(  ) );
     $sth->execute(  );

     # ... zrb co z danymi
 }
-------------------------
package Masa::Kodu::SQL;

 use base 'Exporter';
 use vars qw( @EXPORT_OK %EXPORT_TAGS );

 @EXPORT_OK = qw(
     select_user    insert_user    update_user
     select_story   insert_story   update_story
     select_comment insert_comment
     select_stories
     select_user_stories
     select_user_comments
 );

 %EXPORT_TAGS = (
     user    =>
     [ qw(
         select_user insert_user update_user select_user_stories
         select_user_comments
     )],
     story   =>
     [ qw(
         select_story insert_story update_story select_user_stories
         select_stories
     )],
     comment => [ qw( select_comment insert_comment select_user_comments )],
 );
-------------------------
 [select_nodemethod_attributes]
 SELECT    types.title     AS class,
           methods.title   AS method,
           nodemethod.code AS code
 FROM      nodemethod
 LEFT JOIN node            AS types
 ON        types.node_id = nodemethod.supports_nodetype
-------------------------
 use SQL::Library;

 my $library = SQL::Library->new({ lib => 'nodemethods.sql' });
-------------------------
my $sth = $dbh->prepare( $library->retr( 'select_nodemethod_attributes' ) );
-------------------------
use SQL::Library;

 my $library = SQL::Library->new({ lib => 'daily_reports.sql' });

 for my $query ( $library->elements(  ) )
 {
     my $sth = $dbh->prepare( $query );
     my %columns;

     $sth->bind_columns( \@columns{ @{ $sth->{NAME_lc} } } );
     $sth->execute(  );

     process_report( \%columns );
 }
-------------------------
use SQL::Abstract;

 sub get_select_sth
 {
     my ($self, $table, $columns, $where) = @_;

     my $sql           = SQL::Abstract->new(  );
     my ($stmt, @bins) = $sql->select( $table, $columns, $where );
     my $sth           = $self->get_dbh(  )->prepare( $stmt );

     $sth->execute(  );
     return $sth;
 }
-------------------------
 my $table   = 'users';
 my $columns = [qw( login_name last_accessed_on email_address )];
 my $where   = { signup_date => { '>=', '20050101' } };
 my $sth     = $model->get_select_sth( $table, $columns, $where );
-------------------------
sub restrict_columns
 {
     my ($self, $user, $table, $columns) = @_;
     my $user_columns                    = $user->get_columns_for( $table );
     return [ grep { exists $user_columns->{ $_ } } ] @$columns;
 }
-------------------------
sub bind_hash
 {
     my ($dbh, $hash_ref, $table, @fields) = @_;

     my $sql = 'SELECT ' . join(', ', @fields) . " FROM $table";
     my $sth = $dbh->prepare( $sql );

     $sth->execute(  );
     $sth->bind_columns( \@$hash_ref{ @{ $sth->{NAME_lc} } } );

     return sub { $sth->fetch(  ) };
 }
-------------------------
# zakadamy, e poczylimy si ju z uchwytem bazy $dbh 

 my %user;

 my $user_fetch = bind_hash( $dbh, \%user, qw( users name dob shoe_size ) );

 while ($user_fetch->(  ))
 {
     print "$user{name}, urodzony $user{dob}, ma numer buta " .
           "$user{shoe_size} \n";
 }
-------------------------
use Net::Netmask;

 sub create_generator
 {
     my @netmasks;

     for my $block (@_)
     {
         push @netmasks, Net::Netmask->new( $block );
     }

     my $nth = 1;

     return sub
     {
         return unless @netmasks;
         my $next_ip = $netmasks[0]->nth( $nth++ );

         if ( $next_ip eq $netmasks[0]->last(  ) )
         {
             shift @netmasks;
             $nth = 1;
         }

         return $next_ip;
     }
 }
-------------------------
my $next_address   = create_generator( '192.168.1.0/8', '10.0.0.0/16' );

while (my $address = $next_address->(  ))
{
    # prbujemy skomunikowa si z komputerem o adresie $address
}
-------------------------
sub counter
 {
     my ($from, $to, $step)  = @_;
     $step                 ||= 1;

     return sub
     {
         return if $from > $to;
         my $value       = $from;
         $from          += $step;
         return $value;
     };

 }
-------------------------
 my $counter = counter( 1, 10, 3 );
 my $first   = $counter->(  );
-------------------------
my ($first, $second, $third) = $iterator->(  );
-------------------------
use Want 'howmany';

 sub multi_iterator
 {
     my ($iterator) = @_;

     return sub
     {
         my $context = wantarray(  );

         return               unless defined $context;
         return $iterator->(  ) unless         $context;
         return map { $iterator->(  ) } 1 .. howmany(  );
     };
 }
-------------------------
 my $counter          = counter( 1, 10, 3 );
 my $iterator         = multi_iterator( $counter );

 # wiele zmiennych, kontekst listy
 my ($first, $second) = $iterator->(  );

 # kontekst void (bez argumentw)
 $iterator->(  );

 # pojedyncza zmienna, kontekst skalarny
 my $third            = $iterator->(  );

 # pojedyncza zmienna, kontekst listy 
 my ($fourth)         = $iterator->(  );
-------------------------



