package Seis::Pair;
use strict;
use warnings;
use utf8;
use 5.010_001;
package # hide from pause
Pair;
use Seis::Autobox;
use overload (
'~~' => '_match',
'eq' => sub {
my ($x, $y, $r) = @_;
# optimizable
$x->perl eq $y->perl
},
fallback => 1,
);
# Do not call this directly.
sub _new {
my ($class, $key, $value) = @_;
bless [$key, $value], $class;
}
sub key { $_[0]->[0] }
sub value { $_[0]->[1] }
sub _match {
my ($self, $stuff) = @_;
if (UNIVERSAL::isa($stuff, 'Seis::IO::Handle')) {
my ($key, $val) = @$self;
my $ret = $stuff->$key();
if ($val) {
return !!$ret ? Bool::true() : Bool::false();
} else {
return !$ret ? Bool::True() : Bool::False();
}
} else {
...
}
}
sub fmt {
my ($self, $pattern) = @_;
$pattern //= "%s\t%s";
sprintf($pattern, $self->key, $self->value);
}
# "foo" => 3
our $_PERL_KEY;
sub perl {
my $self = shift;
my $key = do {
local $_PERL_KEY = 1;
$self->key->perl;
};
my $value = $self->value->perl;
if ($_PERL_KEY) {
"($key => $value)";
} else {
"$key => $value";
}
}
sub kv {
my $self = shift;
[$self->key, $self->value];
}
sub isa {
my ($self, $stuff) = @_;
return UNIVERSAL::isa($self, $stuff->{name}) if UNIVERSAL::isa($stuff, 'Seis::Class');
return UNIVERSAL::isa($self, $stuff);
}
sub WHAT {
Seis::Class->_new(nam => 'Pair');
}
1;