Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/env perl
- use warnings;
- use strict;
- use 5.010;
- my @CMPMODS = ( 'CPAN::Version' => 'CPN' => sub {
- return CPAN::Version->vcmp( @_ );
- },
- 'version' => 'VRM' => sub {
- return version->parse( $_[0] ) cmp version->parse( $_[1] );
- },
- 'ALPM' => 'PAC' => \&ALPM::Package::vercmp,
- );
- # Zero-pads version strings to make pacman happy.
- sub archify_verstr
- {
- my ( $ver ) = @_;
- return archify_verstr( $1 ) . $2 if $ver =~ /\A([^_]+)(_.*)\z/;
- # Bye bye letters.
- $ver =~ tr/.0-9//cd;
- # This makes perl's vercmp match pacmans's.
- # return "$ver.0" if $ver =~ /\A\d+[.]\d+\z/;
- # Decimal versions are padded to 6 decimal spaces (if needed).
- return $ver . q{0} x (6 - length $1) if $ver =~ /\A\d+[.](\d+)\z/;
- return $ver;
- }
- sub cpan_to_pacman
- {
- my $ver = shift;
- return 'undef' if not defined($ver);
- # Check if the version is parsable via the "version" module. If not, return
- # "undef".
- if ($ver !~ m/^$version::STRICT$/ and $ver !~ m/^$version::LAX$/)
- {
- # print STDERR "Invalid version string: $ver\n";
- return 'undef';
- }
- $ver = version->parse($ver)->numify;
- # Underscores are considered "alpha" versions. Replace them with "a" so that
- # Pacman treats them as alpha versions too.
- $ver =~ s/_/a\./;
- # Versions that expand to 6 decimal places should be broken up into 2 groups
- # of 3 digits. See the "Decimal Versions" section of the "version::Internals"
- # POD.
- $ver =~ s/(?<=\.)(\d{3})(\d{3})$/${1}.${2}/;
- return $ver;
- }
- my @CONVERSIONS = ( 'ORIG' => sub { shift },
- 'PAD0' => \&archify_verstr,
- 'XYNE' => \&cpan_to_pacman,
- );
- my $LINEFMT;
- sub load_cmpmods
- {
- my (@labels, @loaded);
- LOAD_LOOP:
- while ( @CMPMODS ) {
- my ( $modname, $label, $cmp_ref ) = splice @CMPMODS, 0, 3;
- eval "require $modname" or next LOAD_LOOP;
- push @labels, $label;
- push @loaded, $cmp_ref;
- }
- return (\@loaded, \@labels);
- }
- #---HELPER FUNCTION---
- sub cmpchar
- {
- my ($cmp) = @_;
- return $cmp unless $cmp =~ /\A-?\d+\z/;
- return ( $cmp < 0 ? q{<} :
- $cmp == 0 ? q{=} :
- $cmp > 0 ? q{>} :
- die );
- }
- sub print_cmps
- {
- my ($leftver, $rightver, $cmps_ref) = @_;
- my @cmpresults = ( map { cmpchar( $_ ) }
- map { eval { $_->( $leftver, $rightver ) } // '?' }
- @$cmps_ref );
- my $cmps_match = 1;
- my $first = $cmpresults[0];
- CHECK_LOOP:
- for my $i ( 1 .. $#cmpresults ) {
- unless ( $cmpresults[ $i ] eq $first ) {
- $cmps_match = 0;
- last CHECK_LOOP;
- }
- }
- printf $LINEFMT, $leftver, $rightver, @cmpresults,
- ( $cmps_match ? q{:)} : q{:(} );
- }
- #-----------------------------------------------------------------------------
- # SCRIPT START
- die <<"END_USAGE" if grep { /-{1,2}h(?:elp)?/ } @ARGV;
- Usage:
- $0 <name of version list file>
- OR
- cat <name of version list file> | $0
- Version list files are text files with versions separated by
- whitespace. Every two versions that are read are compared
- together. One comparison is done with the origin version strings and
- the other is with the "normalized" version. You can supply paths to
- version files as arguments or pipe/type them into STDIN.
- -juster
- END_USAGE
- # Load what comparators (?) we are able to.
- my ($cmps_ref, $lbls_ref) = load_cmpmods();
- # Print simple column headers to tell which is which.
- printf "%43s %s | EQ?\n", q{|}, ( join q{ }, @$lbls_ref );
- # Line format is different depending on the number of results we can get.
- $LINEFMT = qq{%15s cmp %-15s | } .
- ( join q{ }, ( q{%1s} ) x scalar @$lbls_ref )
- . qq{ | %s\n};
- my @verstrs;
- while( <> ) {
- push @verstrs, split;
- while ( @verstrs > 1 ) {
- my ($leftver, $rightver) = splice @verstrs, 0, 2;
- my ($cname, $csub_ref);
- my $i = 0;
- while ( $i <= $#CONVERSIONS ) {
- $cname = $CONVERSIONS[ $i++ ];
- $csub_ref = $CONVERSIONS[ $i++ ];
- print "$cname: ";
- print_cmps( $csub_ref->( $leftver ),
- $csub_ref->( $rightver ),
- $cmps_ref );
- }
- }
- }
- if ( @verstrs ) {
- warn <<"END_WARN"
- Warning: The last version (@verstrs) had no versions following it to compare.
- END_WARN
- }
Add Comment
Please, Sign In to add comment