diff options
author | matthewt <matthewt@03d0b0b2-0e1a-0410-a411-fdb2f4bd65d7> | 2008-06-24 16:06:21 +0000 |
---|---|---|
committer | matthewt <matthewt@03d0b0b2-0e1a-0410-a411-fdb2f4bd65d7> | 2008-06-24 16:06:21 +0000 |
commit | 319bf4d0176dfdb8382fdecc607160ba3df38e73 (patch) | |
tree | 68df4c5902359390ff0a2c97ba8208c573412d1b /script | |
parent | 159fd246b1f502b23d747a5e81ca3d8adf6c01af (diff) | |
download | reaction-319bf4d0176dfdb8382fdecc607160ba3df38e73.tar.gz reaction-319bf4d0176dfdb8382fdecc607160ba3df38e73.zip |
this is really pre-alpha and do not blame me if it eats your dog
Diffstat (limited to 'script')
-rw-r--r-- | script/rclass_back_to_moose.pl | 69 |
1 files changed, 69 insertions, 0 deletions
diff --git a/script/rclass_back_to_moose.pl b/script/rclass_back_to_moose.pl new file mode 100644 index 0000000..68dbd57 --- /dev/null +++ b/script/rclass_back_to_moose.pl @@ -0,0 +1,69 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use IO::All; + +sub with_file (&) { + my ($code) = @_; + my $fname = $_; + my $data < io($fname); + { + local $_ = $data; + $code->(); + $data = $_; + } + $data > io($fname); +} + +sub with_class_block (&) { + my ($code) = @_; + $_ =~ s{^class\s*(.*?)which\s*{(.*?)^};} + { + local *_ = { header => $1, body => $2 }; + $code->(); + }sme; +} + +sub parse_header { + my $h = $_{header}; + $h =~ s/^\s*\S+\s+// || die; + my @base; + while ($h =~ /is\s*(\S+?),?/g) { + push(@base, $1); + } + return @base; +} + +sub build_extends { + my $base = join(', ', parse_header); + ($base ? "extends ${base};\n\n" : ''); +} + +sub sq { # short for 'strip quotes' + my $copy = $_[0]; + $copy =~ s/^'(.*)'$/$1/; + $copy =~ s/^"(.*)"$/$1/; + $copy; +} + +sub filtered_body { + local $_ = $_{body}; + s/^ //g; + s/implements *(\S+).*?{/"sub ${\sq $1} {"/ge; + s/^does/with/g; + $_; +} + +sub top { "use namespace::clean -except => [ qw(meta) ];\n" } +sub tail { "__PACKAGE__->meta->make_immutable;\n"; } + +for ("lib/Reaction/InterfaceModel/Object.pm", "lib/Reaction/InterfaceModel/Action/DBIC/Result.pm") { + with_file { + with_class_block { + return top.build_extends.filtered_body.tail; + }; + }; +} + +1; |