advanced perl

arr_in_arr.pl

use strict;
use warnings;
use v5.16;

sub match {
  my ( $needle_ref, $haystack_ref, $idx ) = @_;

  if ( @$needle_ref + $idx > $haystack_ref ) {
    return;
  }

  for ( my $i=0; $i < @$needle_ref; $i++ ) {
    return if $haystack_ref->[$i + $idx] != $needle_ref->[$i];
  }

  return 1;
}


sub array_in_array {
  my ( $needle_ref, $haystack_ref ) = @_;

  for ( my $idx=0; $idx < @$haystack_ref; $idx++ ) {
    if ( match( $needle_ref, $haystack_ref, $idx ) ) {
      return $idx;
    }
  }
  return;
}


my @a = (1, 2, 3);
my @b = (2, 3, 4, 1, 6, 1, 2, 3, 7);
my $idx = array_in_array( \@a, \@b );
# now $idx == 5

print "idx = $idx\n";

Contacts.pm

package Contacts;
use strict;
use warnings;
use v5.16;
sub init {
  my $book_ref = {};
  return $book_ref;
}

sub add_contact {
  my ( $book_ref, $name, $opts_ref ) = @_;
  $book_ref->{$name} = $opts_ref;
}

sub AUTOLOAD {
  my ( $book_ref, $val ) = @_;
  our $AUTOLOAD;

  my ( $name ) = $AUTOLOAD =~ /Contacts::contacts_by_(\w+)/;
  die "Undefined Function $AUTOLOAD" if ! $name;

  grep { $book_ref->{$_}->{$name} eq $val } keys %$book_ref;
}



1;

data.pl

use strict;
use warnings;
use v5.16;
 
my @ppl = (
  { name => 'joe', phone => '052', country => 'il' },
  { name => 'bob', phone => '052', country => 'il' },
  { name => 'jim', phone => '052', country => 'us' },
  { name => 'jane', phone => '052', country => 'us' },
  { name => 'bill', phone => '052', country => 'il' },
  { name => 'george', phone => '052', country => 'uk' },
  { name => 'danny', phone => '052', country => 'il' },
);
 
my @f = grep { $_->{country} eq 'il' } @ppl;
my @g = grep { $_->{name} =~ /^b/ } @ppl;
 
use Data::Dumper;
print "f = ", Dumper(\@f), "\n";
print "g = ", Dumper(\@g), "\n";

dispatch.pl

use strict;
use warnings;
 
sub hi { say "hello" }
sub bye { exit }
sub echo { say "@_" }
 
my %dispatch = (
  hi => \&hi,
  bye => \&bye,
  echo => \&echo,
);
 
while (<>) {
  my ( $cmd, @params ) = split;
  next if ! exists $disptch{$cmd};
 
  $disptch{$cmd}->( @params );
}

find.pl

use strict;
use warnings;
use Cwd;
use v5.16;

use File::Find;

sub handle_file {
  return if -d;
  unlink if ! -s;

  # Inside handle_file you have
  # $_ is the file name
  # $File::Find::name is the full name

  # CWD is also changed
  say "Relative name: $_";
  say "Full name: $File::Find::name";
  say "Current dir: ", getcwd;
  say "---";
}

find( \&handle_file, '/Users/ynonperek/tmp/perl' );

finder.pl

use strict;
use warnings;
use Tk;
use File::Find::Rule;
use v5.16;
use Data::Dumper;

sub find_in_files {
  my ( $text_to_find ) = @_;
  my @results = File::Find::Rule
                  ->file()
                  ->grep(qr/$text_to_find/)
                  ->in('.');
  return @results;
}

my $text_to_find;
my $results_box;

my $w = MainWindow->new;

$w->Label(-text => 'File Finder')->pack;
$w->Entry(-textvar => \$text_to_find)->pack;

$results_box = $w->Listbox();
$results_box->pack;

$w->Button( -text => 'Find',
  -command => sub {
    my @results = find_in_files( $text_to_find );
    $results_box->insert( 'end', @results );
  }


)->pack( -side => 'left' );
$w->Button( -text => 'Exit' )->pack( -side => 'right' );

MainLoop;

Geometry.pm

package My::Geometry;
use strict;
use warnings;

use base 'Exporter';

# our @EXPORT = qw/Dumper/;
our @EXPORT_OK = qw/rectangle_area circle_area/;
our %EXPORT_TAGS = (
  all => [qw/rectangle_area circle_area/],
);

sub rectangle_area {
  my ( $x, $y, $w, $h ) = @_;
  return $w * $h;
}

sub circle_area {
  my ( $r ) = @_;
  return $r * $r * 4 * atan2(1, 1);
}


1;

zombies.pl

use v5.16;

package Zombie;
use Scalar::Util qw/looks_like_number/;

sub new {
  my $self = { size => 2, color => 'blue' };

  bless $self, 'Zombie';
}

sub get_size {
  my ( $self ) = @_;
  return $self->{size};
}

sub set_size {
  my ( $self, $new_value ) = @_;
  die "Invalid size" if ! looks_like_number( $new_value );

  $self->{size} = $new_value;
}



sub meet_person {
  warn 'AKASHKJAHSDJHSDJ I WILL EAT YOUR BRAIN...';
}

sub eat {
  my ( $self, $how_many ) = @_;
  $how_many ||= 1;

  warn '...', $self->{size};
  $self->{siez}++;

  warn 'Yummy...', $self->get_size;
  $self->set_size( $self->get_size() + 1 );
}




package main;

my $bob = Zombie->new;
my $tim = Zombie->new;

$tim->meet_person;

$bob->eat( 7 );
$bob->eat;
$bob->eat;

$tim->eat;
$tim->eat;