* [gentoo-commits] proj/perl-overlay:master commit in: scripts/, scripts/lib/corelist/
@ 2012-03-27 1:26 Kent Fredric
0 siblings, 0 replies; only message in thread
From: Kent Fredric @ 2012-03-27 1:26 UTC (permalink / raw
To: gentoo-commits
commit: 774cf4f0fd1be8145852cda089c784dacd72a36d
Author: Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Mon Mar 5 12:37:18 2012 +0000
Commit: Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Mon Mar 5 12:37:18 2012 +0000
URL: http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=774cf4f0
[scripts/dual-life.pl] refactored and split into modules, overhauled to make more useful output and work on perl5.12
---
scripts/dual-life.pl | 199 ++++++++--------------------------------
scripts/lib/corelist/group.pm | 46 +++++++++
scripts/lib/corelist/module.pm | 26 +++++
scripts/lib/corelist/single.pm | 130 ++++++++++++++++++++++++++
4 files changed, 239 insertions(+), 162 deletions(-)
diff --git a/scripts/dual-life.pl b/scripts/dual-life.pl
old mode 100644
new mode 100755
index 9d7fe80..b2f2c12
--- a/scripts/dual-life.pl
+++ b/scripts/dual-life.pl
@@ -1,6 +1,6 @@
#!/usr/bin/env perl
-use 5.14.2;
+use 5.12.2;
use strict;
use warnings;
@@ -13,18 +13,48 @@ use FindBin;
use version;
use lib "$FindBin::Bin/lib";
+use corelist::group;
-my $pv = shift(@ARGV);
+#my $pv = shift(@ARGV);
my $perls = {
- masked_future => CoreGroup->new( name => 'masked_future', perls => [qw( 5.14.0 5.14.1 5.14.2 )] ),
- masked_past => CoreGroup->new( name => 'masked_past', perls => [qw( 5.8.8 5.10.1 )] ),
- testing => CoreGroup->new( name => 'testing', perls => [qw()] ),
- stable => CoreGroup->new( name => 'stable', perls => [qw( 5.12.3 5.12.4 )] ),
+ masked_future => corelist::group->new( name => 'masked_future', perls => [qw( 5.14.0 5.14.1 5.14.2 )] ),
+ masked_past => corelist::group->new( name => 'masked_past', perls => [qw( 5.8.8 5.10.1 )] ),
+ testing => corelist::group->new( name => 'testing', perls => [qw( 5.12.4 )] ),
+ stable => corelist::group->new( name => 'stable', perls => [qw( 5.12.3 )] ),
};
-pp $perls->{masked_future}->get_perl(qw( 5.14.2 ))->delta( $perls->{stable}->get_perl(qw( 5.12.4 )) );
+my $to = $perls->{masked_future}->get_perl(qw( 5.14.1 ));
+my $from = $perls->{testing}->get_perl(qw( 5.12.4 ));
+my $delta = $from->delta( $to );
+
+for my $module ( sort keys %{ $delta }){
+ my $data = $delta->{$module};
+ if( $data->{kind} eq 'cross' ){
+ my ( $ourv , $theirv ) = @{$data}{'our_version','their_version'};
+ say sprintf "\e[31m[ CHANGE ]\e[0m %-40s\t%s => %s", $module, numpad($ourv) , numpad($theirv);
+ } elsif( $data->{kind} eq 'theirs' ) {
+ my ( $av , $av_in, $nav_in ) = @{$data}{'available_version','available_in','not_available_in'};
+
+ say sprintf "\e[32m[ NEW ] %-40s\t%8s\e[0m", $module, numpad($av);
+ } else {
+ my ( $av , $av_in, $nav_in ) = @{$data}{'available_version','available_in','not_available_in'};
+
+
+ say sprintf "\e[33m[ REMOVED ] %-40s\t%8s\e[0m", $module, numpad($av);
+ }
+}
+
+sub numpad {
+ my $num = shift;
+ my $value;
+ if ( defined $num ){
+ return sprintf "%8s", $num ;
+ } else {
+ return "\e[31m" . ( sprintf "%8s", 'undef' ) . "\e[0m";
+ }
+}
#for my $group ( $perls->{masked_future} ) {
# for my $perl ( values $group->perls ) {
# for my $module ( values $perl->modules ) {
@@ -37,160 +67,5 @@ pp $perls->{masked_future}->get_perl(qw( 5.14.2 ))->delta( $perls->{stable}->get
exit 0;
-BEGIN {
-
- package CoreList::Module;
- 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 );
- __PACKAGE__->meta->make_immutable;
-
- sub to_s {
- my $self = shift;
- return sprintf '%s %s %s %s', $self->coregroup, $self->perl, $self->name, $self->version // 'undef';
- }
-
-}
-
-BEGIN {
-
- package CoreList::Single;
- use Moose;
-
- 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 );
-
- __PACKAGE__->meta->make_immutable;
-
- 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 } ) {
- die "Version " . $self->_version_string . " is not in the \$version stash";
- }
-
- 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
- };
- }
-}
-
-BEGIN {
-
- package CoreGroup;
- use Moose;
- 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 );
-
- __PACKAGE__->meta->make_immutable;
-
- 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 } };
- }
-
-}
diff --git a/scripts/lib/corelist/group.pm b/scripts/lib/corelist/group.pm
new file mode 100644
index 0000000..79f27b5
--- /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 0000000..502d51d
--- /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 0000000..41f5a2f
--- /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;
+
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2012-03-27 1:27 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-03-27 1:26 [gentoo-commits] proj/perl-overlay:master commit in: scripts/, scripts/lib/corelist/ Kent Fredric
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox