[scripts/dual-life.pl] refactored and split into modules, overhauled to make more useful output and work on perl5.12

3 files changed, 202 insertions, 0 deletions

diff --git a/scripts/lib/corelist/group.pm b/scripts/lib/corelist/group.pm
new file mode 100644
index 000000000..79f27b5e2
--- /dev/null
+++ b/scripts/lib/corelist/group.pm
@@ -0,0 +1,46 @@
+use strict;
+use warnings;
+
+package corelist::group;
+
+# FILENAME: group.pm
+# CREATED: 06/03/12 00:27:37 by Kent Fredric (kentnl) <kentfredric@gmail.com>
+# ABSTRACT: a group of some kind
+
+use Moose;
+use corelist::single;
+
+has _perls =>
+  ( isa => 'ArrayRef[Str]', is => 'rw', required => 1, init_arg => 'perls' );
+
+has perls => (
+    isa        => 'HashRef[corelist::single]',
+    is         => 'rw',
+    lazy_build => 1,
+    init_arg   => undef
+);
+has name => ( isa => 'Str', is => 'rw', required => 1 );
+
+sub get_perl {
+    my ( $self, $perlv ) = @_;
+    if ( not exists $self->perls->{$perlv} ) {
+        die "No key $perlv";
+    }
+    return $self->perls->{$perlv};
+}
+
+# BUILDERS
+sub _build_perls {
+    my $self = shift;
+    return {
+        map {
+            $_,
+              corelist::single->new( coregroup => $self->name, perl => $_ )
+          } @{ $self->_perls }
+    };
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+1;
+
diff --git a/scripts/lib/corelist/module.pm b/scripts/lib/corelist/module.pm
new file mode 100644
index 000000000..502d51d3d
--- /dev/null
+++ b/scripts/lib/corelist/module.pm
@@ -0,0 +1,26 @@
+use strict;
+use warnings;
+
+package corelist::module;
+
+# FILENAME: module.pm
+# CREATED: 06/03/12 00:26:40 by Kent Fredric (kentnl) <kentfredric@gmail.com>
+# ABSTRACT: represent a single module from corelist
+
+use Moose;
+
+has name      => ( isa => 'Str',        is => 'rw', required => 1 );
+has version   => ( isa => 'Maybe[Str]', is => 'rw', required => 1 );
+has perl      => ( isa => 'Str',        is => 'rw', required => 1 );
+has coregroup => ( isa => 'Str',        is => 'rw', required => 1 );
+
+sub to_s {
+    my $self = shift;
+    return sprintf '%s %s %s %s', $self->coregroup, $self->perl, $self->name,
+      $self->version // 'undef';
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+1;
+
diff --git a/scripts/lib/corelist/single.pm b/scripts/lib/corelist/single.pm
new file mode 100644
index 000000000..41f5a2f72
--- /dev/null
+++ b/scripts/lib/corelist/single.pm
@@ -0,0 +1,130 @@
+use strict;
+use warnings;
+
+package corelist::single;
+
+# FILENAME: single.pm
+# CREATED: 06/03/12 00:23:19 by Kent Fredric (kentnl) <kentfredric@gmail.com>
+# ABSTRACT: represent a single perl version
+
+use Moose;
+use corelist::module;
+
+has 'perl' => ( isa => 'Str', is => 'rw', required => 1 );
+
+has 'modules' => (
+    isa        => 'HashRef[corelist::module]',
+    is         => 'rw',
+    lazy_build => 1,
+    traits     => [qw(        Hash        )],
+    handles    => {
+        'module_names' => 'keys',
+        'has_module'   => 'exists',
+        'module'       => 'get',
+    },
+);
+
+has 'released' => ( isa => 'Str', is => 'rw', lazy_build => 1 );
+
+has 'perl_version' => ( isa => 'Str', is => 'rw', lazy_build => 1 );
+
+has 'coregroup' => ( isa => 'Str', is => 'rw', required => 1 );
+
+sub delta {
+    my ( $self, $other ) = @_;
+    my (%all) = map { $_, 1 }
+      $self->module_names,
+      $other->module_names;
+    my %diffs;
+    for my $module ( keys %all ) {
+        if ( $self->has_module($module) and not $other->has_module($module) ) {
+            $diffs{$module} = {
+                kind              => 'ours',
+                available_in      => $self->perl_version,
+                not_available_in  => $other->perl_version,
+                module            => $module,
+                available_version => $self->module($module)->version,
+            };
+            next;
+        }
+        if ( not $self->has_module($module) and $other->has_module($module) ) {
+            $diffs{$module} = {
+                kind              => 'theirs',
+                available_in      => $other->perl_version,
+                not_available_in  => $self->perl_version,
+                module            => $module,
+                available_version => $other->module($module)->version,
+            };
+            next;
+        }
+        if ( ( $self->module($module)->version // 'undef' ) ne
+            ( $other->module($module)->version // 'undef' ) )
+        {
+            $diffs{$module} = {
+                kind          => 'cross',
+                module        => $module,
+                our_version   => $self->module($module)->version,
+                their_version => $other->module($module)->version,
+                our_perl      => $self->perl_version,
+                their_perl    => $other->perl_version,
+            };
+        }
+
+    }
+    return \%diffs;
+}
+
+# BUILDERS
+sub _build_perl_version {
+    require version;
+    my $self = shift;
+    return version->parse( $self->perl )->numify;
+}
+
+sub _version_string {
+    my $self = shift;
+    return $self->perl . ' ( ' . $self->perl_version . ' )';
+}
+
+sub _build_released {
+    require Module::CoreList;
+    my $self = shift;
+    if ( not exists $Module::CoreList::released{ $self->perl_version } ) {
+        die "Version "
+          . $self->_version_string
+          . " is not in the \$released stash";
+    }
+    return $Module::CoreList::released{ $self->perl_version };
+}
+
+sub _build_modules {
+    require Module::CoreList;
+    my $self = shift;
+    if ( not exists $Module::CoreList::version{ $self->perl_version } ) {
+        my (@versions) = sort keys %Module::CoreList::version;
+        die "Version "
+          . $self->_version_string
+          . " is not in the \$version stash\n"
+          . " Usually this means either you specified an invalid perl, or that \n"
+          . " Your copy of Module::CoreList ( $Module::CoreList::VERSION ) is out of date\n"
+          . ' Pick one of these: ' . join q[, ], @versions;
+    }
+
+    my $stash = $Module::CoreList::version{ $self->perl_version };
+
+    return {
+        map {
+            $_,
+              corelist::module->new(
+                perl      => $self->perl_version,
+                coregroup => $self->coregroup,
+                name      => $_,
+                version   => $stash->{$_}
+              )
+          } keys %$stash
+    };
+}
+no Moose;
+__PACKAGE__->meta->make_immutable;
+1;
+