user-tools/oded

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 oded - On-disk editor - edit text files by commands directly from shell
   8
   9 =head1 SYNOPSIS
  10
  11  oded [<OPTIONS>] <INSTRUCTIONS>
  12
  13 =head1 DESCRIPTION
  14
  15 Edit files by issuing editor commands like shell commands,
  16 but with the paradigm of well-known visual text processors:
  17 open file, move cursor, type in text, search and replace, select, copy,
  18 paste, ...
  19
  20 May open multiple files.
  21 Always one file is in the foreground.
  22 All opened files has a cursor position at which most commands are
  23 applied.
  24
  25 Files also have several marks which you can set or refer to in
  26 C<select> or C<goto> commands.
  27 A special pair of marks is SELECTION-START and SELECTION-END which
  28 pins the currently selected text for you.
  29
  30 You have one clipboard.
  31
  32 B<Oded> first executes INSTRUCTIONS given in parameters,
  33 then all the instructions given at C<--script> option(s), if any.
  34
  35 =head1 OPTIONS
  36
  37 =over 4
  38
  39 =item -f, --script FILE
  40
  41 Take instructions from FILE
  42 when done processing instructions given in parameters.
  43 May specify multiple times.
  44 Exit immediately on unknown command or parse error or if a command fails.
  45
  46 =item --stdin
  47
  48 Take instructions from STDIN line-by-line.
  49 Contrary to C<--script> scripts, it does not exit on errors,
  50 just shows what was the exception,
  51 and continues reading instructions.
  52 Suitable for interactive mode.
  53 Same as C<--script ->, except in error handling.
  54
  55 =item -v, --verbose
  56
  57 =item -b, --successful-prompt-command INSTRUCTIONS
  58
  59 Set what INSTRUCTIONS to run after each successful command in
  60 interactive mode (ie. C<--stdin>).
  61
  62 =back
  63
  64 =cut
  65
  66 use Data::Dumper;
  67 use Getopt::Long qw/:config no_ignore_case bundling pass_through/;
  68 use feature qw/switch/;
  69 use Pod::Usage;
  70 # Term::ReadLine::Gnu is recommended
  71 $readline_support = eval q{ use Term::ReadLine; 1; };
  72 use POSIX;
  73 use Carp qw/croak/;
  74
  75 $0 =~ s/.*\/([^\/]+)$/$1/;
  76 %Opt = (
  77         'confirm' => 'off',
  78         'verbose' => 'on',
  79         'successful-prompt-command' => 'none',
  80 );
  81 @OptEditorScript = ();
  82
  83 sub store_boolean_opt
  84 {
  85         $Opt{$_[0]} = $_[1] ? 'on' : 'off';
  86 }
  87
  88 GetOptions(
  89         'successful-prompt-command|b=s' => \$Opt{'successful-prompt-command'},
  90         'confirm|c' => \&store_boolean_opt,
  91         'script|f=s@' => \@OptEditorScript,
  92         '--stdin' => sub { push @OptEditorScript, '-'; },
  93         'verbose|v' => \&store_boolean_opt,
  94         'help|?' => sub{ pod2usage(-exitval=>0, -verbose=>99); },
  95 ) or exit 2;
  96
  97
  98 # instruction token ending regexp
  99 my $EOIT = qr/([ \t]+|(?=[\r\n])|$)/;
 100 my $blockio_buffer_size = 4096;
 101
 102
 103
 104 sub verbose
 105 {
 106         my $msg = shift;
 107         if($Opt{'verbose'} =~ /^(on|yes|true)$/i)
 108         {
 109                 warn "$0: $msg\n";
 110         }
 111 }
 112
 113 sub get_text_parameter
 114 {
 115         my $params_ref = shift;
 116         my $text = undef;
 117         if($$params_ref =~ s/^([""''])(.*?)(?<!\\)(?1)$EOIT//)
 118         {
 119                 my $q = $1;
 120                 $text = $2;
 121                 $text =~ s/\\($q)/$1/g;
 122                 # TODO robust escaping
 123         }
 124         elsif($$params_ref =~ s/^([^""''\s]\S*)$EOIT//)
 125         {
 126                 $text = $1;
 127         }
 128         return $text;
 129 }
 130
 131 sub get_pattern_parameter
 132 {
 133         my $params_ref = shift;
 134         my $pattern = get_text_parameter($params_ref);
 135         my $is_regexp = 0;
 136         if($pattern =~ m{^/(.*)/([a-zA-Z]*)$})
 137         {
 138                 $pattern = "(?$2)$1";
 139                 $is_regexp = 1;
 140         }
 141         return ($pattern, $is_regexp);
 142 }
 143
 144 sub seeker
 145 {
 146         my $fdata = shift;
 147         my $offset = shift;
 148         my $whence = shift;
 149         seek $fdata->{'handle'}, $offset, $whence or croak "$0: $fdata->{'path'}: seek: $!";
 150 }
 151
 152 sub readblock
 153 {
 154         my $fdata = shift;
 155         my $scalar_ref = shift;
 156         my $blocksize = shift || $blockio_buffer_size;
 157         my $bytes = read $fdata->{'handle'}, $$scalar_ref, $blocksize;
 158         croak "$0: $fdata->{'path'}: read: $!" unless defined $bytes;
 159         return $bytes;
 160 }
 161
 162 sub read_exact
 163 {
 164         my $fdata = shift;
 165         my $scalar_ref = shift;
 166         my $size = shift;
 167         my $bytes = readblock $fdata, $scalar_ref, $size;
 168         if($bytes != $size) { croak "$0: $fdata->{'path'}: could not read $size bytes, only $bytes"; }
 169         return $bytes;
 170 }
 171
 172 sub overwrite_text
 173 {
 174         my $fdata = shift;
 175         my $text = shift;
 176         print {$fdata->{'handle'}} $text or croak "$0: $fdata->{'path'}: write: $!";
 177 }
 178
 179 sub make_room
 180 {
 181         my $fdata = shift;
 182         my $room_size = shift;
 183
 184         my $buffer;
 185         my $original_pos = curpos($fdata);
 186         seeker $fdata, 0, SEEK_END;
 187
 188         while(1)
 189         {
 190                 my $curpos = curpos($fdata);
 191                 my $chunk_size = $curpos - $original_pos;
 192                 last if $chunk_size <= 0;
 193                 $chunk_size = $blockio_buffer_size if $chunk_size > $blockio_buffer_size;
 194                 seeker $fdata, -$chunk_size, SEEK_CUR;
 195                 read_exact $fdata, \$buffer, $chunk_size;
 196                 seeker $fdata, $curpos + $room_size - $chunk_size, SEEK_SET;
 197                 print {$fdata->{'handle'}} $buffer or croak "$0: $fdata->{'path'}: write: $!";
 198                 seeker $fdata, $curpos-$chunk_size, SEEK_SET;
 199         }
 200         seeker $fdata, $original_pos, SEEK_SET;
 201         # TODO maintain $fdata->{'mark'} marks
 202 }
 203
 204 sub insert_text
 205 {
 206         my $fdata = shift;
 207         my $text = shift;
 208         make_room $fdata, length $text;
 209         return overwrite_text $fdata, $text;
 210 }
 211
 212 sub update_file_size
 213 {
 214         my $fdata = shift;
 215         my $pos = curpos($fdata);
 216         if(seek $fdata->{'handle'}, 0, SEEK_END)
 217         {
 218                 $fdata->{'size'} = curpos($fdata);
 219                 seek $fdata->{'handle'}, $pos, SEEK_SET;
 220                 return $fdata->{'size'};
 221         }
 222         return undef;
 223 }
 224
 225 sub curpos
 226 {
 227         my $fdata = shift;
 228         return tell $fdata->{'handle'};
 229 }
 230
 231 sub resolve_mark
 232 {
 233         my $fdata = shift;
 234         my $mark = shift;
 235         my $p;
 236         given($mark)
 237         {
 238                 when('START') { $p = 0; }
 239                 when('END')   { update_file_size $fdata; $p = $fdata->{'size'}; }
 240                 when('SOL')   {} # TODO
 241                 when('EOL')   {
 242                         ($p, undef) = search_pattern($fdata, "\n", 0);
 243                         $p = resolve_mark($fdata, 'END') unless defined $p;
 244                 }
 245                 when('HERE')  { $p = curpos $fdata; }
 246                 default       { $p = $fdata->{'mark'}->{$mark}; }
 247         }
 248         croak "$0: mark $mark not found" if not defined $p;
 249         return $p;
 250 }
 251
 252 sub insert_stream
 253 {
 254         my $fdata = shift;
 255         my $stream_data = shift;
 256         update_file_size $stream_data;
 257
 258         my $buffer;
 259         my $room_allocated = 0;
 260         if(defined $stream_data->{'size'})
 261         {
 262                 make_room $fdata, $stream_data->{'size'};
 263                 $room_allocated = 1;
 264         }
 265         while(my $bytes = readblock $stream_data, \$buffer)
 266         {
 267                 if($room_allocated) { overwrite_text $fdata, $buffer; }
 268                 else                { insert_text $fdata, $buffer; }
 269         }
 270 }
 271
 272 sub shovel_text
 273 {
 274         my $src = shift;
 275         my $pos_start = shift;
 276         my $pos_stop = shift;
 277         my $length = $pos_stop - $pos_start;
 278         my $dest_fh = shift;
 279         my $callback = shift;
 280
 281         my $original_pos = curpos($src);
 282         seeker $src, $pos_start, SEEK_SET;
 283         my $buffer;
 284         while(1)
 285         {
 286                 last if $length <= 0;
 287                 my $pos = curpos($src);
 288                 my $size = $length < $blockio_buffer_size ? $length : $blockio_buffer_size;
 289                 $length -= readblock $src, \$buffer, $size;
 290                 if($callback)
 291                 {
 292                         $callback->($pos, \$buffer);
 293                 }
 294                 else
 295                 {
 296                         print {$dest_fh} $buffer;
 297                 }
 298         }
 299         seeker $src, $original_pos, SEEK_SET;
 300 }
 301
 302 sub delete_chars
 303 {
 304         my $fdata = shift;
 305         my $length = shift;
 306
 307         my $buffer;
 308         my $original_pos = curpos($fdata);
 309         my $continue_write_pos = $original_pos;
 310         seeker $fdata, $length, SEEK_CUR;
 311         while(readblock $fdata, \$buffer)
 312         {
 313                 seeker $fdata, $continue_write_pos, SEEK_SET;
 314                 print {$fdata->{'handle'}} $buffer or croak "$0: $fdata->{'path'}: write: $!";
 315                 $continue_write_pos = curpos($fdata);
 316                 seeker $fdata, $length, SEEK_CUR;
 317         }
 318         truncate $fdata->{'handle'}, $continue_write_pos;
 319         seeker $fdata, $original_pos, SEEK_SET;
 320         # TODO maintain $fdata->{'mark'} marks
 321 }
 322
 323 sub search_pattern
 324 {
 325         my $fdata = shift;
 326         my $pattern = shift;
 327         my $is_regexp = shift;
 328
 329         my $original_pos = curpos($fdata);
 330         my $chunk_start_pos = $original_pos;
 331         my $found_pos = undef;
 332         my $matched_string;
 333
 334         while(my $chunk = readline $fdata->{'handle'})
 335         {
 336                 if($is_regexp)
 337                 {
 338                         if($chunk =~ $pattern)
 339                         {
 340                                 $found_pos = $chunk_start_pos + length $`;
 341                                 $matched_string = $&;
 342                         }
 343                 }
 344                 else
 345                 {
 346                         my $index = index $chunk, $pattern;
 347                         if($index >= 0)
 348                         {
 349                                 $found_pos = $chunk_start_pos + $index;
 350                                 $matched_string = $pattern;
 351                         }
 352                 }
 353                 last if defined $found_pos;
 354                 $chunk_start_pos = curpos($fdata);
 355         }
 356
 357         seeker $fdata, $original_pos, SEEK_SET;
 358
 359         return ($found_pos, $matched_string);
 360 }
 361
 362 sub process_instructions
 363 {
 364         my $instructions_ref = shift;
 365         my $cur_instr_offset_ref = shift;
 366
 367         my $whole_instr_length = length $$instructions_ref;
 368
 369         while(1)
 370         {
 371                 my $position_before_operation;
 372                 $position_before_operation = curpos($curfile) if $curfile;
 373                 $$instructions_ref =~ s/^\s*//;
 374                 $$cur_instr_offset_ref = $whole_instr_length - length $$instructions_ref;
 375 =pod
 376
 377 =head1 INSTRUCTIONS
 378
 379 =over 4
 380
 381 =item open [file] PATH [as NAME]
 382
 383 =item open or create [file] PATH [as NAME]
 384
 385 =item open new [file] PATH [as NAME]
 386
 387 Open PATH file to edit.
 388 C<open file PATH> only opens already existing files,
 389 C<open or create ...> creates the file if it is not yet there.
 390 C<open new file ...> opens a file only if it does not exist yet.
 391
 392 You can switch between multiple opened files by invoking C<open PATH>
 393 or C<open file PATH> again, or C<open NAME> if you opened the file
 394 under a certain NAME by C<as NAME>.
 395
 396 Don't worry, it won't open the same PATH multiple time with conflicting
 397 editor states.
 398 However your system may allow accessing the same file (by soft and hard links)
 399 on different paths.
 400 B<Oded> considers only the PATH string when discerning files,
 401 so F<x.txt> and F<./x.txt> and F<.//x.txt> are handled separatedly.
 402 You have to open a file before any operation.
 403
 404 =item open [NAME | PATH]
 405
 406 Switch to an already opened file with the given NAME alias or
 407 PATH path, if NAME alias is not found.
 408 You can not open a file on path PATH once you set NAME as an alias for
 409 a file on an other PATH.
 410 But you can always refer to the same path by prepending C<./> (or C</>
 411 in case of absolute paths) to it.
 412
 413 =cut
 414
 415                 if($$instructions_ref =~ s/^open$EOIT//)
 416                 {
 417                         my $may_create = 0;
 418                         my $must_create = 0;
 419                         my $must_file = 0;
 420
 421                         if($$instructions_ref =~ s/^or create$EOIT//)
 422                         {
 423                                 $may_create = 1;
 424                                 $must_file = 1;
 425                         }
 426                         elsif($$instructions_ref =~ s/^new$EOIT//)
 427                         {
 428                                 $must_create = 1;
 429                                 $must_file = 1;
 430                         }
 431                         $must_file = 1 if $$instructions_ref =~ s/^file$EOIT//;
 432
 433                         my $key = get_text_parameter $instructions_ref;
 434                         unless(length $key)
 435                         {
 436                                 if($must_file or $must_create or $may_create)
 437                                 {
 438                                         croak "$0: file path expected to open";
 439                                 }
 440                                 croak "$0: file path or alias expected to open";
 441                         }
 442
 443                         my $alias;
 444                         if($$instructions_ref =~ s/^as (\S+)$EOIT//)
 445                         {
 446                                 $alias = $1;
 447                                 $must_file = 1;
 448                         }
 449
 450                         my $path;
 451                         if(not defined $alias and not $must_file)
 452                         {
 453                                 # "open NAME" form -> check aliases
 454                                 if(exists $filepathalias{$key})
 455                                 {
 456                                         $path = $filepathalias{$key};
 457                                 }
 458                         }
 459                         if(not defined $path)
 460                         {
 461                                 # either "open NAME" form and NAME alias is not found,
 462                                 # or "open file PATH" or "open PATH as NAME" form
 463                                 $path = $key;
 464                         }
 465                         if($must_create or not exists $openedfile{$path})
 466                         {
 467                                 # file is not yet open
 468                                 my $handle;
 469                                 use Fcntl;
 470                                 my $open_flags = O_RDWR;
 471                                 $open_flags |= O_CREAT if $may_create or $must_create;
 472                                 $open_flags |= O_EXCL if $must_create;
 473                                 sysopen $handle, $path, $open_flags or croak "$0: $path: open: $!";
 474                                 binmode $handle, ':utf8' or croak "$0: $path: binmode: $!";
 475                                 $openedfile{$path} = {
 476                                         'handle' => $handle,
 477                                         'path' => $path,
 478                                 };
 479                         }
 480
 481                         $curfile = $openedfile{$path};
 482                         $filepathalias{$alias} = $path if defined $alias;
 483                         $curfile->{'mark'} = {} unless exists $curfile->{'mark'};
 484                         verbose sprintf "%s: opened%s", $path, defined $alias ? " as $alias" : "";
 485                         update_file_size $curfile;
 486                         verbose sprintf "cursor at %d size %d", curpos($curfile), $curfile->{'size'};
 487                 }
 488                 elsif($$instructions_ref =~ s/^goto$EOIT//)
 489                 {
 490                         my $goto_pos = undef;
 491                         my $whence = SEEK_SET;
 492 =pod
 493
 494 =item goto end of [last] search result
 495
 496 =cut
 497
 498                         if($$instructions_ref =~ s/^end of( last)? search result$EOIT//)
 499                         {
 500                                 my $c = $last_search_is_regexp ? '/' : '"';
 501                                 croak "$0: last search ($c$last_search_pattern$c) was not found" if not defined $last_search_result;
 502                                 $goto_pos = $last_search_result_pos + 1 + length $last_search_result;
 503                         }
 504 =pod
 505
 506 =item goto [start | end] [of file]
 507
 508 =item goto [start | end] of line
 509
 510 =item goto [sof | eof | sol | eol]
 511
 512 =cut
 513
 514                         elsif($$instructions_ref =~ s/^((?<ANCHOR>start|end)( of (?<SCOPE>file|line)|)|(?<ANCHOR>[se])o(?<SCOPE>[fl]))$EOIT//)
 515                         {
 516                                 my $anchor = substr $+{'ANCHOR'}, 0, 1;
 517                                 my $scope  = substr $+{'SCOPE'}, 0, 1;
 518                                 if($scope eq 'l')  # line
 519                                 {
 520                                         if($anchor eq 'e')  # end
 521                                         {
 522                                                 my $rest_of_line = readline $curfile->{'handle'};
 523                                                 if(substr $rest_of_line, -1 eq "\n")
 524                                                 {
 525                                                         seeker $curfile, -1, SEEK_CUR;
 526                                                 }
 527                                         }
 528                                         else  # start
 529                                         {
 530                                                 my $buffer;
 531                                                 my $pos = $position_before_operation;
 532                                                 while($pos != 0)
 533                                                 {
 534                                                         if($pos < $blockio_buffer_size)
 535                                                         {
 536                                                                 seeker $curfile, 0, SEEK_SET;
 537                                                                 readblock $curfile, \$buffer, $pos;
 538                                                                 $pos = 0;
 539                                                         }
 540                                                         else
 541                                                         {
 542                                                                 seeker $curfile, $blockio_buffer_size, SEEK_CUR;
 543                                                                 $pos = curpos($curfile);
 544                                                                 readblock $curfile, \$buffer;
 545                                                         }
 546                                                         my $idx = rindex $buffer, "\n";
 547                                                         if($idx >= 0)
 548                                                         {
 549                                                                 $goto_pos = $pos + $idx + 1;
 550                                                                 last;
 551                                                         }
 552                                                         seeker $curfile, $pos, SEEK_SET;
 553                                                 }
 554                                         }
 555                                 }
 556                                 else  # file
 557                                 {
 558                                         $goto_pos = 0;
 559                                         $whence = $anchor eq 's' ? SEEK_SET : SEEK_END;
 560                                 }
 561                         }
 562 =pod
 563
 564 =item goto [previous | next] line
 565
 566 =cut
 567
 568                         elsif($$instructions_ref =~ s/^(?<DIRECTION>next|previous) line$EOIT//)
 569                         {
 570                                 if($+{'DIRECTION'} eq 'next')
 571                                 {
 572                                         readline $curfile->{'handle'};
 573                                 }
 574                                 else  # previous
 575                                 {
 576                                         # TODO
 577                                 }
 578                         }
 579 =pod
 580
 581 =item goto [line | offset] NUMBER
 582
 583 Lines and byte offsets are indexed by 0.
 584
 585 =cut
 586
 587                         elsif($$instructions_ref =~ s/^(?<WHAT>line|offset) (?<INDEX>\d+)$EOIT//)
 588                         {
 589                                 if($+{'WHAT'} eq 'line')
 590                                 {
 591                                         seeker $curfile, 0, SEEK_SET;
 592                                         readline $curfile->{'handle'} for 1..$+{'INDEX'};
 593                                 }
 594                                 else  # goto offset
 595                                 {
 596                                         seeker $curfile, $+{'INDEX'}, SEEK_SET;
 597                                 }
 598                         }
 599 =pod
 600
 601 =item goto mark NAME
 602
 603 Set cursor position in file.
 604
 605 =cut
 606
 607                         elsif($$instructions_ref =~ s/^mark (\S+)$EOIT//)
 608                         {
 609                                 $goto_pos = resolve_mark $curfile, $1;
 610                         }
 611                         else
 612                         {
 613                                 croak "$0: invalid GOTO: $$instructions_ref";
 614                         }
 615
 616                         if(defined $goto_pos)
 617                         {
 618                                 seeker $curfile, $goto_pos, $whence;
 619                         }
 620                 }
 621 =pod
 622
 623 =item go [back | forward] COUNT line[s]
 624
 625 =cut
 626
 627                 elsif($$instructions_ref =~ s/^go (?<DIRECTION>back|forward) (?<COUNT>[1-9]\d*) lines?$EOIT//)
 628                 {
 629                         if($+{'DIRECTION'} eq 'forward')
 630                         {
 631                                 readline $curfile->{'handle'} for 1..$+{'COUNT'};
 632                         }
 633                         else  # back
 634                         {
 635                                 # TODO
 636                         }
 637                 }
 638 =pod
 639
 640 =item [go] [up | down | left | right] [COUNT times]
 641
 642 =cut
 643
 644                 elsif($$instructions_ref =~ s/^(go |)(?<WHERE>up|down|left|right)( (?<COUNT>[1-9]\d*) times|)$EOIT//)
 645                 {
 646                         my $count = $+{'COUNT'} || 1;
 647                         given($+{'WHERE'})
 648                         {
 649                                 when('right') {
 650                                         my $tmp;
 651                                         read $curfile->{'handle'}, $tmp, $count or croak "$0: read: $!";
 652                                 }
 653                                 when('left') {
 654                                         $count = $position_before_operation if $count > $position_before_operation;
 655                                         seeker $curfile, -$count, SEEK_CUR if $count;
 656                                 }
 657                                 when('down') {
 658                                         readline $curfile->{'handle'};
 659                                         my $tmp;
 660                                         read $curfile->{'handle'}, $tmp, $count or croak "$0: read: $!";
 661                                         # FIXME offset in line?
 662                                 }
 663                                 when('up') {
 664                                 }
 665                                 # TODO
 666                         }
 667                 }
 668 =pod
 669
 670 =item type STRING
 671
 672 =item enter [STRING]
 673
 674 Insert given STRING into the current cursor position.
 675 It does not overwrite current selection.
 676 Add newline to the end only if called as c<enter>.
 677
 678 =cut
 679
 680                 elsif($$instructions_ref =~ s/^(?<CMD>type|enter)$EOIT//)
 681                 {
 682                         my $cmd = $+{'CMD'};
 683                         my $end = $cmd eq 'enter' ? "\n" : "";
 684                         my $text = get_text_parameter $instructions_ref;
 685                         $text = '' if not defined $text and $cmd eq 'enter';
 686                         croak "$0: text not given to type in" unless defined $text;
 687                         insert_text $curfile, $text.$end;
 688                         verbose sprintf "inserted %d bytes at %d", length $text.$end, $position_before_operation;
 689                 }
 690 =pod
 691
 692 =item overwrite with STRING
 693
 694 =item overtype with STRING
 695
 696 Type given STRING into the current cursor position in overwrite mode.
 697 It does not overwrite current selection, but the text itself
 698 let it be currently selected or not.
 699
 700 =cut
 701
 702                 elsif($$instructions_ref =~ s/^over(write|type) with$EOIT//)
 703                 {
 704                         my $text = get_text_parameter $instructions_ref;
 705                         croak "$0: text not given to overwrite with" unless defined $text;
 706                         overwrite_text $curfile, $text;
 707                         verbose sprintf "written over %d bytes at %d", length $text, $position_before_operation;
 708                 }
 709 =pod
 710
 711 =item replace all [[occurrences of] PATTERN] to STRING
 712
 713 =item replace all [occurrences | PATTERN] to STRING
 714
 715 =item replace [next [COUNT]] [[occurrence[s] of] PATTERN] to STRING
 716
 717 =item replace [next [COUNT]] [occurrence[s] | PATTERN] to STRING
 718
 719 Replace given PATTERN to STRING.
 720 If PATTERN is not given, then the last search pattern will be used.
 721 "Replace next" changes only the next COUNT number of occurrences
 722 starting from the cursor position.
 723 Default is 1 occurrence, if COUNT is not given.
 724 "Replace all" changes all the occurrences from the cursor position down
 725 to the end of file.
 726 If you want to replace all the occurrences in the whole file,
 727 "goto start" first.
 728
 729 =cut
 730
 731                 elsif($$instructions_ref =~ s/^replace( (?<LIMIT>all|next( (?<COUNT>[1-9]\d*)|))|)(?<OCCUR> occurrences?(?<OF> of|)|)$EOIT//)
 732                 {
 733                         croak "$0: don't understand this REPLACE instruction" if not $+{'LIMIT'} and $+{'OCCUR'};
 734                         my $replace_count = $+{'LIMIT'} eq 'all' ? undef : ($+{'COUNT'}||1);
 735                         my $expect_pattern;
 736                         $expect_pattern = 1 if $+{'OF'};
 737                         $expect_pattern = 0 if $+{'OCCUR'} and not $+{'OF'};
 738                         my $pattern;
 739                         my $is_regexp = 0;
 740                         my $text;
 741
 742                         if((not defined $expect_pattern and $$instructions_ref !~ /^to$EOIT/) or $expect_pattern eq 1)
 743                         {
 744                                 ($pattern, $is_regexp) = get_pattern_parameter $instructions_ref;
 745                                 croak "$0: string/pattern not given what to replace" unless length $pattern;
 746                         }
 747                         else  # not expecting PATTERN to be given here
 748                         {
 749                                 $pattern = $last_search_pattern;
 750                                 $is_regexp = $last_search_is_regexp;
 751                         }
 752
 753                         if($$instructions_ref =~ s/^to$EOIT//)
 754                         {
 755                                 $text = get_text_parameter $instructions_ref;
 756                         }
 757                         croak "$0: string not given to replace pattern to" unless defined $text;
 758
 759                         my $replacements = 0;
 760
 761                         while(not defined $replace_count or $replace_count > 0)
 762                         {
 763                                 my ($found_pos, $matched_string) = search_pattern $curfile, $pattern, $is_regexp;
 764
 765                                 if(defined $found_pos)
 766                                 {
 767                                         seeker $curfile, $found_pos, SEEK_SET;
 768                                         my $found_length = length $matched_string;
 769                                         my $length_to_delete = $found_length - length $text;
 770                                         if($length_to_delete >= 0)
 771                                         {
 772                                                 delete_chars $curfile, $length_to_delete if $length_to_delete > 0;
 773                                                 overwrite_text $curfile, $text;
 774                                         }
 775                                         else
 776                                         {
 777                                                 overwrite_text $curfile, substr($text, 0, $found_length);
 778                                                 insert_text $curfile, substr($text, $found_length);
 779                                         }
 780                                         verbose "replaced \"$matched_string\" to \"$text\" at $found_pos";
 781                                         $replace_count -= 1 if defined $replace_count;
 782                                         $replacements += 1;
 783                                 }
 784                                 else
 785                                 {
 786                                         last;
 787                                 }
 788                         }
 789
 790                         if(not defined $replace_count or $replacements == 0)
 791                         {
 792                                 verbose "replaced $replacements occurrences";
 793                         }
 794                 }
 795 =pod
 796
 797 =item delete [COUNT char[s]]
 798
 799 =item backspace [COUNT char[s]]
 800
 801 =cut
 802
 803                 elsif($$instructions_ref =~ s/^(?<CMD>delete(?! selection)|backspace)( (?<COUNT>[1-9]\d*) chars?|)$EOIT//)
 804                 {
 805                         my $count = $+{'COUNT'} || 1;
 806                         if($+{'CMD'} eq 'backspace')
 807                         {
 808                                 $count = $position_before_operation if $count > $position_before_operation;
 809                                 seeker $curfile, -$count, SEEK_CUR;
 810                         }
 811                         delete_chars $curfile, $count;
 812                 }
 813 =pod
 814
 815 =item search [next] PATTERN [backward]
 816
 817 Find next occurrence (or previous one if "backward" is specified) of
 818 PATTERN and set the cursor to it.
 819 PATTERN is either a bare word, a string enclosed in quotes, or a regexp
 820 enclosed in slashes (C</regexp/>).
 821 PATTERN is not supported to overhang from one line to the next.
 822 Remove newlines from the text if you must.
 823 If the cursor is at a matching text, C<search PATTERN> will find the
 824 very place where we are, while C<search next ...> skips 1 char and
 825 continues from there.
 826
 827 =item search next [//]
 828
 829 Continue searching the next occurrence of the last search query.
 830 You may close this instruction with an empty pattern (C<//>) to
 831 separate it from the next instruction, since the empty search PATTERN
 832 (both fixed text and regexp) is invalid, thus not searching an other
 833 pattern but the last one.
 834 In interactive mode C<search next> is enough.
 835
 836 =cut
 837
 838                 elsif($$instructions_ref =~ s/^search(?<NEXT> next|)$EOIT//)
 839                 {
 840                         my $next = 1 if $+{'NEXT'};
 841                         my ($pattern, $is_regexp) = get_pattern_parameter $instructions_ref;
 842                         if($next and length $pattern == 0)
 843                         {
 844                                 $pattern = $last_search_pattern;
 845                                 $is_regexp = $last_search_is_regexp;
 846                         }
 847                         croak "$0: string/pattern not given what to search for" unless length $pattern;
 848
 849                         my $backward = 0;
 850                         if($$instructions_ref =~ s/^backwards?$EOIT//)
 851                         {
 852                                 $backward = 1;
 853                         }
 854                         # TODO search backward
 855
 856                         DO_SEARCH:
 857                         my ($found_pos, $matched_string) = search_pattern $curfile, $pattern, $is_regexp;
 858                         if($found_pos == $position_before_operation and $next)
 859                         {
 860                                 seeker $curfile, +1, SEEK_CUR;
 861                                 $next = 0;
 862                                 goto DO_SEARCH;
 863                         }
 864
 865                         if(defined $found_pos)
 866                         {
 867                                 seeker $curfile, $found_pos, SEEK_SET;
 868                                 my $len = length $matched_string;
 869                                 verbose "match found at $found_pos, length $len";
 870                         }
 871                         else
 872                         {
 873                                 verbose "not found";
 874                                 seeker $curfile, $position_before_operation, SEEK_SET;
 875                         }
 876                         $last_search_pattern = $pattern;
 877                         $last_search_is_regexp = $is_regexp;
 878                         $last_search_result_pos = $found_pos;
 879                         $last_search_result = $matched_string;
 880                 }
 881 =pod
 882
 883 =item mark as NAME
 884
 885 Put a named mark to the current cursor position.
 886 NAME must not be a reserved mark name: START, END, SOL, EOL, HERE.
 887
 888 =cut
 889
 890                 elsif($$instructions_ref =~ s/^mark as (\S+)$EOIT//)
 891                 {
 892                         my $m = $1;
 893                         $curfile->{'mark'}->{$m} = $position_before_operation;
 894                 }
 895 =pod
 896
 897 =item clear mark NAME
 898
 899 =cut
 900
 901                 elsif($$instructions_ref =~ s/^clear mark (\S+)$EOIT//)
 902                 {
 903                         delete $curfile->{'mark'}->{$1};
 904                 }
 905 =pod
 906
 907 =item select from START-MARK to END-MARK
 908
 909 Select text from the previously named mark START-MARK to END-MARK.
 910 Put marks with C<mark as> command.
 911 You have some special predefined marks:
 912
 913 =over 8
 914
 915 =item C<START> beginning of the file
 916
 917 =item C<END> end of the file
 918
 919 =item C<HERE> current cursor position
 920
 921 =item C<SOL> start of line
 922
 923 =item C<EOL> end of line, excluding the line ending (Newline) char
 924
 925 =back
 926
 927 =item select [from | to] MARK
 928
 929 If either C<from> or C<to> is missing, C<HERE> is implied.
 930
 931 =cut
 932
 933                 elsif($$instructions_ref =~ s/^select ((?<FROM>from)|to) (?<M1>\S+)(?('FROM')( to (?<M2>\S+)|))$EOIT//)
 934                 {
 935                         delete $curfile->{'mark'}->{'SELECTION-START'};
 936                         delete $curfile->{'mark'}->{'SELECTION-END'};
 937
 938                         my $p1 = resolve_mark $curfile, $+{'M1'};
 939                         my $p2 = resolve_mark $curfile, ($+{'M2'} // 'HERE');
 940                         ($p1, $p2) = ($p2, $p1) if $p2 < $p1;
 941
 942                         $curfile->{'mark'}->{'SELECTION-START'} = $p1;
 943                         $curfile->{'mark'}->{'SELECTION-END'}   = $p2;
 944                 }
 945 =pod
 946
 947 =item select [last] search result
 948
 949 =item select none
 950
 951 =cut
 952
 953                 elsif($$instructions_ref =~ s/^select( none|( last|) search result)$EOIT//)
 954                 {
 955                         my $what = $1;
 956                         delete $curfile->{'mark'}->{'SELECTION-START'};
 957                         delete $curfile->{'mark'}->{'SELECTION-END'};
 958                         if($what =~ /search result/)
 959                         {
 960                                 croak "$0: no last search result to select" if not defined $last_search_result_pos;
 961                                 $curfile->{'mark'}->{'SELECTION-START'} = $last_search_result_pos;
 962                                 $curfile->{'mark'}->{'SELECTION-END'}   = $last_search_result_pos + length $last_search_result;
 963                         }
 964                 }
 965 =pod
 966
 967 =item select [COUNT] [char[s] | word[s] | line[s]]
 968
 969 =cut
 970
 971 =pod
 972
 973 =item copy [[selection] | [last] search result | to [start | end] of line]
 974
 975 =item cut [[selection] | [last] search result | to [start | end] of line]
 976
 977 =item delete [selection | [last] search result | to [start | end] of line]
 978
 979 =item [copy | cut] [selection]
 980
 981 =item delete selection
 982
 983 =item [copy | cut | delete] [last] search result
 984
 985 =item [copy | cut | delete] to [the] [start | end] of line
 986
 987 =cut
 988
 989                 elsif($$instructions_ref =~ s/^(?<CMD>copy|cut|delete)(?<WHAT> selection|( last|) search result|to( the|) (?<ANCHOR>start|end) of line|)$EOIT//)
 990                 {
 991                         my $cmd = $+{'CMD'};
 992                         my $what = $+{'WHAT'};
 993                         my $anchor = $+{'ANCHOR'};
 994                         my $p1;
 995                         my $p2;
 996                         if($what =~ /search result/)
 997                         {
 998                                 croak "$0: no last search result to $cmd" if not defined $last_search_result_pos;
 999                                 $p1 = $last_search_result_pos;
1000                                 $p2 = $p1 + length $last_search_result;
1001                         }
1002                         elsif($what =~ /of line/)
1003                         {
1004                                 # TODO
1005                         }
1006                         else  # selection
1007                         {
1008                                 $p1 = $curfile->{'mark'}->{'SELECTION-START'};
1009                                 $p2 = $curfile->{'mark'}->{'SELECTION-END'};
1010                                 croak "$0: no selection to $cmd" unless defined $p1 and defined $p2;
1011                         }
1012                         if($cmd =~ /copy|cut/)
1013                         {
1014                                 seeker $curfile, $p1, SEEK_SET;
1015                                 read_exact $curfile, \$Clipboard, $p2-$p1;
1016                                 seeker $curfile, $p1, SEEK_SET;
1017                         }
1018                         if($cmd =~ /cut|delete/)
1019                         {
1020                                 delete_chars $curfile, $p2-$p1;
1021                         }
1022                 }
1023 =pod
1024
1025 =item paste [selection]
1026
1027 =cut
1028
1029                 elsif($$instructions_ref =~ s/^paste( selection|)$EOIT//)
1030                 {
1031                         insert_text $curfile, $Clipboard;
1032                         verbose sprintf "pasted %d byes at %d", length $Clipboard, $position_before_operation;
1033                 }
1034 =pod
1035
1036 =item undo
1037
1038 =item redo
1039
1040 =cut
1041
1042 =pod
1043
1044 =item insert file FILE
1045
1046 =item insert output of COMMAND
1047
1048 Insert FILE's contents or the output (stdout) of COMMAND
1049 to the current cursor position.
1050
1051 =item filter selection through COMMAND
1052
1053 =item send selection to COMMAND
1054
1055 Send selected text to COMMAND as stdin,
1056 and in case of C<filter>, replace selection with its stdout.
1057
1058 =cut
1059
1060                 elsif($$instructions_ref =~ s/^(?<CMD>insert (?<WHAT>file|output of)|filter selection through|send selection to)$EOIT//)
1061                 {
1062                         my $cmd = $+{'CMD'};
1063                         my $source_type = $+{'WHAT'};
1064                         $cmd =~ s/^(\S+).*/$1/;
1065                         my $source = get_text_parameter $instructions_ref;
1066                         croak "$0: file/command not given to insert/filter/send to" unless length $source;
1067                         my $stream_data = {};
1068
1069                         if($source_type eq 'file')
1070                         {
1071                                 open $stream_data->{'handle'}, '<', $source or croak "$0: $source: open: $!";
1072                                 $stream_data->{'path'} = $source;
1073                         }
1074                         else  # command
1075                         {
1076                                 my $filter_pid;
1077                                 my $ext_command_input;
1078
1079                                 given($cmd)
1080                                 {
1081                                         when('insert')
1082                                         {
1083                                                 $stream_data->{'path'} = "<($source)";
1084                                                 open $stream_data->{'handle'}, '-|', $source or croak "$0: open $stream_data->{'path'}: $!";
1085                                         }
1086                                         when('send')
1087                                         {
1088                                                 $stream_data->{'path'} = "|$source";
1089                                                 open $ext_command_input, '|-', $source or croak "$0: open $stream_data->{'path'}: $!";
1090                                         }
1091                                         when('filter')
1092                                         {
1093                                                 $stream_data->{'path'} = "<(|$source)";
1094                                                 use IPC::Open2;
1095                                                 $filter_pid = open2($stream_data->{'handle'}, $ext_command_input, $source);
1096                                         }
1097                                 }
1098                                 if(defined $ext_command_input)
1099                                 {
1100                                         if(defined $curfile->{'mark'}->{'SELECTION-START'} and defined $curfile->{'mark'}->{'SELECTION-END'})
1101                                         {
1102                                                 shovel_text $curfile, $curfile->{'mark'}->{'SELECTION-START'}, $curfile->{'mark'}->{'SELECTION-END'}, $ext_command_input;
1103                                         }
1104                                         else
1105                                         {
1106                                                 croak "$0: $curfile->{'path'}: there is not any selection to $cmd";
1107                                         }
1108                                         close $ext_command_input or croak "$0: close pipe: $!";
1109                                 }
1110                         }
1111
1112                         if(defined $stream_data->{'handle'})
1113                         {
1114                                 my $overwrite_length;
1115                                 if($cmd eq 'filter')
1116                                 {
1117                                         seeker $curfile, $curfile->{'mark'}->{'SELECTION-START'}, SEEK_SET;
1118                                         $overwrite_length = $curfile->{'mark'}->{'SELECTION-END'} - $curfile->{'mark'}->{'SELECTION-START'};
1119                                         my $buf;
1120                                         my $size;
1121                                         while(1)
1122                                         {
1123                                                 last if $overwrite_length <= 0;
1124                                                 $size = $overwrite_length < $blockio_buffer_size ? $overwrite_length : $blockio_buffer_size;
1125                                                 my $nbytes = readblock $stream_data, \$buf, $size;
1126                                                 $overwrite_length -= $nbytes;
1127                                                 overwrite_text $curfile, $buf;
1128                                                 last if $nbytes == 0;
1129                                         }
1130                                 }
1131                                 insert_stream $curfile, $stream_data;
1132                                 close $stream_data->{'handle'};
1133                                 if($cmd eq 'filter' and $overwrite_length > 0)
1134                                 {
1135                                         delete_chars $curfile, $overwrite_length;
1136                                 }
1137                         }
1138                 }
1139 =pod
1140
1141 =item uppercase
1142
1143 =item lowercase
1144
1145 =item capitalize
1146
1147 =cut
1148
1149                 elsif($$instructions_ref =~ s/^(uppercase|lowercase|capitalize)$EOIT//)
1150                 {
1151                         my $op = $1;
1152                         if(defined $curfile->{'mark'}->{'SELECTION-START'} and defined $curfile->{'mark'}->{'SELECTION-END'})
1153                         {
1154                                 seeker $curfile, $selection_start, SEEK_SET;
1155                                 # TODO
1156                         }
1157                         else
1158                         {
1159                                 verbose "there is not any selection";
1160                         }
1161                 }
1162 =pod
1163
1164 =item show open[ed] file[s]
1165
1166 Display a list of file paths which were opened.
1167 The one in foreground prefixed with an C<*> asterisk.
1168 If any of them opened by an alias name, it shown after the path in C<[]> brackets.
1169
1170 =cut
1171
1172                 elsif($$instructions_ref =~ s/^show open(ed)? files?$EOIT//)
1173                 {
1174                         for my $path (keys %openedfile)
1175                         {
1176                                 printf "%s %s", ($path eq $curfile->{'path'}) ? '*' : ' ', $path;
1177                                 for my $alias (keys %filepathalias)
1178                                 {
1179                                         print "\t[$alias]" if $filepathalias{$alias} eq $path;
1180                                 }
1181                                 print "\n";
1182                         }
1183                 }
1184 =pod
1185
1186 =item show contents [with cursor] [with selection] [with marks]
1187
1188 Show the contents of the file in foreground.
1189
1190 =cut
1191
1192                 elsif($$instructions_ref =~ s/^show contents(?<WITH>( with (cursor|selection|marks))*)$EOIT//)
1193                 {
1194                         my $extras = $+{'WITH'};
1195                         update_file_size $curfile;
1196                         shovel_text $curfile, 0, $curfile->{'size'}, undef, sub
1197                                 {
1198                                         my $pos = shift;
1199                                         my $data_ref = shift;
1200                                         my $end = $pos + length $$data_ref;
1201                                         my @inserts;
1202                                         if($extras =~ /selection/)
1203                                         {
1204                                                 my $p1 = $curfile->{'mark'}->{'SELECTION-START'};
1205                                                 if(defined $p1 and $pos <= $p1 and $p1 < $end)
1206                                                 {
1207                                                         # put "selection start" signal in the stream
1208                                                         push @inserts, {'where' => $p1-$pos, 'what' => "\x1B[7m"};
1209                                                 }
1210                                                 my $p2 = $curfile->{'mark'}->{'SELECTION-END'};
1211                                                 if(defined $p2 and $pos <= $p2 and $p2 < $end)
1212                                                 {
1213                                                         # put "selection end" signal in the stream
1214                                                         push @inserts, {'where' => $p2-$pos, 'what' => "\x1B[27m"};
1215                                                 }
1216                                         }
1217                                         if($extras =~ /cursor/)
1218                                         {
1219                                                 if($pos <= $position_before_operation and $position_before_operation < $end)
1220                                                 {
1221                                                         my $offset = $position_before_operation - $pos;
1222                                                         if(substr($$data_ref, $offset, 1) =~ /[\r\n]/)
1223                                                         {
1224                                                                 push @inserts, {'where' => $offset, 'what' => "\x1B[4m \x1B[24m"};
1225                                                         }
1226                                                         else
1227                                                         {
1228                                                                 push @inserts,
1229                                                                         {'where' => $offset,   'what' => "\x1B[4m"},
1230                                                                         {'where' => $offset+1, 'what' => "\x1B[24m"};
1231                                                         }
1232                                                 }
1233                                         }
1234                                         if($extras =~ /marks/)
1235                                         {
1236                                                 for my $mark (keys $curfile->{'mark'})
1237                                                 {
1238                                                         next if $mark =~ /^(SELECTION-|)(START|END)$/;
1239                                                         my $p = $curfile->{'mark'}->{$mark};
1240                                                         if($pos <= $p and $p < $end)
1241                                                         {
1242                                                                 push @inserts, {'where' => $p-$pos, 'what' => "\x1B[1m[$mark]\x1B[22m"};
1243                                                         }
1244                                                 }
1245                                         }
1246                                         # TODO close all highlights
1247                                         @inserts = sort {$a->{'where'} <=> $b->{'where'}} @inserts;
1248                                         my $prev_slice_end = 0;
1249                                         for my $ins (@inserts)
1250                                         {
1251                                                 print substr($$data_ref, $prev_slice_end, $ins->{'where'} - $prev_slice_end);
1252                                                 print $ins->{'what'};
1253                                                 $prev_slice_end = $ins->{'where'};
1254                                         }
1255                                         print substr($$data_ref, $prev_slice_end);
1256                                 };
1257
1258                         seeker $curfile, $position_before_operation, SEEK_SET;
1259                 }
1260 =pod
1261
1262 =item show cursor
1263
1264 =cut
1265
1266                 elsif($$instructions_ref =~ s/^show cursor$EOIT//)
1267                 {
1268                         print $position_before_operation;
1269                         print "\n";
1270                 }
1271 =pod
1272
1273 =item show marks
1274
1275 =cut
1276
1277                 elsif($$instructions_ref =~ s/^show marks$EOIT//)
1278                 {
1279                         for my $mark (sort {$curfile->{'mark'}->{$a} <=> $curfile->{'mark'}->{$b}} keys $curfile->{'mark'})
1280                         {
1281                                 printf "%d\t%s\n", $curfile->{'mark'}->{$mark}, $mark;
1282                         }
1283                 }
1284 =item show clipboard
1285
1286 =cut
1287
1288                 elsif($$instructions_ref =~ s/^show clipboard$EOIT//)
1289                 {
1290                         print $Clipboard;
1291                 }
1292 =pod
1293
1294 =item set OPTION [on | off | VALUE]
1295
1296 =item unset OPTION
1297
1298 =cut
1299
1300                 elsif($$instructions_ref =~ s/^((?<CMD>set) (?<OPT>\S+)( (?<VALUE>on|off)|)|(?<CMD>unset) (?<OPT>\S+))$EOIT//)
1301                 {
1302                         my $value = $+{'VALUE'};
1303                         $value = 'off' if $+{'CMD'} eq 'unset';
1304                         my $opt = $+{'OPT'};
1305                         croak "$0: unknown option $opt" unless exists $Opt{$opt};
1306                         if(length $value == 0)
1307                         {
1308                                 $value = get_text_parameter $instructions_ref;
1309                                 croak "$0: value not given for $opt option" unless defined $value;
1310                         }
1311                         $Opt{$opt} = $value;
1312                 }
1313 =pod
1314
1315 =item show options
1316
1317 =cut
1318
1319                 elsif($$instructions_ref =~ s/^show options$EOIT//)
1320                 {
1321                         for my $o (sort keys %Opt)
1322                         {
1323                                 print "$o\t$Opt{$o}\n";
1324                         }
1325                 }
1326 =pod
1327
1328 =item [show] help
1329
1330 =cut
1331
1332                 elsif($$instructions_ref =~ s/^(show |)help$EOIT//)
1333                 {
1334                         pod2usage(-exitval=>'NOEXIT', -verbose=>99);
1335                 }
1336                 elsif($$instructions_ref eq '')
1337                 {
1338                         last;
1339                 }
1340                 else
1341                 {
1342                         my $instr = $$instructions_ref;
1343                         $instr =~ s/\n/\n\t/g;
1344                         $instr =~ s/\n\t$/\n/;
1345                         # TODO abbrev...
1346                         croak "$0: invalid instruction: $instr";
1347                 }
1348         }
1349 =pod
1350
1351 =back
1352
1353 =cut
1354
1355 }
1356
1357
1358
1359 # TODO optional backup files
1360
1361 our %openedfile = ();
1362 our %filepathalias = ();
1363 our $curfile;
1364
1365 our $last_search_pattern = undef;
1366 our $last_search_is_regexp = undef;
1367 our $last_search_result = undef;
1368 our $Clipboard = '';
1369
1370
1371 if(@ARGV)
1372 {
1373         my $Instructions = join ' ', map { if(/[ \r\n""]/ or $_ eq ''){ s/[""]/\\$&/g; $_="\"$_\""; }; $_ } @ARGV;
1374         process_instructions \$Instructions;
1375 }
1376
1377 for my $espath (@OptEditorScript)
1378 {
1379         my $es;
1380         if($espath eq '-')
1381         {
1382                 # TODO readline
1383                 while(my $Instructions = <STDIN>)
1384                 {
1385                         eval { process_instructions \$Instructions; 1; };
1386                         if($@)
1387                         {
1388                                 warn $@;
1389                         }
1390                         elsif($Opt{'successful-prompt-command'} ne 'none')
1391                         {
1392                                 my $instr = $Opt{'successful-prompt-command'};
1393                                 eval { process_instructions \$instr; 1; };
1394                                 warn $@ if $@;
1395                         }
1396                 }
1397         }
1398         else
1399         {
1400                 open $es, '<', $espath or croak "$0: $espath: open: $!";
1401                 local $/ = undef;
1402                 my $Instructions = <$es>;
1403                 my $instr_length = length $Instructions;
1404                 my $cur_instr_offset = 0;
1405                 eval { process_instructions \$Instructions, \$cur_instr_offset; 1; };
1406                 if($@)
1407                 {
1408                         my $o = $instr_length - length $Instructions;
1409                         my $loc;
1410                         if($o == $cur_instr_offset) { $loc = "at offset $cur_instr_offset"; }
1411                         else { $loc = "between offset $cur_instr_offset and $o" ; }
1412                         warn "$0: exception in script $espath $loc\n";
1413                         warn "$0: current file: $curfile->{'path'}\n";
1414                         die $@;
1415                 }
1416         }
1417         close $es;
1418 }
1419
1420
1421
1422 our $close_err = 0;
1423 for my $fdata (values %openedfile)
1424 {
1425         close $fdata->{'handle'} and next;
1426         $close_err = $!;
1427         warn "$0: $fdata->{'path'}: close: $!\n";
1428 }
1429 exit $close_err;
1430
1431
1432 # TODO positioning and offsets should represent chars, not bytes (multibyte/utf8 support)