view release on metacpan or  search on metacpan

scripts/keycommon  view on Meta::CPAN

#!/usr/bin/perl
use 5.001 ; use strict ; use warnings ; 
use Getopt::Std ; getopts '0:12:cf:nr_~/:' , \my%o ; 
use Scalar::Util qw/looks_like_number/ ;
use Term::ANSIColor qw/:constants/ ; $Term::ANSIColor::AUTORESET = 1 ; 

my $sep = $o{'/'} // "\t" ; # 入出力の区切り文字
my $empty = $o{0} // 'undef' ;   # 対応する値が無い場合の代替の値 
my $cutpos = $o{f} // 1 ;	 # 各行を左から何番目の列で切るか
my %val ; # $val{ キーの値 } [ ファイル番号 ] = バリューの値 
my $pole = 0 ; 
my $Flst = (defined $o{2} && $o{2} =~ m/\./ ) ; # 各ファイルで同じキーが出現した場合に最後のバリューを採用するかどうかのフラグ
my $Fcon = (defined $o{2} && $o{2} =~ m/:/ ) ; # 各ファイルで同じキーが出現した場合に最後のバリューを採用するかどうかのフラグ
my (@keg1,%keg1) ; # -1 が指定された場合、キーが最初に読まれた順に、出力の順序を一致させる、ために使う変数

scripts/keycommon  view on Meta::CPAN

        elsif ($Fcon) { grep { if ( defined $_ ) { $_ .= ":$value" } else { $_ = $value } } $val{ $key } [ $pole ] }  
        else { $val{ $key } [ $pole ] //= $value } ; # キー(1列目)ごとに ファイル番号を表す $pole ごとに値(2列目)を格納。
    }
}

sub outputting { 
    my @keg = keys %val unless $o{1} ; 
    @keg = 
        $o{1} ? @keg1 : 
        $o{n} ? 
            (@{[sort {$a <=> $b} grep {   looks_like_number($_) } @keg ]} ,  
                sort {$a cmp $b} grep { ! looks_like_number($_) } @keg   ) : 
           sort @keg ;  
     
    @keg = reverse @keg if $o{r} ;

    *UNDERLINE = sub {@_} unless $o{'_'} ;
    for my $k ( @keg ) { 
        print scalar @{[grep {defined $_} @{$val{$k}} ]}, "\t" if $o{c} ;
        print UNDERLINE $k ;
        print join $sep , '' , map {  $val{$k}[$_] // $empty } 0 .. $pole -1 ; 
        print "\n" ;