package elk; use Filter::Simple; # Yes, I know this is ugly code, # but it's a source filter, so # it is supposed to be ugly :) FILTER { s/class\s(.*)\{/fix_class($1)/egx; s/role\s(.*)\{/fix_role($1)/egx; }; sub process_desc { my $desc = shift; my ($full_name, @args) = split /\s+/ => $desc; my %args; while (@args) { my ($k, $v) = splice @args, 0, 2; if (exists $args{$k}) { push @{$args{$k}} => $v; } else { $args{$k} = [$v]; } } return ($full_name, %args); } sub process_full_name { my ($full_name) = @_; split '-' => $full_name; } sub fix_class { my ($desc) = @_; my ($full_name, %args) = process_desc($desc); my ($name, $version, $authority) = process_full_name($full_name); return '{package ' . $name . '; use Moose;' . (exists $args{extends} ? 'extends qw/' . (join ' ' => @{$args{extends}}) . '/;' : '') . (exists $args{with} ? 'with qw/' . (join ' ' => @{$args{with}}) . '/;' : '') . ($version ? "our \$VERSION = '$version';" : '') . ($authority ? "our \$AUTHORITY = '$authority';" : ''); } sub fix_role { my ($desc) = @_; my ($full_name, %args) = process_desc($desc); my ($name, $version, $authority) = process_full_name($full_name); return '{package ' . $name . '; use Moose::Role;' . (exists $args{with} ? 'with qw/' . (join ' ' => @{$args{with}}) . '/;' : '') . ($version ? "our \$VERSION = '$version';" : '') . ($authority ? "our \$AUTHORITY = '$authority';" : ''); } 1;