From: "Kent Fredric" <kentfredric@gmail.com>
To: gentoo-commits@lists.gentoo.org
Subject: [gentoo-commits] proj/perl-overlay:master commit in: scripts/
Date: Mon, 31 Oct 2011 18:05:32 +0000 (UTC) [thread overview]
Message-ID: <66ce54b9fb3a062ff9ff1b164de659f47aa9cb25.kent@gentoo> (raw)
commit: 66ce54b9fb3a062ff9ff1b164de659f47aa9cb25
Author: Kent Fredric <kentfredric <AT> gmail <DOT> com>
AuthorDate: Mon Oct 31 18:03:56 2011 +0000
Commit: Kent Fredric <kentfredric <AT> gmail <DOT> com>
CommitDate: Mon Oct 31 18:03:56 2011 +0000
URL: http://git.overlays.gentoo.org/gitweb/?p=proj/perl-overlay.git;a=commit;h=66ce54b9
[scripts/dual-life.pl] early stage of dual-life script, shows delta between arbitrary corelist perls
---
scripts/dual-life.pl | 199 ++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 199 insertions(+), 0 deletions(-)
diff --git a/scripts/dual-life.pl b/scripts/dual-life.pl
new file mode 100644
index 0000000..458e1f9
--- /dev/null
+++ b/scripts/dual-life.pl
@@ -0,0 +1,199 @@
+#!/usr/bin/env perl
+
+use 5.14.2;
+use strict;
+use warnings;
+
+# FILENAME: dual-life.pl
+# CREATED: 01/11/11 05:49:45 by Kent Fredric (kentnl) <kentfredric@gmail.com>
+# ABSTRACT: find/report dual-life modules.
+use Module::CoreList;
+use Data::Dump qw( pp );
+use FindBin;
+use version;
+
+use lib "$FindBin::Bin/lib";
+
+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 )] ),
+};
+
+
+pp $perls->{masked_future}->get_perl(qw( 5.14.2 ))->delta(
+ $perls->{stable}->get_perl(qw( 5.12.4 )) );
+
+#for my $group ( $perls->{masked_future} ) {
+# for my $perl ( values $group->perls ) {
+# for my $module ( values $perl->modules ) {
+# say $module->to_s;
+# }
+# }
+#}
+
+#pp $perls;
+
+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 } };
+ }
+
+}
next reply other threads:[~2011-10-31 18:05 UTC|newest]
Thread overview: 63+ messages / expand[flat|nested] mbox.gz Atom feed top
2011-10-31 18:05 Kent Fredric [this message]
-- strict thread matches above, loose matches on Subject: below --
2017-09-16 22:36 [gentoo-commits] proj/perl-overlay:master commit in: scripts/ Kent Fredric
2015-02-28 23:17 Kent Fredric
2015-02-28 23:17 Kent Fredric
2013-12-23 15:28 Kent Fredric
2013-05-01 23:03 Kent Fredric
2013-05-01 23:03 Kent Fredric
2012-10-24 15:49 Kent Fredric
2012-09-15 23:19 Kent Fredric
2012-08-02 11:46 Kent Fredric
2012-08-02 11:46 Kent Fredric
2012-07-31 3:04 Kent Fredric
2012-07-12 19:23 Torsten Veller
2012-06-22 7:34 Kent Fredric
2012-06-08 17:14 Kent Fredric
2012-05-27 2:30 Kent Fredric
2012-04-28 10:40 Kent Fredric
2012-04-18 3:32 Kent Fredric
2012-04-18 3:32 Kent Fredric
2012-04-18 3:32 Kent Fredric
2012-04-12 19:46 Kent Fredric
2012-04-09 16:05 Kent Fredric
2012-04-08 13:20 Kent Fredric
2012-04-08 13:20 Kent Fredric
2012-04-05 10:02 Kent Fredric
2012-03-27 1:26 Kent Fredric
2012-03-27 1:26 Kent Fredric
2012-03-27 1:26 Kent Fredric
2012-03-01 11:38 Kent Fredric
2012-02-29 12:22 Kent Fredric
2012-02-29 12:22 Kent Fredric
2012-02-29 12:06 Kent Fredric
2012-02-28 21:55 Kent Fredric
2012-02-28 21:55 Kent Fredric
2012-02-28 21:55 Kent Fredric
2012-02-24 7:13 Kent Fredric
2012-02-24 7:13 Kent Fredric
2012-02-12 7:22 Kent Fredric
2012-02-12 7:22 Kent Fredric
2011-12-05 21:45 Kent Fredric
2011-11-14 2:57 Kent Fredric
2011-11-14 2:57 Kent Fredric
2011-11-11 14:38 Kent Fredric
2011-10-31 18:05 Kent Fredric
2011-10-31 8:46 Kent Fredric
2011-10-31 7:10 Kent Fredric
2011-10-31 4:52 Kent Fredric
2011-10-31 2:48 Kent Fredric
2011-10-31 2:48 Kent Fredric
2011-10-31 2:48 Kent Fredric
2011-10-31 2:48 Kent Fredric
2011-10-31 2:48 Kent Fredric
2011-10-31 2:48 Kent Fredric
2011-10-31 2:48 Kent Fredric
2011-10-31 2:48 Kent Fredric
2011-10-25 19:46 Kent Fredric
2011-10-25 19:46 Kent Fredric
2011-10-25 19:46 Kent Fredric
2011-10-24 21:17 Kent Fredric
2011-10-24 18:26 Kent Fredric
2011-10-24 9:09 Kent Fredric
2011-09-23 6:17 Kent Fredric
2011-08-29 5:44 Kent Fredric
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=66ce54b9fb3a062ff9ff1b164de659f47aa9cb25.kent@gentoo \
--to=kentfredric@gmail.com \
--cc=gentoo-commits@lists.gentoo.org \
--cc=gentoo-dev@lists.gentoo.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox