view release on metacpan or  search on metacpan

12567834  view on Meta::CPAN

$o{c} //= 100 ;  # 「ページ指定」受付最大文字列長さ
$o{b} //= 1 ; 
 # 入力ファイルがもしもAdobe生成されたときに「ページサイズと処理」で「複数」の指定を受けたあとだったときに
 # 2や 4などの適切な値(1枚辺りの元のページ数)を指定する
my $p1 ; # 元のPDFファイルの最初のページ番号
my $p2 ; # 元のPDFファイルの最後のページ番号
my $p2a ; # $p2+1 以下の、 $p2a - $p1 が4の倍数となる最大の数。

# コマンド引数から、与え方に応じて3通りに、ページ数の最初と最後を取り出す。
($p1,$p2) = $ARGV[0] =~ m/(.*)(-|\.\.)(.*)/ ? ($1,$3) : exists $ARGV[1] ? @ARGV : (1,$ARGV[0]) ; 
exit if map {say "'$_' seems not a numbper."} grep { ! looks_like_number $_ } ($p1,$p2) ;
exit if  $p1 > $p2 && say "'$p1 <= $p2' does not hold." ;


 
# 最後に出力する紙の処理 および 出力枚数の算出
my $pr = ($p2-$p1+1) % 4 ; # reminder 余り
$p2a = $p2 - $pr + 1 ; 
my $q = ($p2a-$p1) / 4 ; 

my @P0 = () ; 
my @P1 = () ; 

12567834  view on Meta::CPAN

sub M ($) ; 
* M = ($o{b} // 1 ) eq 1 ? sub ($) { $_[0] } : sub ($) { ( $_[0] - 1 ) * $o{b} + 1 } ; 
* con = $o{','} ? sub { map { M $_ } $_[0] .. $_[1] } : sub { ( M $_[0] ) . '-' . ( M $_[1] ) } ; # 関数を定義。-でつなげるか、,でつなげるか
* con2 = sub { $p2a < $p2 ? join "," , con ($p2a,$p2)  : "$p2" } ;

if ( $o{p} ) {
  my @P ; 
  my $out = "pdftk INPUT.pdf cat " ; 
  $p=$p1-1;splice @P,@P/2,0,$p+1..($p+=4)for 1..$q;$out .= join" ",@P ;
  $out .= " output OUTPUT.pdf" ;
  say $out ; 
  print "# Page " . con2($p2a, $p2)  . " has not contained above." if $pr ; 
  say "# The above contains " . length ($out) . " characters." ;  
  $o{2}//= 0 ; 
  exit ; 
}


say CYAN + (map { join '', 1..9,($_% 10 ) } ( 1..$o{c}/10) ) , 1..$o{c} % 10 if ($o{2}//'')ne"0"; # 文字列長さの定規
for ( 1 .. $q ) {
  @P0 = @P1  ;
  splice @P0 , @P0/2 , 0 , con($p,$p+3) ; # $p . "-" . ($p+3) ; # 試しに1度に4ページ挿入。
  if ( length ( $o0 = join "," , @P0 ) > $o{c} ) 
    { say $o1 ; $o0 = '' ; @P1 = () ; @P0 = con($p,$p+3) ; $L++ }  ; # 長すぎたら出力。
  splice @P1 , @P1/2 , 0 , con($p++,$p++) , con($p++,$p++) ;
  $o1 = $o0 ;  
}
do { say join "," , @P0 ; $L ++ } if @P0  ; 
#print $p2a < $p2 ? (join",",con($p2a,$p2))."\n" : $p2a == $p2 ? "$p2\n" : '' ; # 最後のページの出力。4の倍数か否か、1枚だけか否かにより、3通りに分けた。
#print $p2a > $p2 ? '' : con2 ( $p2a , $p2 ) . "\n" ; 
$L ++ and say con2($p2a,$p2)  if $pr ;  
exit ;

END {
  exit if ($o{2}//'') eq "0" ; 
  my $procsec = sprintf "%.5f", tv_interval ${ dt_start } ; #time - $time0 ; # このプログラムの処理にかかった秒数。比較する2個の時刻は秒単位なので、±1秒未満の誤差は発生する。
  my $s = tv_interval $dt_start , [ gettimeofday ] ; 
  say STDERR BOLD FAINT ITALIC " -- $Script ; " . $procsec . " seconds in process. " . $L. " lines output." ;
}

## ヘルプの扱い
sub VERSION_MESSAGE {}
sub HELP_MESSAGE {
  use FindBin qw[ $Script ] ; 
  $ARGV[1] //= '' ;
  open my $FH , '<' , $0 ;
  while(<$FH>){
    s/\$0/$Script/g ;