The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

package Morris::Message;
use Moose;
use Moose::Util::TypeConstraints;
use namespace::clean -except => qw(meta);

class_type 'Morris::Message::Address';

coerce 'Morris::Message::Address'
    => from 'Str'
        => via { Morris::Message::Address->new($_) }
;

has from => (
    is => 'ro',
    isa => 'Morris::Message::Address',
    coerce => 1,
    required => 1,
    handles  => [ qw(modifier nickname username hostname) ]
);

has channel => (
    is => 'ro',
    isa => 'Str',
);

has message => (
    is => 'ro',
    isa => 'Str',
);

has timestamp => (
    is => 'ro',
    isa => 'Int',
    default => sub { time() }
);

__PACKAGE__->meta->make_immutable;

package Morris::Message::Address;
use Moose;

has str_ref => (
    is => 'ro',
    isa => 'ScalarRef',
    required => 1,
    trigger => sub {
        my $self = shift;
        $self->__parsed(0);
    },
);

has __parsed => (
    is => 'rw',
    isa => 'Bool',
    required => 1,
    default => 0,
);

has modifier => (
    is => 'ro',
    isa => 'Maybe[Str]',
    writer => 'set_modifier',
);

has nickname => (
    is => 'ro',
    isa => 'Maybe[Str]',
    writer => 'set_nickname',
);

has username => (
    is => 'ro',
    isa => 'Maybe[Str]',
    writer => 'set_username',
);

has hostname => (
    is => 'ro',
    isa => 'Maybe[Str]',
    writer => 'set_hostname',
);

around BUILDARGS => sub {
    my ($next, $class, @args) = @_;

    if (@args == 1) {
        @args = (str_ref => \$args[0]);
    }
    $next->($class, @args);
};

around qw(modifier nickname username hostname) => \&__check_parsed;

sub __check_parsed {
    my ($next, $self, @args) = @_;

    if (@args) {
        return $next->($self, @args);
    }

    if (! $self->__parsed) {
        my $ref = $self->str_ref;

        $$ref =~ /^(\W)?([^!]+)!([^@]+)@(.*)$/;
        $self->set_modifier( $1 || '' );
        $self->set_nickname( $2 || '' );
        $self->set_username( $3 || '' );
        $self->set_hostname( $4 || '' );
        $self->__parsed(1);
    }
    return $next->($self);
}

__PACKAGE__->meta->make_immutable();

1;