#!/usr/bin/perl use 5.001 ; use strict ; use warnings ; use Getopt::Std ; getopts ':~+12f' , \my %o ; use autodie qw[ open ] ; my %first ; # 最åˆã«è¦‹ãŸ my %last ; unshift @ARGV , splice @ARGV , 1 , 1 if $o{'~'} ; # æ¡ä»¶æ¬¡ç¬¬ã§å…ˆé ã¨ãã®æ¬¡ã‚’入れ替ãˆã‚‹ã€‚ open my $FH , '<' , shift @ARGV ; $SIG{ INT } = sub { close $FH ; exit 130 } ; while ( <$FH> ) { chomp ; $first { $_ } //= $. ; $last { $_ } = $. unless $o{f} ; } close $FH ; #$. = 0 ; while ( <> ) { chomp ; if ( exists $first { $_ } ) { delete $first { $_ } } elsif ( $o{'+'} ) { $first { $_ } = "+$." ; } } unless ( $o{':'} ) { for ( sort keys %first ) { print "$_\n" ; } } else { for ( sort { $first{$a} <=> $first{$b} } keys %first ) { my $prefix = do { ! exists $last{$_} || $o{1} && $first{$_} eq $last{$_} ? "$first{$_}" : "$first{$_}-$last{$_}" } ; print "$prefix:\t$_\n" ; } } =encoding utf8 =head1 $0 file1 file2 $0 file1 < file2 cat file2 | $0 file1 file1 ã®ã©ã“ã‹ã®è¡Œã«ã‚ã£ã¦ã€file2 ã«ãªã„ã‚‚ã®ã‚’抽出ã™ã‚‹ã€‚ ãƒ¡ãƒ¢ãƒªã®æ¶ˆè²»ã¯ã€file1ã®å„行ã®ç•°ãªã‚‹è¡Œã®æ•°ã«å¿œã˜ãŸã‚‚ã®ã«ãªã‚‹ã€‚ オプション : -~ : file1 㨠file2 ã®é †åºã‚’交æ›ã™ã‚‹ã€‚ -: : 出力ã®éš›ã«ã€å„è¦ç´ ãŒæœ€å¾Œã«ä½•行目ã«ç¾ã‚ŒãŸã‹ã‚’出力ã™ã‚‹ã€‚ -1 ; 出力ã®å„è¦ç´ ã®ã€å‡ºç¾è¡Œç•ªå·ã®æœ€åˆã¨æœ€å¾ŒãŒä¸€è‡´ã™ã‚‹å ´åˆã¯ã€ã²ã¨ã¤ã«ã¾ã¨ã‚る。 -f ; æœ€åˆæ„外ã¯è¦‹ãªã„ã“ã¨ã§ã€ãƒ¡ãƒ¢ãƒªã®æ¶ˆè²»ã‚’抑制ã™ã‚‹ã€‚ -+ ; file2 ã«ã‚ã£ã¦ã€file1 ã«ã¯ãªã‹ã£ãŸè¡Œè¦ç´ も抽出ã™ã‚‹ã€‚ã“ã®å ´åˆã¯ã€-: ã®è¡Œç•ªå·å‡ºåŠ›æŒ‡å®šæ™‚ã«ã€+記å·ã‚’ä»˜åŠ ã™ã‚‹ã€‚ 開発上ã®ãƒ¡ãƒ¢ : -2 ã§ã€æ¨™æº–エラー出力ã«ã€é€†ã®å·®åˆ†ã®çµæžœã‚’出ã—ãŸã„。 =cut ## ãƒ˜ãƒ«ãƒ—ã®æ‰±ã„ sub VERSION_MESSAGE {} sub HELP_MESSAGE { use FindBin qw[ $Script ] ; $ARGV[1] //= '' ; open my $FH , '<' , $0 ; while(<$FH>){ s/\$0/$Script/g ; print $_ if s/^=head1// .. s/^=cut// and $ARGV[1] =~ /^o(p(t(i(o(ns?)?)?)?)?)?$/i ? m/^\s+\-/ : 1; } close $FH ; exit 0 ; }