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 が指定された場合、キーが最初に読まれた順に、出力の順序を一致させる、ために使う変数
&reading ; 
&outputting ; 
exit 0 ;

sub reading { 
    while ( <> ) { 
        chomp ;
        do { ++ $pole ; next } if eof || m/^$/ ;  # 複数のデータセットに対する処理 
        my @F = split /$sep/ , $_ ,  $cutpos + 1 ; 
        my $key = join $sep , splice @F , 0 , $cutpos ;# 先頭のみ束ねる。
        my $value = $F[0] // ''  ; # 残ったものを束ねる。
        ( $key , $value ) = ( $value , $key ) if $o{'~'} ; 

        do { push @keg1 , $key unless $keg1 { $key } ++ } if $o{1} ; 
        if ( $Flst ) { $val{ $key } [ $pole ] = $value }  # キー(1列目)ごとに ファイル番号を表す $pole ごとに値(2列目)を格納。
        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" ; 
    }
}

sub VERSION_MESSAGE {}
sub HELP_MESSAGE{
    $0=~s|.*/|| ; $ARGV[1] //= '' ;
    while(<DATA>){
        s/\$0/$0/g ;
        print $_ if $ARGV[1] =~ /opt/ ? m/^\ +\-/ : s/^=head1// .. s/^=cut// ; 
    }
    exit 0 ;
}

__END__ 

=encoding utf8 

=head1

    $0 

入力: 
   1列目はキーで2列目は参照値を持つ、空行区切りまたは複数のファイルによる
   複数のデータセット。
   ただし、ひとつひとつのデータセットにおいて、キーは全て異なるとしている。

出力: 
   1列目はキーの合併集合。i行目1列目はキーの値 k[i] 。
   i行 j+1列目の値は、j番目のデータセットにおける
   キー k[i] に対する参照値となる。
 
オプション: 
    -/ str : 区切り文字をタブから指定した変更する。
    -~ : キーとバリューを反転する。(左側をバリュー、右側をキーとみなす。) 
    -_ : キーに下線を引く。ANSIカラーエスケープコードを使用している。
    -c : 各キーに該当するファイルの個数を行の先頭に表示する。(このことで共通集合を検出するトリッキーなこともできる。)
    -f num : キーとバリューを分離する位置を指定する。未指定なら1であり、その場合、最左列とそれ以外に分ける。
    -n : キーの出力順序に関して、最初に数値については数の順序でソートし、その次に数値以外を文字列で整列する。
    -r : キーの出力順序を逆にする。

    -0 str : 空欄に埋める文字列。たとえば0を指定する。未指定ならundef。
    -1  : 出力する順序に関して、キーの順番は、入力で読み取るときに最初に読みとったキーの順に一致させる。(-r指定があれば逆になる。)
    -2 str : １つのデータセット(通常はファイル)に、同じキーが2回以上現れた場合の挙動を str で指定。 
    -2 1 : パラメータ文字列に 1の文字が含まれていたら、同じファイルで同じキーに2番目以降に出現した値は初めの値を採用する。
    -2 . : パラメータ文字列に ピリオド(.) が含まれていたら、同じファイルに同じキーに2番目以降に出現した値は最後の値を採用する。
    -2 : : パラメータ文字列に コロン(:) が含まれていたら、同じファイルに同じキーに現れる全ての値が : で連結される。(<-- あまりきれいでないかも)

    --help : このヘルプを表示する。

その他: