From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from pigeon.gentoo.org ([208.92.234.80] helo=lists.gentoo.org) by finch.gentoo.org with esmtp (Exim 4.60) (envelope-from ) id 1RIPEj-0005rC-0C for garchives@archives.gentoo.org; Mon, 24 Oct 2011 18:27:01 +0000 Received: from pigeon.gentoo.org (localhost [127.0.0.1]) by pigeon.gentoo.org (Postfix) with SMTP id 0317A21C03B; Mon, 24 Oct 2011 18:26:47 +0000 (UTC) Received: from smtp.gentoo.org (smtp.gentoo.org [140.211.166.183]) by pigeon.gentoo.org (Postfix) with ESMTP id B246F21C03B for ; Mon, 24 Oct 2011 18:26:47 +0000 (UTC) Received: from pelican.gentoo.org (unknown [66.219.59.40]) (using TLSv1 with cipher AECDH-AES256-SHA (256/256 bits)) (No client certificate requested) by smtp.gentoo.org (Postfix) with ESMTPS id 0C7911B4022 for ; Mon, 24 Oct 2011 18:26:47 +0000 (UTC) Received: from localhost.localdomain (localhost [127.0.0.1]) by pelican.gentoo.org (Postfix) with ESMTP id 0D6D280057 for ; Mon, 24 Oct 2011 18:26:46 +0000 (UTC) From: "Kent Fredric" To: gentoo-commits@lists.gentoo.org Content-type: text/plain; charset=UTF-8 Reply-To: gentoo-dev@lists.gentoo.org, "Kent Fredric" Message-ID: Subject: [gentoo-commits] proj/perl-overlay:master commit in: scripts/ X-VCS-Repository: proj/perl-overlay X-VCS-Files: scripts/package_log.pl X-VCS-Directories: scripts/ X-VCS-Committer: kent X-VCS-Committer-Name: Kent Fredric X-VCS-Revision: f93a203f751970026f26bf3666145a92e13698ba Date: Mon, 24 Oct 2011 18:26:46 +0000 (UTC) Precedence: bulk List-Post: List-Help: List-Unsubscribe: List-Subscribe: List-Id: Gentoo Linux mail X-BeenThere: gentoo-commits@lists.gentoo.org Content-Transfer-Encoding: quoted-printable X-Archives-Salt: X-Archives-Hash: b8758383e4a1e57374ae1b4c4c7cd8cb commit: f93a203f751970026f26bf3666145a92e13698ba Author: Kent Fredric gmail com> AuthorDate: Mon Oct 24 17:50:04 2011 +0000 Commit: Kent Fredric gmail com> CommitDate: Mon Oct 24 18:23:19 2011 +0000 URL: http://git.overlays.gentoo.org/gitweb/?p=3Dproj/perl-overlay.= git;a=3Dcommit;h=3Df93a203f [Scripts/package_log.pl] refactor to be more functional. don't fetch data that we don't use. --- scripts/package_log.pl | 152 ++++++++++++++++++++++++++----------------= ------ 1 files changed, 83 insertions(+), 69 deletions(-) diff --git a/scripts/package_log.pl b/scripts/package_log.pl index 69deb38..1d36d12 100644 --- a/scripts/package_log.pl +++ b/scripts/package_log.pl @@ -36,6 +36,7 @@ use coloriterator =20 my $flags; my $singleflags; + @ARGV =3D grep { defined } map { $_ =3D~ /^--(\w+)/ ? do { $flags->{$1}++; undef } @@ -46,51 +47,20 @@ my $singleflags; } } @ARGV; =20 -if ( $flags->{help} or $singleflags->{h} ) { - print <<"EOF"; -package_log.pl - -USAGE: - - package_log.pl PACKAGE [PACKAGE*] [--all] [--help] [--changes] [--deps= ] [--trace] - - ie: - - # Just show the recent log for Moose, Catalyst-Runtime and Dist-Zilla - package_log.pl Moose Catalyst-Runtime Dist-Zilla - - # show all log events for Moose - package_log.pl Moose --all - - # show recent Moose log events with attached changelog data and depend= enices - package_log.pl Moose --changes --deps - - # Be verbose about what we're doing - package_log.pl Moose --trace --all - - --all Show all releases in the log. - --help Show this message - --changes Show ChangeLog Excerpts using CPAN::Changes where possible - --deps Show Dependency data ( as reported via metadata ) - --trace Turn on extra debugging. -EOF - exit 0; -} - -my $package =3D shift @ARGV; - -my (@want_dists) =3D ( $package, @ARGV ); +if ( $flags->{help} or $singleflags->{h} ) { print help(); exit 0; } =20 my $oldest_date =3D '2011-09-01T00:00:00.000Z'; my $newest_date =3D '2012-01-01T00:00:00.000Z'; =20 my $search =3D {}; + $search->{query} =3D { terms =3D> { - distribution =3D> [ @want_dists, ], + distribution =3D> [ @ARGV, ], minimum_match =3D> 1, }, }; + if ( not $flags->{all} ) { $search->{filter} =3D { range =3D> { @@ -108,62 +78,75 @@ $search->{sort} =3D [ ]; $search->{size} =3D 1024; =20 -# $flags->{fields} =3D [qw( author name date distribution )], +$search->{fields} =3D [qw( author name date distribution version )]; + +if ( $flags->{deps} ) { + push @{ $search->{fields} }, '_source.dependency'; +} + _log( ['initialized: fetching search results'] ); =20 my $results =3D mcpan->post( 'release', $search ); =20 _log( [ 'fetched %s results', scalar @{ $results->{hits}->{hits} } ] ); =20 -sub ac { - return author_colour( $_[0] ) . $_[0] . RESET; -} +for my $result ( @{ $results->{hits}->{hits} } ) { =20 -sub dc { - return dist_colour( $_[0] ) . $_[1] . RESET; + # use Data::Dump qw(pp); + # pp $result; + say $_ for format_result( $result->{fields}, $flags ); } =20 -sub pp { - require Data::Dump; - goto \&Data::Dump::pp; -} +exit 0; =20 -sub gv { - require Gentoo::PerlMod::Version; - goto \&Gentoo::PerlMod::Version::gentooize_version; -} +# Utils + +sub ac { return author_colour( $_[0] ) . $_[0] . RESET } +sub dc { return dist_colour( $_[0] ) . $_[1] . RESET } +sub pp { require Data::Dump; goto \&Data::Dump::pp } +sub gv { require Gentoo::PerlMod::Version; goto \&Gentoo::PerlMod::Versi= on::gentooize_version } =20 sub _log { return unless $flags->{trace}; - if ( not ref $_[0] ) { - return *STDERR->print(@_); - } - my $conf =3D $_[0]; - my ( $str, @args ) =3D @{$conf}; + return *STDERR->print(@_) if ( not ref $_[0] ); + + state $prefix =3D "\e[7m* package_log.pl:\e[0m "; + + my ( $str, @args ) =3D @{ $_[0] }; $str =3D~ s/\n?$/\n/; - return *STDERR->print( sprintf "\e[7m* %s:\e[0m " . $str, 'package_log= .pl', @args ); + + *STDERR->print($prefix); + *STDERR->printf( $str, @args ); + return; + } =20 -for my $result ( @{ $results->{hits}->{hits} } ) { +sub format_result { + + my %f =3D %{ $_[0] }; + my %opts =3D %{ $_[1] || {} }; + + _log( [ 'formatting entry for %s', $f{name} ] ); =20 - my %f =3D %{ $result->{_source} }; + my @out; =20 - # say pp \%f; - my ( $date, $distribution, $name, $author, $deps, $version ) =3D @f{qw= ( date distribution name author dependency version )}; - _log( [ 'formatting entry for %s', $name ] ); - say entry_heading( @f{qw( date author distribution name version)} ); + push @out, entry_heading( @f{qw( date author distribution name version= )} ); =20 - if ( $flags->{deps} ) { - _log( [ 'processing %s deps for %s', scalar @{$deps}, $name ] ); - print $_ for sort map { dep_line($_) } @{$deps}; + my $name =3D $f{name}; + my $author =3D $f{author}; + + if ( $opts{deps} ) { + my $deps =3D $f{'_source.dependency'}; + _log( [ 'processing %s deps for %s', scalar @{$deps}, $f{name} ] ); + push @out, sort map { dep_line($_) } @{$deps}; } - if ( $flags->{changes} ) { + if ( $opts{changes} ) { _log( [ 'processing changes deps for %s', $name ] ); } - if ( $flags->{changes} and my $message =3D change_for( $author, $name = ) ) { - say "\n\e[1;38m" . $message . "\e[0m"; + if ( $opts{changes} and my $message =3D change_for( $author, $name ) )= { + push @out, "\e[1;38m" . $message . "\e[0m"; } - + return @out; } =20 sub entry_heading { @@ -183,7 +166,7 @@ sub dep_line { my $rel =3D ( $dep->{relationship} ne 'requires' ? BRIGHT_BLUE . $dep-= >{relationship} : q[] ); my $phase =3D ( $dep->{phase} eq 'develop' ? BRIGHT_GREEN : q[] ) . $d= ep->{phase}; my $version =3D $gentoo_version . gv( $dep->{version}, { lax =3D> 1 } = ) . RESET; - return sprintf "%s %s: %s %s %s\n", $rel, $phase, $dep->{module}, $dep= ->{version}, $version; + return sprintf "%s %s: %s %s %s", $rel, $phase, $dep->{module}, $dep->= {version}, $version; } =20 sub change_for { @@ -234,3 +217,34 @@ sub change_for { =20 } =20 +sub help { + return <<"EOF"; +package_log.pl + +USAGE: + + package_log.pl PACKAGE [PACKAGE*] [--all] [--help] [--changes] [--deps= ] [--trace] + + ie: + + # Just show the recent log for Moose, Catalyst-Runtime and Dist-Zilla + package_log.pl Moose Catalyst-Runtime Dist-Zilla + + # show all log events for Moose + package_log.pl Moose --all + + # show recent Moose log events with attached changelog data and depend= enices + package_log.pl Moose --changes --deps + + # Be verbose about what we're doing + package_log.pl Moose --trace --all + + --all Show all releases in the log. + --help Show this message + --changes Show ChangeLog Excerpts using CPAN::Changes where possible + --deps Show Dependency data ( as reported via metadata ) + --trace Turn on extra debugging. +EOF + +} +