MooseX::Declare example

gistfile1.PL

use MooseX::Declare;

our $VERSION = '0.02';

# XXX: fuck, please, refactoring me :)

class Geo::Message {
	has 'data' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } );
	
	method parse(Str $data) {
		return [
			map { Geo::Message::Type::Msg->new->parse($_) }
			split /\n/, $data
		];
	}
	method to_string {
		return join "\n", map { $_->to_string } @{ $self->data };
	}
	method add(Any $msg) {
		push @{ $self->{'data'} }, $msg;
		return $self;
	}
	
	class ::Type {
		has 'type'   => ( is => 'rw', isa => 'Str' );
		has 'data'   => ( is => 'rw' );
		
		has 'sep'    => ( is => 'rw', default => '' );
		
		method parse(Str $data) {
			if ($self->sep) {
				return [ split $self->sep, $data ];
			}
			else {
				return $self->new(data => $data);
			}
		}
		method to_string {
			if ($self->sep) {
				return join $self->sep, @{ $self->data };
			}
			else {
				return $self->data;
			}
		}
		
		class ::Undef extends Geo::Message::Type { }
		
		class ::Msg   extends Geo::Message::Type {
			has 'sep'      => ( is => 'ro', default => ',' );
			
			has 'udid'     => ( is => 'rw', isa => 'Str' );
			has 'type_raw' => ( is => 'rw', isa => 'Str' );
			
			use Moose::Util::TypeConstraints;
			enum Message => qw(undef track avatar status direct profile);
			
			has 'type' => ( is => 'rw', isa => 'Message'  );
			has 'data' => ( is => 'rw' ); # XXX: please use isa, fuck
			
			method parse(Str $data) {
				return
					map {
						my $msg  = $self->new(udid => $_->[0], type_raw => $_->[1] // '');
						my $type = $self->check_type($msg->type_raw);
						
						$msg->type($type->type);
						$msg->data($type->parse($_->[2] // ''));
						
						$msg;
					}
					$self->SUPER::parse($data)
				;
			}
			method to_string {
				my $type = $self->new->check_type($self->type);
				$type->data($self->data);
				
				# $self->data([ $self->udid, $self->type, $type->to_string ]);
				# return $self->SUPER::to_string;
				
				return join $self->sep, $self->udid, $self->type, $type->to_string; # XXX
			}
			method check_type(Str $name) {
				my $all  = Moose::Util::TypeConstraints::find_type_constraint('Message')->values;
				my $type = [ grep { $name eq $_ } @$all ]->[0] || $all->[0];
				
				return "Geo::Message::Type::$_"->new(type => $type) for ucfirst $type;
			}
		}
		
		class ::Track extends Geo::Message::Type {
			has 'sep'  => ( is => 'ro', default => ';' );
			has 'data' => ( is => 'rw', 'isa' => 'ArrayRef', default => sub { [] } );
			
			class ::Msg extends Geo::Message::Type {
				has 'sep'    => ( is => 'ro', default => ':' );
				
				has 'lat'    => ( is => 'rw', isa => 'Str' );
				has 'lon'    => ( is => 'rw', isa => 'Str' );
				has 'acc'    => ( is => 'rw', isa => 'Str' );
				has 'time'   => ( is => 'rw', isa => 'Str' );
				
				method parse(Str $data) {
					return
						map { $self->new( lat => $_->[0], lon => $_->[1], acc => $_->[2], time => $_->[3] ) }
						$self->SUPER::parse($data)
					;
				}
				method to_string {
					$self->data([ $self->lat, $self->lon, $self->acc, $self->time ]);
					return $self->SUPER::to_string;
				}
			}
			
			method parse(Str $data) {
				my $msg = join '::', 'Geo::Message::Type', ucfirst $self->type, 'Msg'; # XXX
				
				return $self->new(data => [
					map { $msg->new->parse($_) }
					@{ $self->SUPER::parse($data) }
				]);
			}
			method to_string {
				$self->data([ map { $_->to_string } @{ $self->data } ]);
				
				return $self->SUPER::to_string;
			}
		}
		
		class ::Avatar extends Geo::Message::Type {
			has 'url'    => ( is => 'rw', isa => 'Str' );
			has 'file'   => ( is => 'rw', isa => 'Str' );
			
			use MIME::Base64 qw(encode_base64 decode_base64);
			
			method parse(Str $data) {
				return $self->new(data => decode_base64 $data);
			}
			method to_string {
				# XXX: в обе стороны на основе есть url или нет
				$self->url($self->data) if $self->data =~ m{^http://};
				
				return $self->url || encode_base64($self->data, '');
			}
			method save_avatar(Str $filename) {
				my $file = $filename ? $self->file($filename) : $self->file;
				return unless $file;
				
				{
					open my $fh, '>', $file or die "Can't open file $file: $!";
					binmode $fh;
					print   $fh $self->data;
				}
				return -s $file;
			}
		}
		
		class ::Status extends Geo::Message::Type {
			use MIME::Base64 qw(encode_base64 decode_base64);
			
			method parse(Str $data) {
				return $self->new(data => decode_base64 $data);
			}
			method to_string {
				use Encode ();
				return encode_base64(Encode::encode_utf8($self->data), ''); # XXX: may be encode with 1
			}
		}
		
		class ::Direct extends Geo::Message::Type::Status { }
		
		class ::Profile extends Geo::Message::Type::Track {
			class ::Msg extends Geo::Message::Type {
				has 'sep'    => ( is => 'ro', default => ':' );
				
				has 'key'    => ( is => 'rw', isa => 'Str' );
				has 'value'  => ( is => 'rw', isa => 'Str' );
				has 'access' => ( is => 'rw', isa => 'Str' );
				
				method parse(Str $data) {
					return
						map { $self->new( key => $_->[0], value => $_->[1], access => $_->[2] ) }
						$self->SUPER::parse($data)
					;
				}
				method to_string {
					$self->data([ $self->key, $self->value, $self->access ]);
					
					return $self->SUPER::to_string;
				}
			}
		}
		
	}
}

1;