Perl Now

Real-life usage of modern Perl features.

Transcript

1. Perl Now 1 / 24
2. 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', ); 2 / 24
3. Moose — наследование package User; use Moose; extends 'Person'; has password => ( is => 'ro', isa => 'Str', ); 3 / 24
4. Moose — инициализация BUILD has age => (is => 'ro', isa => 'Int'); has is_adult => (is => 'ro', isa => 'Bool'); sub BUILD { my ($self) = @_; $self->is_adult($self->age >= 18); return; } 4 / 24
5. 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; } ); 5 / 24
6. 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; } 6 / 24
7. 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) } 7 / 24
8. 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); } 8 / 24
9. 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', } 9 / 24
10. Moose — и т. д. before 'is_adult' => sub { shift->recalculate_age } subtype 'ModernDateTime' => as 'DateTime' => where { $_->year() >= 1980 } => message { 'The date you provided is not modern enough' }; has 'valid_dates' => ( is => 'ro', isa => 'ArrayRef[DateTime]', ); package Config; use MooseX::Singleton; # instead of Moose has 'cache_dir' => ( ... ); 10 / 24
11. Moose — аналоги Moose Mouse Moo Mo M 11 / 24
12. DBIx::Class # SELECT * FROM user WHERE age >= 18 my @adults = $schema->resultset('User')->search({ age => { '>=' => 18 }, }); foreach my $adult (@adults) { # UPDATE user SET fired = NOW() WHERE id = ... $adult->update({ fired => \'NOW()', }); $adult->cry(); } 12 / 24
13. DBIx::Class — схема __PACKAGE__->table('user_ip'); __PACKAGE__->add_columns( 'user_id', { data_type => 'integer', is_foreign_key => 1, is_nullable => 0 }, 'ip', { data_type => 'varchar', is_nullable => 0, size => 128 }, ); __PACKAGE__->set_primary_key('user_id', 'ip'); __PACKAGE__->belongs_to( 'user', 'Schema::Result::User', { user_id => 'user_id' }, { is_deferrable => 1, on_delete => 'CASCADE', on_update => 'CASCADE' }, ); 13 / 24
14. DBIx::Class — связи # SELECT * FROM user WHERE id = 81858 my $user = $schema->resultset('User')->find(81858); my $free_services = $user->accounts->search_related('service', { status => {'<>' => $DELETED_STATUS}, price => 0, }); 14 / 24
15. DBIx::Class — поиск my $man = $schema->resultset('User')->search( { 'name' => 'Вася', 'cat.name' => 'Барсик', 'dog.name' => 'Бобик', }, { join => ['cat', 'dog'], } ); 15 / 24
16. DBIx::Class — создание $person_rs->create({ name => 'Vadim Pushtaev', email => 'vadim@pushtaev.ru', }); $artist_rs->create({ artistid => 4, name => 'Rage', cds => [ { title => 'Black in Mind', year => 1995 }, { title => 'XIII', year => 1998 }, { title => '21', year => 2012 }, ], }); # Завтра концерт! 16 / 24
17. DBIx::Class — изменение $schema->resultset('User')->find(81858)->update({ name => 'Vadim', }); $schema->resultset('Cd')->search({ title => 'ReLoad', })->update_all({ year => 1997, }); 17 / 24
18. Test::Class package Test::Untils; use base 'Test::Class'; use Utils qw(cube); sub test_cube : Test(2) { my ($self) = @_; is(cube(-2), -8, 'negative'); is(cube(2), 8, 'positive'); return; } 18 / 24
19. Test::Deep cmp_bag( [7, 'Fred', {vadim => 'pushtaev'}], ['Fred', {vadim => 'pushtaev'}, 7], 'OK' ); cmp_deeply( $obj, methods(name => 'John', ['favourite', 'food'] => 'taco') ); # $obj->name eq 'Join'; # $obj->favourite->food eq 'taco'; 19 / 24
20. Test::MockObject use Test::MockObject; my $mock = Test::MockObject->new(); $mock->set_true('somemethod'); ok( $mock->somemethod() ); $mock ->set_true('Deutsch') ->set_false('English') ->set_series('numbers', 'Eins', 'Zwei', 'Drei'); 20 / 24
21. Test::DBIx::Class DBIx::Class::Schema::PopulateMore - Gender: fields: label data: female: female male: male - Person: fields: - name - age - gender data: jane: - jane - 40 - '!Index:Gender.female' john: - john - 38 - '!Index:Gender.male' 21 / 24
22. Perl::Critic my $max_cache_size = 42; my $maxCacheSize; $max_cache_size++ if condition(); $obj->_some_method(); my @names = ( 'Pushtaev Vadim', 'Pushtaeva Ekaterina' ); 22 / 24
23. use strict; Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict perl5i uni::perl Modern::Perl common::sense 23 / 24
24. Modern Perl Perl Now 24 / 24