user-tools/cled

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 cled - Command Line-Editor - Edit text file lines by commands directly from shell
   8
   9 =head1 SYNOPSIS
  10
  11  cled [<OPTIONS>] <EXPR> [<EXPR> [...]] [-- <FILE> [<FILE> [...]]]
  12
  13 =head1 DESCRIPTION
  14
  15 Each EXPR expression consist of an optional SELECTOR term and a command
  16 and variable number of arguments depending on the command
  17 (see COMMANDS section), like:
  18
  19  <SELECTOR>[..<SELECTOR>] <COMMAD> [<ARG> [<ARG> [...]]]
  20
  21 You may narrow the COMMAND's effect by a SELECTOR term.
  22 A SELECTOR selects either one line or a closed range of lines.
  23 For ranges, put C<..> (double dot) between SELECTORs.
  24 A SELECTOR may be a regexp, ie. C</PATTERN/[MODIFIERS]>,
  25 or a line number, or the literal word C<last> which means the last line.
  26 SELECTOR syntax:
  27
  28  [ /<REGEXP>/[<MODIFIERS>][[+ | -]<OFFSET>] | <LINE> | last[-<OFFSET>] ]
  29
  30 Examples:
  31
  32  10../lorem/i
  33
  34 Select line 10 and all subsequent lines down to the first one matching
  35 to case-insensitive "lorem".
  36
  37  /begin/../end/
  38
  39 Select the lines between /begin/ and /end/ inclusively.
  40
  41  /begin/+1../end/-1
  42
  43 Select the lines between /begin/ and /end/ exclusively.
  44
  45 The 2nd SELECTOR does not get tested on the same line as the 1st
  46 SELECTOR.
  47 So you can select at least a 2-lines long range by eg. C</start/../stop/>.
  48 If the 2nd SELECTOR is REGEXP and it does not match any lines, then
  49 practically it's an open-ended range, so the rest of the file is
  50 selected.
  51 Line numbers are indexed from 0.
  52
  53 REGEXP and the C<last> SELECTOR have an optional OFFSET: eg. C</begin/+2>
  54 selects the 2nd line following a line matching to /begin/. The C<last>
  55 SELECTOR obviously supports only negative OFFSETs.
  56
  57 An EXPR expression can be a group denoted by brackets,
  58 in which there are subexpressions like EXPR.
  59 This way you can do multiple COMMAND commands, all when the common
  60 SELECTOR matches to the line in order:
  61
  62  /^d/ [ ltrim prepend " " ]
  63
  64 Which removes all leading whitespace, if any, from lines starting with
  65 "d" and inserts a single space at the beginning of all of them.
  66 See COMMANDS below for all the supported editor commands.
  67
  68 Currently 3 type of brackets are supported: C<[ ... ]> square,
  69 C<{ ... }> curly, and C<( ... )> parenthesis. Use the square one to
  70 save shell escaping.
  71
  72 =head1 OPTIONS
  73
  74 =over 4
  75
  76 =item -f, --file PATH
  77
  78 File to edit.
  79 May specify multiple times.
  80 Files are edited in-place by default, by persisting their Inode,
  81 ie. buffer the output data and write to the original input file
  82 when it's all read up.
  83 If --output option(s) is (are) given, then the file(s) won't be
  84 modified in-place, rather than saved in output file(s).
  85 If not given any --file, works on STDIN and print to STDOUT.
  86
  87 =item -o, --output PATH
  88
  89 File to save modified data into.
  90 May specify multiple times.
  91 If less --output parameters given than --file, then the input files
  92 without a corresponding output file will be edited in-place.
  93
  94 =item -c, --confirm
  95
  96 Prompt for confirmation for each selected line.
  97 If a readline module is installed then you may do further changes to the
  98 lines interactively.
  99 Term::ReadLine::Gnu(3pm) module is recommended.
 100
 101 Press Ctrl-J to insert newline (LF) at the cursor position,
 102 as it's not added automaticaly to the end of line.
 103
 104 If no readline module available, press only a single Enter to accept
 105 changes, and Ctrl-C to revert to the original line, or type in new
 106 content and press Enter to replace the promped line (newline is added
 107 to the end in this case).
 108 Additionally an inverse space char at the end of line indicates if the last
 109 line is not terminated by a newline.
 110
 111 =item -v, --verbose
 112
 113 Print edited lines to STDERR.
 114 Prefixed with line number if option C<-l> is given.
 115 A line is edited if it's selected by any SELECTOR and not reverted
 116 thereafter at the interactive prompt.
 117
 118 =item -l
 119
 120 Show line numbers in verbose mode.
 121
 122 =back
 123
 124 =cut
 125
 126
 127 use Data::Dumper;
 128 use Getopt::Long qw/:config no_ignore_case bundling pass_through/;
 129 use feature qw/switch/;
 130 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
 131 use Pod::Usage;
 132 # Term::ReadLine::Gnu is recommended
 133 $readline_support = eval q{ use Term::ReadLine; 1; };
 134 use POSIX;
 135
 136 $0 =~ s/.*\/([^\/]+)$/$1/;
 137 $OptConfirm = 0;
 138 $OptVerbose = 0;
 139 $OptVerboseLnum = 0;
 140 @Files = ();
 141 @Output = ();
 142
 143 # Getopt::Long(3perl)
 144 # When configured for bundling, single-character options are matched
 145 # case sensitive while long options are matched case insensitive.
 146
 147 $SIG{'__WARN__'} = sub { warn "$0: $_[0]"; };
 148 GetOptions(
 149         'c|confirm' => \$OptConfirm,
 150         'f|file=s@' => \@Files,
 151         'help|?' => sub{ pod2usage(-exitval=>0, -verbose=>99); },
 152         'o|output=s@' => \@Output,
 153         'v|verbose' => \$OptVerbose,
 154         'l' => \$OptVerboseLnum,
 155 ) or exit 2;
 156 delete $SIG{'__WARN__'};
 157
 158
 159 sub readline_insert_lf
 160 {
 161         my $pos = $readline->Attribs->{'point'};
 162         my $buf = $readline->Attribs->{'line_buffer'};
 163         $readline->Attribs->{'line_buffer'} = substr($buf, 0, $pos)."\n".substr($buf, $pos);
 164         $readline->Attribs->{'point'} += 1;
 165 }
 166
 167 if($readline_support)
 168 {
 169         $readline = Term::ReadLine->new('cled');
 170         $readline->ornaments(0);
 171         $readline->add_defun('insert_lf', \&readline_insert_lf);
 172         $readline->bind_keyseq('\\C-j', 'insert_lf');
 173         $readline->variable_bind('echo-control-characters', 0);
 174 }
 175
 176 sub select_by_match
 177 {
 178         my $state = shift;
 179         return ${$state->{'line_ref'}} =~ /(?$_[1])$_[0]/;
 180 }
 181 sub select_line_eq
 182 {
 183         my $state = shift;
 184         return $state->{'line_num'} == $_[0];
 185 }
 186 sub select_line_num_cmp
 187 {
 188         my $state = shift;
 189         return $state->{'line_num'} <=> $_[0];
 190 }
 191 sub select_never
 192 {
 193         return 0;
 194 }
 195 sub select_always
 196 {
 197         return 1;
 198 }
 199
 200 sub add_selector
 201 {
 202         my $selector_expr = shift;
 203         my $ref = shift;
 204         my ($match_expr, $offset) = $selector_expr =~ /^(.+?)([+-]\d+|)$/;
 205         given($match_expr)
 206         {
 207                 when(/^\d+$/)
 208                 {
 209                         $ref->{'sub'} = \&select_line_eq;
 210                         $ref->{'relative_sub'} = \&select_line_num_cmp;
 211                         $ref->{'arg'} = [int $match_expr];
 212                 }
 213                 when('last')
 214                 {
 215                         $ref->{'sub'} = \&select_never;
 216                 }
 217                 when(m{^/(.*)/([[:alpha:]]*)$})
 218                 {
 219                         my ($pattern, $modifiers) = ($1, $2);
 220                         eval { "" =~ /(?$modifiers)$pattern/; 1; };
 221                         die "$0: $selector_expr: $@" if $@;
 222                         $ref->{'sub'} = \&select_by_match;
 223                         $ref->{'arg'} = [$pattern, $modifiers];
 224                 }
 225                 default
 226                 {
 227                         if($selector_expr eq '')
 228                         {
 229                                 $ref->{'sub'} = \&select_always;
 230                         }
 231                         else
 232                         {
 233                                 die "$0: should not happen.";
 234                         }
 235                 }
 236         }
 237         $ref->{'offset'} = int($offset || 0);
 238 }
 239
 240
 241 =pod
 242
 243 =head1 COMMANDS
 244
 245 =over 4
 246
 247 =item s/<PATTERN>/<REPLACEMENT>/[<MODIFIERS>]
 248
 249 Regexp substitution. Works just like in perl(1). See perlre(1).
 250
 251 =cut
 252
 253
 254 # define how many arguments each edit_* subroutine expects from the CLI
 255 # by putting eg. $NumberOfCliArgs{'xyz'}=2 before "sub edit_xyz".
 256 # Omit if does not need any CLI argument.
 257 %NumberOfCliArgs = ();
 258
 259 =pod
 260
 261 =item edit
 262
 263 Edit selected lines interactively by a readline interface.
 264 See --confirm option in OPTIONS section for details.
 265
 266 =cut
 267
 268 sub edit_edit
 269 {
 270         my $state = shift;
 271         $state->{'confirm'} = 1;
 272 }
 273
 274 =pod
 275
 276 =item delete
 277
 278 Delete matching line(s).
 279
 280 =cut
 281
 282 sub edit_delete
 283 {
 284         my $state = shift;
 285         ${$state->{'line_ref'}} = '';
 286 }
 287
 288 =pod
 289
 290 =item ltrim, rtrim, trim
 291
 292 Remove leading (ltrim), trailing (rtrim), or leading and trailing (trim) whitespace from the line.
 293 End-of-line char (LF, \n) is preserved.
 294
 295 =cut
 296
 297 sub edit_trim
 298 {
 299         edit_ltrim(@_);
 300         edit_rtrim(@_);
 301 }
 302 sub edit_ltrim
 303 {
 304         my $state = shift;
 305         ${$state->{'line_ref'}} =~ s/^\s*//;
 306 }
 307 sub edit_rtrim
 308 {
 309         my $state = shift;
 310         my $eol = '';
 311         ${$state->{'line_ref'}} =~ /(\n)$/ and $eol = $1;
 312         ${$state->{'line_ref'}} =~ s/\s*$//;
 313         ${$state->{'line_ref'}} .= $eol;
 314 }
 315
 316 =pod
 317
 318 =item replace STR1 STR2
 319
 320 Replace all STR1 to STR2.
 321
 322 =cut
 323
 324 $NumberOfCliArgs{'replace'} = 2;
 325 sub edit_replace
 326 {
 327         my $state = shift;
 328         ${$state->{'line_ref'}} =~ s/\Q$_[0]\E/$_[1]/g;
 329 }
 330
 331 =pod
 332
 333 =item replaceword STR1 STR2
 334
 335 Replace whole word STR1 to STR2.
 336
 337 =cut
 338
 339 $NumberOfCliArgs{'replaceword'} = 2;
 340 sub edit_replaceword
 341 {
 342         my $state = shift;
 343         ${$state->{'line_ref'}} =~ s/\b\Q$_[0]\E\b/$_[1]/g;
 344 }
 345
 346 =pod
 347
 348 =item replaceline STR
 349
 350 Replace the whole line to STR.
 351
 352 =cut
 353
 354 $NumberOfCliArgs{'replaceline'} = 1;
 355 sub edit_replaceline
 356 {
 357         my $state = shift;
 358         my $eol = '';
 359         ${$state->{'line_ref'}} =~ /(\n)$/ and $eol = $1;
 360         ${$state->{'line_ref'}} = $_[0];
 361         ${$state->{'line_ref'}} .= $eol;
 362 }
 363
 364 =pod
 365
 366 =item prepend STR
 367
 368 Prepend STR to the line.
 369
 370 =cut
 371
 372 $NumberOfCliArgs{'prepend'} = 1;
 373 sub edit_prepend
 374 {
 375         my $state = shift;
 376         ${$state->{'line_ref'}} = $_[0] . ${$state->{'line_ref'}};
 377 }
 378
 379 =pod
 380
 381 =item insertline STR
 382
 383 Insert STR as a whole line before the matching line(s).
 384 Line numbering is preserved as there was not an inserted line,
 385 ie. line numbers are not incremented.
 386
 387 =cut
 388
 389 $NumberOfCliArgs{'insertline'} = 1;
 390 sub edit_insertline
 391 {
 392         my $state = shift;
 393         ${$state->{'line_ref'}} = $_[0] . "\n" . ${$state->{'line_ref'}};
 394 }
 395
 396 =pod
 397
 398 =item insertfile PATH
 399
 400 Insert the content of PATH file before the matching line(s).
 401 The last line of PATH file will be separated from the matched line by a
 402 newline (LF) either way.
 403 Line numbering is preserved as described above.
 404
 405 =cut
 406
 407 $NumberOfCliArgs{'insertfile'} = 1;
 408 sub edit_insertfile
 409 {
 410         my $state = shift;
 411         open my $fh, '<', $_[0] or die "$_[0]: $!\n";
 412         local $/ = undef;
 413         my $filecontent = <$fh>;
 414         close $fh;
 415         my $eol = $filecontent =~ /\n$/ ? '' : "\n";
 416         ${$state->{'line_ref'}} = $filecontent . $eol . ${$state->{'line_ref'}};
 417 }
 418
 419 =pod
 420
 421 =item append STR
 422
 423 Append STR to the line.
 424
 425 =cut
 426
 427 $NumberOfCliArgs{'append'} = 1;
 428 sub edit_append
 429 {
 430         my $state = shift;
 431         my $eol = '';
 432         ${$state->{'line_ref'}} =~ s/(\n)$// and $eol = $1;
 433         ${$state->{'line_ref'}} .= $_[0];
 434         ${$state->{'line_ref'}} .= $eol;
 435 }
 436
 437 =pod
 438
 439 =item appendline STR
 440
 441 Append STR as a whole line to the matching line(s).
 442 Line numbering is preserved as described above.
 443
 444 =cut
 445
 446 $NumberOfCliArgs{'appendline'} = 1;
 447 sub edit_appendline
 448 {
 449         my $state = shift;
 450         ${$state->{'line_ref'}} .= $_[0] . "\n";
 451 }
 452
 453 =pod
 454
 455 =back
 456
 457 =cut
 458
 459 sub cled_eval
 460 {
 461         my $state = shift;
 462         eval $_[0];
 463 }
 464
 465 sub signal_int_handler
 466 {
 467         die "SIGINT\n";
 468 }
 469
 470
 471 @Commands = ();
 472 @group_selectors = ();
 473
 474 ArgumentParsing:
 475 while(@ARGV)
 476 {
 477         my $ThisCmd = {};
 478         my $selector = {};
 479
 480         if($ARGV[0] eq '--')
 481         {
 482                 shift @ARGV;
 483                 push @Files, @ARGV;
 484                 last;
 485         }
 486
 487         if(my ($selector_start, $selector_stop) = $ARGV[0] =~ m{^(/.*/[[:alpha:]]*(?:[+-]\d+|)|\d+)\.\.(/.*/[[:alpha:]]*(?:[+-]\d+|)|\d+|last(?:-\d+|))$})
 488         {
 489                 $selector->{'repr'} = $ARGV[0];
 490                 $selector->{'start'} = {};
 491                 add_selector $selector_start, $selector->{'start'};
 492                 $selector->{'stop'} = {};
 493                 add_selector $selector_stop, $selector->{'stop'};
 494                 shift @ARGV;
 495         }
 496         elsif(my ($selector_expr) = $ARGV[0] =~ m{^(/.*/[[:alpha:]]*(?:[+-]\d+|)|\d+)$})
 497         {
 498                 # FIXME: make it possible to select the last line (single selector)
 499                 # TODO: last-N to select the last but Nth line (buffering required)
 500                 # FIXME: fix /asd/-1..5 style selectors
 501                 $selector->{'repr'} = $ARGV[0];
 502                 $selector->{'single'} = {};
 503                 add_selector $selector_expr, $selector->{'single'};
 504                 shift @ARGV;
 505         }
 506
 507         if($ARGV[0] ~~ ['[', '(', '{'])
 508         {
 509                 if(not %$selector)
 510                 {
 511                         $selector->{'repr'} = '';
 512                         $selector->{'single'} = {};
 513                         add_selector '', $selector->{'single'};
 514                 }
 515                 push @group_selectors, $selector;
 516                 shift @ARGV;
 517                 next;
 518         }
 519
 520         if($ARGV[0] ~~ [']', ')', '}'])
 521         {
 522                 die "$0: selector without a command: $selector->{'repr'}\n" if %$selector;
 523                 pop @group_selectors or die "$0: too many closing brackets\n";
 524                 shift @ARGV;
 525                 next;
 526         }
 527
 528         my $editcmd = shift @ARGV or die "$0: missing command\n";
 529
 530         given($editcmd)
 531         {
 532                 if(@group_selectors)
 533                 {
 534                         my @group_selectors_copy;
 535                         for my $sel_ref (@group_selectors)
 536                         {
 537                                 my %sel = %$sel_ref;
 538                                 push @group_selectors_copy, \%sel;
 539                         }
 540                         push @{$ThisCmd->{'selectors'}}, @group_selectors_copy;
 541                 }
 542                 if(%$selector)
 543                 {
 544                         push @{$ThisCmd->{'selectors'}}, $selector;
 545                 }
 546
 547                 when(m{^(s/.*/.*/.*)$})
 548                 {
 549                         $ThisCmd->{'editor'} = {'sub' => \&cled_eval, 'arg' => [sprintf('${$state->{"line_ref"}} =~ %s',$1)],};
 550                 }
 551                 default
 552                 {
 553                         my $edit_sub = sprintf 'edit_%s', $editcmd;
 554                         if(not exists &$edit_sub)
 555                         {
 556                                 die "$0: unknown editor command or selector: $editcmd\n";
 557                         }
 558
 559                         my @cli_args = ();
 560                         my $num_args = $NumberOfCliArgs{$editcmd};
 561                         if($num_args)
 562                         {
 563                                 @cli_args = @ARGV[0..$num_args-1];
 564                                 shift @ARGV for 0..$num_args-1;
 565                         }
 566
 567                         $ThisCmd->{'editor'} = {'name' => $editcmd, 'sub' => \&{$edit_sub}, 'arg' => \@cli_args};
 568                 }
 569         }
 570
 571         $ThisCmd->{'n'} = scalar @Commands;
 572         push @Commands, $ThisCmd;
 573 }
 574
 575 undef @group_selectors;
 576 #warn Dumper \@Commands;
 577
 578
 579 # if no readline support and --confirm requested or any of the editor commands is 'edit'
 580 if(not $readline_support and ($OptConfirm or grep {$_->{'editor'}->{'sub'} eq \&edit_edit} @Commands))
 581 {
 582         open $terminal_fh, '<', '/dev/tty' or die "$0: /dev/tty: $!\n";
 583 }
 584
 585
 586
 587 sub filehandler_write
 588 {
 589         my $event = shift;
 590         my $data = shift;
 591         my $meta = shift;
 592         if($event eq 'append')
 593         {
 594                 return print {$meta->{'fh'}} $data;
 595         }
 596         return 1;
 597 }
 598
 599 sub buffered_overwrite
 600 {
 601         my $event = shift;
 602         my $data = shift;
 603         my $meta = shift;
 604         given($event)
 605         {
 606                 when('start')
 607                 {
 608                         $meta->{'buffer'} = '';
 609                 }
 610                 when('append')
 611                 {
 612                         $meta->{'buffer'} .= $data;
 613                 }
 614                 when('finish')
 615                 {
 616                         print {$meta->{'fh'}} $meta->{'buffer'} or return 0;
 617                         truncate($meta->{'fh'}, tell $meta->{'fh'}) or return 0;
 618                 }
 619         }
 620         return 1;
 621 }
 622
 623 sub process_file
 624 {
 625         my $fh = shift;
 626         my $commands_ref = shift;
 627         my @commands = @$commands_ref;
 628         my $output_cb = shift;
 629         my $cb_metadata = shift;
 630         my $lnum = 0;
 631
 632         # find out the maximum backtrack distance
 633         # to set the buffer size which holds the lines' state
 634         # which have not been decided to edit yet
 635         # due to negative offsets
 636
 637         my @linebuffer = ();
 638         my $largest_negative_offset = 0;
 639         for my $cmd (@commands)
 640         {
 641                 for my $selector (@{$cmd->{'selectors'}})
 642                 {
 643                         $largest_negative_offset = $selector->{'start'}->{'offset'} if $selector->{'start'}->{'offset'} < $largest_negative_offset;
 644                         $largest_negative_offset = $selector->{'stop'}->{'offset'}  if $selector->{'stop'}->{'offset'}  < $largest_negative_offset;
 645                 }
 646         }
 647
 648         $output_cb->('start', undef, $cb_metadata);
 649
 650         while(my $line = <$fh>)
 651         {
 652                 my %buffered_line = (
 653                         'data_before' => $line,
 654                         'edited' => 0,
 655                         'state' => {
 656                                 'line_ref' => \$line,
 657                                 'line_num' => $lnum,
 658                                 'confirm' => undef,
 659                         }
 660                 );
 661
 662                 for my $cmd (@commands)
 663                 {
 664                         my $selected = 1;
 665
 666                         for my $selector (@{$cmd->{'selectors'}})
 667                         {
 668                                 if(exists $selector->{'single'})
 669                                 {
 670                                         $selected = $selector->{'single'}->{'sub'}->($buffered_line{'state'}, @{$selector->{'single'}->{'arg'}});
 671                                 }
 672                                 elsif(exists $selector->{'start'} and exists $selector->{'stop'})
 673                                 {
 674                                         # this is a range selector, let's maintain its state.
 675                                         $selected = $selector->{'matched'};
 676
 677                                         if(defined $selector->{'will_start_after'})
 678                                         {
 679                                                 $selector->{'will_start_after'} -= 1;
 680                                         }
 681                                         else
 682                                         {
 683                                                 my $matched = $selector->{'start'}->{'sub'}->($buffered_line{'state'}, @{$selector->{'start'}->{'arg'}});
 684                                                 if($matched)
 685                                                 {
 686                                                         my $offset = $selector->{'start'}->{'offset'};
 687                                                         if($offset < 0)
 688                                                         {
 689                                                                 $linebuffer[$_]->{'editors'}->[$cmd->{'n'}]->{'selected'} = 1 for $offset..-1;
 690                                                                 $selector->{'matched'} = 1;
 691                                                                 $selected = 1;
 692                                                         }
 693                                                         else
 694                                                         {
 695                                                                 $selector->{'will_start_after'} = $offset;
 696                                                         }
 697                                                 }
 698                                         }
 699                                         if(defined $selector->{'will_start_after'} and $selector->{'will_start_after'} == 0)
 700                                         {
 701                                                 $selector->{'matched'} = 1;
 702                                                 $selected = 1;
 703                                                 delete $selector->{'will_start_after'};
 704                                         }
 705
 706                                         if(defined $selector->{'will_stop_after'})
 707                                         {
 708                                                 $selector->{'will_stop_after'} -= 1;
 709                                         }
 710                                         else
 711                                         {
 712                                                 # check if the range is being closed in this line.
 713                                                 my $match_stop = $selector->{'stop'}->{'sub'}->($buffered_line{'state'}, @{$selector->{'stop'}->{'arg'}});
 714                                                 if($match_stop)
 715                                                 {
 716                                                         my $offset = $selector->{'stop'}->{'offset'};
 717                                                         if($offset < 0)
 718                                                         {
 719                                                                 $linebuffer[$_]->{'editors'}->[$cmd->{'n'}]->{'selected'} = 0 for (($offset+1)..-1);
 720                                                                 $selector->{'matched'} = 0;
 721                                                                 $selected = 0;
 722                                                         }
 723                                                         else
 724                                                         {
 725                                                                 $selector->{'will_stop_after'} = $offset;
 726                                                         }
 727                                                 }
 728                                         }
 729                                         if(defined $selector->{'will_stop_after'} and $selector->{'will_stop_after'} == 0)
 730                                         {
 731                                                 $selector->{'matched'} = 0;
 732                                                 delete $selector->{'will_stop_after'};
 733                                         }
 734
 735                                         if(defined $selector->{'stop'}->{'relative_sub'})
 736                                         {
 737                                                 my $cmp = $selector->{'stop'}->{'relative_sub'}->($buffered_line{'state'}, @{$selector->{'stop'}->{'arg'}});
 738                                                 if($cmp > 0)
 739                                                 {
 740                                                         # this range is already closed because we have passed by the line number.
 741                                                         $selected = 0;
 742                                                 }
 743                                         }
 744                                 }
 745                                 else
 746                                 {
 747                                         die "$0: should not happen.";
 748                                 }
 749
 750                                 last if not $selected;
 751                         }
 752
 753                         push @{$buffered_line{'editors'}}, {
 754                                 'selected' => $selected,
 755                                 'editor' => $cmd->{'editor'},
 756                         };
 757                 }
 758
 759                 push @linebuffer, \%buffered_line;
 760
 761                 process_line_buffer(\@linebuffer, $largest_negative_offset, $output_cb, $cb_metadata);
 762
 763                 $lnum++;
 764         }
 765
 766         process_line_buffer(\@linebuffer, 0, $output_cb, $cb_metadata);
 767
 768         $output_cb->('finish', undef, $cb_metadata) or return 0;
 769
 770         return 1;
 771 }
 772
 773 sub process_line_buffer
 774 {
 775         my $linebuffer_ref = shift;
 776         my $largest_negative_offset = shift;
 777         my $output_cb = shift;
 778         my $cb_metadata = shift;
 779
 780                 while(scalar @$linebuffer_ref > -$largest_negative_offset)
 781                 {
 782                         my $processing_line = shift $linebuffer_ref;
 783
 784                         # perform all edit commands on this line
 785                         for my $editor (@{$processing_line->{'editors'}})
 786                         {
 787                                 # perform this edit command if any group selector or the command's own selector matched
 788                                 if($editor->{'selected'})
 789                                 {
 790                                         $processing_line->{'selected'} = 1;
 791                                         $editor->{'editor'}->{'sub'}->($processing_line->{'state'}, @{$editor->{'editor'}->{'arg'}});
 792                                         $processing_line->{'edited'} = 1;
 793                                 }
 794                         }
 795
 796                         # prompt user for confirmation if needed
 797                         my $do_confirm = $OptConfirm;
 798                         $do_confirm = $processing_line->{'state'}->{'confirm'} if defined $processing_line->{'state'}->{'confirm'};
 799
 800                         my $before = $processing_line->{'data_before'};
 801                         my $line = ${$processing_line->{'state'}->{'line_ref'}};
 802                         my $lnum = $processing_line->{'state'}->{'line_num'};
 803
 804                         if($processing_line->{'selected'} and $do_confirm)
 805                         {
 806                                 my $confirmation;
 807                                 print STDERR "$lnum: $before";
 808                                 print STDERR "\n" unless $before =~ /\n$/;
 809                                 my $prompt = "$lnum> ";
 810                                 my $old_sigaction = {};
 811
 812                                 eval {
 813                                         if($readline_support)
 814                                         {
 815                                                 my $startup_hook = $readline->Attribs->{'startup_hook'};
 816                                                 # Perl's signal handlers (%SIG) don't work in readline,
 817                                                 # so setup a low-level signal handler to intercept Ctrl-C.
 818                                                 sigaction SIGINT, POSIX::SigAction->new(sub {
 819                                                         # readline is interrupted so it can not restore the startup_hook
 820                                                         # which was modified to "preput" the initial data in the rl buffer.
 821                                                         $readline->Attribs->{'startup_hook'} = $startup_hook;
 822                                                         die "SIGINT\n";
 823                                                 }),$old_sigaction;
 824
 825                                                 $confirmation = $readline->readline($prompt, $line);
 826                                         }
 827                                         else
 828                                         {
 829                                                 local $SIG{'INT'} = \&signal_int_handler;
 830
 831                                                 print STDERR "$prompt$line";
 832                                                 # display an inverse-video space to indicate no-EOL.
 833                                                 print STDERR "\x1B[7m \x1B[0m\n" unless $line =~ /\n$/;
 834                                                 $confirmation = <$terminal_fh>;
 835                                                 $confirmation = $line if $confirmation eq "\n";
 836                                         }
 837                                 };
 838
 839                                 if($@)
 840                                 {
 841                                         if($@ eq "SIGINT\n")
 842                                         {
 843                                                 # user pressed Ctrl-C
 844                                                 if($readline_support)
 845                                                 {
 846                                                         # show the original line
 847                                                         $readline->Attribs->{'line_buffer'} = $before;
 848                                                         $readline->Attribs->{'point'} = length $before;
 849                                                         $readline->redisplay;
 850                                                 }
 851                                                 $confirmation = undef;
 852                                         } else {
 853                                                 # other exception happened
 854                                                 die $@;
 855                                         }
 856                                 }
 857
 858                                 # restore low-level signal handler.
 859                                 if($readline_support and %$old_sigaction)
 860                                 {
 861                                         sigaction SIGINT, POSIX::SigAction->new($old_sigaction->{'HANDLER'});
 862                                 }
 863
 864                                 # revert the line to the original as it was before,
 865                                 # or apply what the user typed, depending on the confirmation result
 866                                 if(defined $confirmation)
 867                                 {
 868                                         $line = $confirmation;
 869                                 } else {
 870                                         $line = $before;
 871                                         $processing_line->{'edited'} = 0;
 872                                 }
 873                         }
 874
 875                         if($OptVerbose and $processing_line->{'edited'})
 876                         {
 877                                 print STDERR "$lnum: " if $OptVerboseLnum;
 878                                 # TODO: line numbering gets confusing when the newline is removed from or extra newlines added in $line
 879                                 print STDERR $line;
 880                         }
 881
 882                         if($line ne '')
 883                         {
 884                                 $output_cb->('append', $line, $cb_metadata) or return 0;
 885                         }
 886                 }
 887 }
 888
 889 if(@Files)
 890 {
 891         for my $file_idx (0..$#Files)
 892         {
 893                 my $in_path = $Files[$file_idx];
 894                 my $out_path = $Output[$file_idx];
 895
 896                 open my $in_fh, '<', $in_path or die "$in_path: $!\n";
 897
 898                 my $output_handler = \&buffered_overwrite;
 899                 my $output_handler_meta = {};
 900
 901                 if(defined $out_path)
 902                 {
 903                         open my $out_fh, '>', $out_path or die "$out_path: $!\n";
 904                         $output_handler = \&filehandler_write;
 905                         $output_handler_meta->{'fh'} = $out_fh;
 906                         $output_handler_meta->{'fname'} = $out_path;
 907                 }
 908                 else
 909                 {
 910                         open my $out_fh, '+<', $in_path or die "$in_path: $!\n";
 911                         $output_handler_meta->{'fh'} = $out_fh;
 912                         $output_handler_meta->{'fname'} = $in_path;
 913                 }
 914
 915                 my $file_ok = process_file($in_fh, \@Commands, $output_handler, $output_handler_meta);
 916
 917                 if(not $file_ok)
 918                 {
 919                         die "$in_path: $!\n";
 920                 }
 921
 922                 close $in_fh or die "$in_path: $!\n";
 923                 close $output_handler_meta->{'fh'} or die "$output_handler_meta->{'fname'}: $!\n";
 924         }
 925 }
 926 else
 927 {
 928         process_file(\*STDIN, \@Commands, \&filehandler_write, {'fh'=>\*STDOUT});
 929 }
 930
 931 =pod
 932
 933 =head1 SIMILAR PROJECTS
 934
 935 =over 4
 936
 937 =item L<https://github.com/andrewbihl/bsed>
 938
 939 =back
 940
 941 =cut