Perl course (4), oop - Speaker Deck

Slide 1

Slide 1 text

ООП 1 / 60

Slide 2

Slide 2 text

Термины 2 / 60

Slide 3

Slide 3 text

Объект, метод > a = [5, 3, 7] => [5, 3, 7] > a.length() => 3 > a.max() => 7 3 / 60

Slide 4

Slide 4 text

Класс, конструктор, атрибут class Person(): def __init__(self, name): self.name = name vadim = Person("Vadim") katya = Person("Katya") puts vadim.name # Vadim # def = sub 4 / 60

Slide 5

Slide 5 text

Наследование class Student(Person): def get_name(self): return self.name class Teacher(Person): def get_name(self): return 'Профессор ' + self.name Teacher('Иван').get_name() # Профессор Иван # def = sub 5 / 60

Slide 6

Slide 6 text

package + ref = объект 6 / 60

Slide 7

Slide 7 text

bless { package Package::Name; #... } my $obj = bless {}, 'Package::Name'; my $obj2 = bless [], '...'; my $scalar = 42; my $obj2 = bless \$scalar, '...'; 7 / 60

Slide 8

Slide 8 text

Методы { package Person; sub set_name { my ($self, $name) = @_; $self->{name} = $name; } sub get_name { my ($self) = @_; return $self->{name}; } } my $vadim = bless {}, 'Person'; $vadim->set_name('Vadim'); print $vadim->get_name(); # Vadim 8 / 60

Slide 9

Slide 9 text

Атрибуты? my $obj = bless {name => 42, zzz => 42}, 'Person'; print $obj->{name}; # Vadim print $obj->{zzz}; # 42 sub get_name { my ($self) = @_; return $self->{name}; } 9 / 60

Slide 10

Slide 10 text

Методы класса package Person; sub class_name { my ($class) = @_; return $class; } Person->class_name(); # Person 10 / 60

Slide 11

Slide 11 text

Конструктор? { package Person; sub new { my ($class, $name) = @_; return bless {name => $name}, $class; } sub get_name { my ($self) = @_; return $self->{name}; } } my $vadim = Person->new('Vadim'); print $vadim->get_name(); # Vadim 11 / 60

Slide 12

Slide 12 text

Универсальный конструктор package Object; sub new { my ($class, %params) = @_; my $obj = bless \%params, $class; $obj->init(); return $obj; } sub init { my ($self) = @_; return; } 12 / 60

Slide 13

Slide 13 text

Универсальный конструктор package Person; # Наследуемся от Object sub init { my ($self) = @_; if ($self->{age} < 0) { die "Negative age $self->{age}"; } return; } Person->new(age => 42); 13 / 60

Slide 14

Slide 14 text

Методы — еще варианты my $class = 'A'; $class->new(); my $method_name = $cond ? 'get_a' : 'get_b'; $obj->$method_name; A::new(); # not the same! static? $obj->A::get_a(); # !? 14 / 60

Slide 15

Slide 15 text

Методы — indirect new My::Class(1, 2, 3); My::Class->new(1, 2, 3); foo $obj(123); # $obj->foo(123); use strict; use warnings; Syntax error! exit 0; 15 / 60

Slide 16

Slide 16 text

Методы — WHY!? use strict; use warnings; Syntax error! exit 0; use warnings; use strict; 'error'->Syntax(!exit(0)); 16 / 60

Slide 17

Slide 17 text

can { package A; sub test { return 42; } } if (A->can('test')) { print A->test; } print A->can('test')->('A'); my $obj = bless {}, 'A'; $obj->can('test'); 17 / 60

Slide 18

Slide 18 text

Filehandles open(my $fh, '>', 'path/to/file'); $fh->autoflush(); $fh->print('content'); STDOUT->autoflush(); 18 / 60

Slide 19

Slide 19 text

Пакеты use Some::Package qw(a b c); # Some::Package->import(qw(a b c)); no Some::Package; # Some::Package->unimport; use Some::Package 10.01 # Some::Package->VERSION(10.01); 19 / 60

Slide 20

Slide 20 text

Итого my $vadim = Person->new('Vadim'); print $vadim->get_name(); print $vadim->{name}; $vadim->can('get_name')->(); $fh->print(123); $katya = new Person(); # :( 20 / 60

Slide 21

Slide 21 text

Примеры 21 / 60

Slide 22

Slide 22 text

DBI $dbh = DBI->connect( $data_source, $username, $auth, \%attr ); my $sth = $dbh->prepare('SELECT name FROM city'); $sth->execute(); 22 / 60

Slide 23

Slide 23 text

XML::LibXML; use XML::LibXML; my $document = XML::LibXML->load_xml( string => '...' ); my $list = $document->findnodes('...'); # XML::LibXML::NodeList XML::LibXML::Node / \ XML::LibXML::Document XML::LibXML::Element 23 / 60

Slide 24

Slide 24 text

File::Spec use File::Spec; print File::Spec->catfile('a', 'b', 'c'); 24 / 60

Slide 25

Slide 25 text

JSON use JSON; JSON->new->utf8->decode('...'); decode_json '...'; 25 / 60

Slide 26

Slide 26 text

Наследование 26 / 60

Slide 27

Slide 27 text

Наследование { package IOStream; BEGIN { push(@ISA, 'InStream', 'OutStream') } use base qw(InStream OutStream); use parent qw(InStream OutStream); } 27 / 60

Slide 28

Slide 28 text

UNIVERSAL $teacher->can('get_name'); $teacher->isa('Person'); Teacher->isa('Person'); Teacher->VERSION(5.12); 28 / 60

Slide 29

Slide 29 text

SUPER package Teacher; sub get_name { my ($self, %params) = @_; my $name = $self->SUPER::get_name(%params); return "Уважаемый $name"; } 29 / 60

Slide 30

Slide 30 text

Method Resolution Order 30 / 60

Slide 31

Slide 31 text

Method Resolution Order Object | Stream Cacheable / \ / InStream CacheableOutStream \ / IOStream IOStream->method(); qw( IOStream InStream Stream Object CacheableOutStream Cacheable ); 31 / 60

Slide 32

Slide 32 text

mro Object | Stream Cacheable / \ / InStream CacheableOutStream \ / IOStream use mro 'c3'; IOStream->method(); qw( IOStream InStream CacheableOutStream Stream Object Cacheable ); 32 / 60

Slide 33

Slide 33 text

mro — next::method package Teacher; use mro; sub get_name { my ($self, %params) = @_; my $name = $self->next::method(%params); return "Уважаемый $name"; } 33 / 60

Slide 34

Slide 34 text

Итого @ISA; use base; use parent; UNIVERSAL; SUPER; use mro; use mro 'c3'; $obj->next::method(); 34 / 60

Slide 35

Slide 35 text

MOAR 35 / 60

Slide 36

Slide 36 text

ref , blessed use JSON: use Scalar::Util 'blessed'; ref JSON->new(); # 'JSON' ref []; # 'ARRAY' ref {}; # 'HASH' ref 0; # '' blessed JSON->new(); # 'JSON' blessed []; # undef blessed {}; # undef blessed 0; # undef 36 / 60

Slide 37

Slide 37 text

AUTOLOAD package A; our $AUTOLOAD; sub AUTOLOAD { print $AUTOLOAD } A->new()->test(); # test A->can('anything'); # :( sub UNIVERSAL::AUTOLOAD {} # Dog->m(); Animal->m(); UNIVERSAL->m(); # Dog->AUTOLOAD(); Animal->AUTOLOAD(); # UNIVERSAL->AUTOLOAD(); 37 / 60

Slide 38

Slide 38 text

DESTROY package Teacher; sub DESTROY { my ($self) = @_; $self->_flush_all_grades(); } { my $teacher = Teacher->new(); $teacher->grade($student1, 5); # ... } 38 / 60

Slide 39

Slide 39 text

DESTROY — сложности die local AUTOLOAD ${^GLOBAL_PHASE} eq 'DESTRUCT' sub DESTROY { my ($self) = @_; $self->{handle}->close() if $self->{handle}; } 39 / 60

Slide 40

Slide 40 text

Исключения eval { die Local::Exception->new(); 1; } or do { my $error = $@; if ( blessed($error) && $error->isa('Local::Exception') ) { # ... } else { die $error; } }; 40 / 60

Slide 41

Slide 41 text

Исключения — модули use Try::Tiny; try { die 'foo' } catch { warn "caught error: $_"; } # not $@ use Error qw(:try); try { throw Error::Simple 'Oops!'; } catch Error::Simple with { say 'Simple' } catch Error::IO with { say 'IO' } except { say 'Except' } otherwise { say 'Otherwise' } finally { say 'Finally' }; 41 / 60

Slide 42

Slide 42 text

??? $hash{x} = 7; print $hash{x}; 42 / 60

Slide 43

Slide 43 text

42 43 / 60

Slide 44

Slide 44 text

tie package Local::MyHash; use Tie::Hash; use base 'Tie::StdHash'; sub FETCH { 42 } my %hash; tie %hash, 'Local::MyHash'; $hash{x} = 7; print $hash{x}; 44 / 60

Slide 45

Slide 45 text

overload my $x = Local::Int->new(42); my $y = Local::Int->new(24); print(($x + $y)->{value}); # 66 45 / 60

Slide 46

Slide 46 text

overload package Local::Int; use overload '+' => 'add'; sub new { my ($class, $value) = @_; return bless {value => $value}, $class; } sub add { my ($self, $other) = @_; return __PACKAGE__->new( $self->{value} + $other->{value} ); } 46 / 60

Slide 47

Slide 47 text

Class::Accessor package Foo; use base qw(Class::Accessor); Foo->follow_best_practice; Foo->mk_accessors(qw(name role salary)); use base qw(Class::Accessor::Fast); use base qw(Class::XSAccessor); 47 / 60

Slide 48

Slide 48 text

Итого ref($obj); blessed($obj); A->brr(); { A->new() } die A->new(); $h->{42}; A->new() + A->new(); 48 / 60

Slide 49

Slide 49 text

Moose и его друзья 49 / 60

Slide 50

Slide 50 text

Moose package Person; use Moose; has first_name => ( is => 'rw', isa => 'Str', ); has last_name => ( is => 'rw', isa => 'Str', ); Person->new( first_name => 'Vadim', last_name => 'Pushtaev', ); 50 / 60

Slide 51

Slide 51 text

Moose — наследование package User; use Moose; extends 'Person'; has password => ( is => 'ro', isa => 'Str', ); 51 / 60

Slide 52

Slide 52 text

Moose — инициализация BUILD has age => (is => 'ro', isa => 'Int'); has is_adult => (is => 'rw', isa => 'Bool'); sub BUILD { my ($self) = @_; $self->is_adult($self->age >= 18); return; } 52 / 60

Slide 53

Slide 53 text

Moose — инициализация default has age => (is => 'ro', isa => 'Int'); has is_adult => ( is => 'ro', isa => 'Bool', lazy => 1, default => sub { my ($self) = @_; return $self->age >= 18; } ); 53 / 60

Slide 54

Slide 54 text

Moose — инициализация builder has age => (is => 'ro', isa => 'Int'); has is_adult => ( is => 'ro', isa => 'Bool', lazy => 1, builder => '_build_is_adult', ); sub _build_is_adult { my ($self) = @_; return $self->age >= 18; } package SuperMan; extends 'Person'; sub _build_is_adult { return 1; } 54 / 60

Slide 55

Slide 55 text

Moose — инициализация Цепочки has [qw( file_name fh file_content xml_document data )] => ( lazy_build => 1, # ... ); sub _build_fh { open(file_name) } sub _build_file_content { read(fh) } sub _build_xml_document { parse(file_content) } sub _build_data { find(xml_document) } 55 / 60

Slide 56

Slide 56 text

Moose — миксины with 'Role::HasPassword'; package Role::HasPassword; use Moose::Role; use Some::Digest; has password => ( is => 'ro', isa => 'Str', ); sub password_digest { my ($self) = @_; return Some::Digest->new($self->password); } 56 / 60

Slide 57

Slide 57 text

Moose — делегирование has doc => ( is => 'ro', isa => 'Item', handles => [qw(read write size)], ); has last_login => ( is => 'rw', isa => 'DateTime', handles => { 'date_of_last_login' => 'date' }, ); { handles => qr/^get_(a|b|c)|set_(a|d|e)$/, handles => 'Role::Name', } 57 / 60

Slide 58

Slide 58 text

Moose — и т. д. before 'is_adult' => sub { shift->recalculate_age } subtype 'ModernDateTime' => as 'DateTime' => where { $_->year() >= 1980 } => message { 'The date is not modern enough' }; has 'valid_dates' => ( is => 'ro', isa => 'ArrayRef[DateTime]', ); package Config; use MooseX::Singleton; # instead of Moose has 'cache_dir' => ( ... ); 58 / 60

Slide 59

Slide 59 text

Moose — аналоги Moose Mouse Moo Mo M 59 / 60

Slide 60

Slide 60 text

ДЗ https://github.com/Nikolo/T echnosfera-perl/ /homeworks/oop_reducer 60 / 60