use 5.010; use warnings; use Test::More 'tests' => 2; # Use this class declaration to check that classes with ctors # actually call the ctor when objrules use them... { package Speaker; my %allowed = map { $_ => 1 } qw(name alias id); sub new { my $that = shift; #warn "running 'new'\n"; my $self = bless {}, (ref($that) || $that); $self->init(@_); } sub init { my $self = shift; #warn "running 'init'\n"; my %args = (scalar @_ == 1 and UNIVERSAL::isa($_[0], 'HASH')) ? %{ $_[0] } : @_; foreach my $accessor (keys %args) { next unless (exists $allowed{$accessor}); $self->$accessor($args{$accessor}); } #warn "returning initialized object\n"; return $self; } sub AUTOLOAD { my $self = shift; our $AUTOLOAD; my $var = $AUTOLOAD; my $last_colon_pos = rindex($var, ':'); substr $var, 0, $last_colon_pos+1, q{}; #warn "running AUTOLOAD as '$var' with param '$_[0]'\n"; @_ ? ($self->{$var} = shift) : $self->{$var}; } } my $parser = do{ use Regexp::Grammars; qr{ \\"\> (?:\(\‎\‎\)) \w+ (?:(?:<.ws>|\-|\') \w+) \w+ \d+ }xms }; my $target = { "" => "Nathan Gray (‎kolibrie‎)", "speaker" => bless({ "" => "Nathan Gray (‎kolibrie‎)", "alias" => "kolibrie", "id" => 1613, "name" => "Nathan Gray", }, "Speaker"), }; my $input = do{ local $/; }; chomp $input; my $original_input = $input; ok +($input =~ $parser) => 'Matched'; is_deeply \%/, $target => 'Returned correct data structure'; #is $/{""}, $original_input => 'Captured entire text'; __DATA__ Nathan Gray (‎kolibrie‎) - ‎Practical Extraction with Regexp::Grammars‎ (50 min) 9