4 use File::Basename qw(&basename &dirname);
7 # List explicitly here the variables you want Configure to
8 # generate. Metaconfig only looks for shell variables, so you
9 # have to mention them as if they were shell variables, not
10 # %Config entries. Thus you write
12 # to ensure Configure will look for $Config{startperl}.
14 # This forces PL files to create target in same directory as PL file.
15 # This is so that make depend always knows where to find PL derivatives.
18 $file = basename($0, '.PL');
19 $file .= '.com' if $^O eq 'VMS';
21 open OUT,">$file" or die "Can't create $file: $!";
23 print "Extracting $file (with variable substitutions)\n";
25 # In this section, perl variables will be expanded during extraction.
26 # You can use $Config{...} to use Configure variables.
28 print OUT <<"!GROK!THIS!";
30 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
31 if \$running_under_some_shell;
34 (\$startperl = <<'/../') =~ s/\\s*\\z//;
37 (\$perlpath = <<'/../') =~ s/\\s*\\z//;
42 # In the following, perl variables are not expanded during extraction.
44 print OUT <<'!NO!SUBS!';
46 $0 =~ s/^.*?(\w+)[\.\w]*$/$1/;
48 # (p)sed - a stream editor
49 # History: Aug 12 2000: Original version.
50 # Mar 25 2002: Rearrange generated Perl program.
58 psed - a stream editor
62 psed [-an] script [file ...]
63 psed [-an] [-e script] [-f script-file] [file ...]
65 s2p [-an] [-e script] [-f script-file]
69 A stream editor reads the input stream consisting of the specified files
70 (or standard input, if none are given), processes is line by line by
71 applying a script consisting of edit commands, and writes resulting lines
72 to standard output. The filename `C<->' may be used to read standard input.
74 The edit script is composed from arguments of B<-e> options and
75 script-files, in the given order. A single script argument may be specified
76 as the first parameter.
78 If this program is invoked with the name F<s2p>, it will act as a
79 sed-to-Perl translator. See L<"sed Script Translation">.
81 B<sed> returns an exit code of 0 on success or >0 if an error occurred.
89 A file specified as argument to the B<w> edit command is by default
90 opened before input processing starts. Using B<-a>, opening of such
91 files is delayed until the first line is actually written to the file.
95 The editing commands defined by I<script> are appended to the script.
96 Multiple commands must be separated by newlines.
98 =item B<-f> I<script-file>
100 Editing commands from the specified I<script-file> are read and appended
105 By default, a line is written to standard output after the editing script
106 has been applied to it. The B<-n> option suppresses automatic printing.
112 B<sed> command syntax is defined as
114 Z<> Z<> Z<> Z<>[I<address>[B<,>I<address>]][B<!>]I<function>[I<argument>]
116 with whitespace being permitted before or after addresses, and between
117 the function character and the argument. The I<address>es and the
118 address inverter (C<!>) are used to restrict the application of a
119 command to the selected line(s) of input.
121 Each command must be on a line of its own, except where noted in
124 The edit cycle performed on each input line consist of reading the line
125 (without its trailing newline character) into the I<pattern space>,
126 applying the applicable commands of the edit script, writing the final
127 contents of the pattern space and a newline to the standard output.
128 A I<hold space> is provided for saving the contents of the
129 pattern space for later use.
133 A sed address is either a line number or a pattern, which may be combined
134 arbitrarily to construct ranges. Lines are numbered across all input files.
136 Any address may be followed by an exclamation mark (`C<!>'), selecting
137 all lines not matching that address.
143 The line with the given number is selected.
147 A dollar sign (C<$>) is the line number of the last line of the input stream.
149 =item B</>I<regular expression>B</>
151 A pattern address is a basic regular expression (see
152 L<"Basic Regular Expressions">), between the delimiting character C</>.
153 Any other character except C<\> or newline may be used to delimit a
154 pattern address when the initial delimiter is prefixed with a
159 If no address is given, the command selects every line.
161 If one address is given, it selects the line (or lines) matching the
164 Two addresses select a range that begins whenever the first address
165 matches, and ends (including that line) when the second address matches.
166 If the first (second) address is a matching pattern, the second
167 address is not applied to the very same line to determine the end of
168 the range. Likewise, if the second address is a matching pattern, the
169 first address is not applied to the very same line to determine the
170 begin of another range. If both addresses are line numbers,
171 and the second line number is less than the first line number, then
172 only the first line is selected.
177 The maximum permitted number of addresses is indicated with each
178 function synopsis below.
180 The argument I<text> consists of one or more lines following the command.
181 Embedded newlines in I<text> must be preceded with a backslash. Other
182 backslashes in I<text> are deleted and the following character is taken
191 #--------------------------------------------------------------------------
192 $ComTab{'a'}=[ 1, 'txt', \&Emit, '{ push( @Q, <<'."'TheEnd' ) }\n" ]; #ok
194 =item [1addr]B<a\> I<text>
196 Write I<text> (which must start on the line following the command)
197 to standard output immediately before reading the next line
198 of input, either by executing the B<N> function or by beginning a new cycle.
202 #--------------------------------------------------------------------------
203 $ComTab{'b'}=[ 2, 'str', \&Branch, '{ goto XXX; }' ]; #ok
205 =item [2addr]B<b> [I<label>]
207 Branch to the B<:> function with the specified I<label>. If no label
208 is given, branch to the end of the script.
212 #--------------------------------------------------------------------------
213 $ComTab{'c'}=[ 2, 'txt', \&Change, <<'-X-' ]; #ok
214 { print <<'TheEnd'; } $doPrint = 0; goto EOS;
216 ### continue OK => next CYCLE;
218 =item [2addr]B<c\> I<text>
220 The line, or range of lines, selected by the address is deleted.
221 The I<text> (which must start on the line following the command)
222 is written to standard output. With an address range, this occurs at
223 the end of the range.
227 #--------------------------------------------------------------------------
228 $ComTab{'d'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
233 ### continue OK => next CYCLE;
237 Deletes the pattern space and starts the next cycle.
241 #--------------------------------------------------------------------------
242 $ComTab{'D'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
244 if(length($_)){ goto BOS } else { goto EOS }
247 ### continue OK => next CYCLE;
251 Deletes the pattern space through the first embedded newline or to the end.
252 If the pattern space becomes empty, a new cycle is started, otherwise
253 execution of the script is restarted.
257 #--------------------------------------------------------------------------
258 $ComTab{'g'}=[ 2, '', \&Emit, '{ $_ = $Hold };' ]; #ok
262 Replace the contents of the pattern space with the hold space.
266 #--------------------------------------------------------------------------
267 $ComTab{'G'}=[ 2, '', \&Emit, '{ $_ .= "\n"; $_ .= $Hold };' ]; #ok
271 Append a newline and the contents of the hold space to the pattern space.
275 #--------------------------------------------------------------------------
276 $ComTab{'h'}=[ 2, '', \&Emit, '{ $Hold = $_ }' ]; #ok
280 Replace the contents of the hold space with the pattern space.
284 #--------------------------------------------------------------------------
285 $ComTab{'H'}=[ 2, '', \&Emit, '{ $Hold .= "\n"; $Hold .= $_; }' ]; #ok
289 Append a newline and the contents of the pattern space to the hold space.
293 #--------------------------------------------------------------------------
294 $ComTab{'i'}=[ 1, 'txt', \&Emit, '{ print <<'."'TheEnd' }\n" ]; #ok
296 =item [1addr]B<i\> I<text>
298 Write the I<text> (which must start on the line following the command)
303 #--------------------------------------------------------------------------
304 $ComTab{'l'}=[ 2, '', \&Emit, '{ _l() }' ]; #okUTF8
308 Print the contents of the pattern space: non-printable characters are
309 shown in C-style escaped form; long lines are split and have a trailing
310 `C<\>' at the point of the split; the true end of a line is marked with
311 a `C<$>'. Escapes are: `\a', `\t', `\n', `\f', `\r', `\e' for
312 BEL, HT, LF, FF, CR, ESC, respectively, and `\' followed by a three-digit
313 octal number for all other non-printable characters.
317 #--------------------------------------------------------------------------
318 $ComTab{'n'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
319 { print $_, "\n" if $doPrint;
322 last CYCLE unless getsARGV();
329 If automatic printing is enabled, write the pattern space to the standard
330 output. Replace the pattern space with the next line of input. If
331 there is no more input, processing is terminated.
335 #--------------------------------------------------------------------------
336 $ComTab{'N'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
339 last CYCLE unless getsARGV( $h );
347 Append a newline and the next line of input to the pattern space. If
348 there is no more input, processing is terminated.
352 #--------------------------------------------------------------------------
353 $ComTab{'p'}=[ 2, '', \&Emit, '{ print $_, "\n"; }' ]; #ok
357 Print the pattern space to the standard output. (Use the B<-n> option
358 to suppress automatic printing at the end of a cycle if you want to
359 avoid double printing of lines.)
363 #--------------------------------------------------------------------------
364 $ComTab{'P'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
365 { if( /^(.*)/ ){ print $1, "\n"; } }
370 Prints the pattern space through the first embedded newline or to the end.
374 #--------------------------------------------------------------------------
375 $ComTab{'q'}=[ 1, '', \&Emit, <<'-X-' ]; #ok
376 { print $_, "\n" if $doPrint;
383 Branch to the end of the script and quit without starting a new cycle.
387 #--------------------------------------------------------------------------
388 $ComTab{'r'}=[ 1, 'str', \&Emit, "{ _r( '-X-' ) }" ]; #ok
390 =item [1addr]B<r> I<file>
392 Copy the contents of the I<file> to standard output immediately before
393 the next attempt to read a line of input. Any error encountered while
394 reading I<file> is silently ignored.
398 #--------------------------------------------------------------------------
399 $ComTab{'s'}=[ 2, 'sub', \&Emit, '' ]; #ok
401 =item [2addr]B<s/>I<regular expression>B</>I<replacement>B</>I<flags>
403 Substitute the I<replacement> string for the first substring in
404 the pattern space that matches the I<regular expression>.
405 Any character other than backslash or newline can be used instead of a
406 slash to delimit the regular expression and the replacement.
407 To use the delimiter as a literal character within the regular expression
408 and the replacement, precede the character by a backslash (`C<\>').
410 Literal newlines may be embedded in the replacement string by
411 preceding a newline with a backslash.
413 Within the replacement, an ampersand (`C<&>') is replaced by the string
414 matching the regular expression. The strings `C<\1>' through `C<\9>' are
415 replaced by the corresponding subpattern (see L<"Basic Regular Expressions">).
416 To get a literal `C<&>' or `C<\>' in the replacement text, precede it
419 The following I<flags> modify the behaviour of the B<s> command:
425 The replacement is performed for all matching, non-overlapping substrings
426 of the pattern space.
430 Replace only the n-th matching substring of the pattern space.
434 If the substitution was made, print the new value of the pattern space.
438 If the substitution was made, write the new value of the pattern space
439 to the specified file.
445 #--------------------------------------------------------------------------
446 $ComTab{'t'}=[ 2, 'str', \&Branch, '{ goto XXX if _t() }' ]; #ok
448 =item [2addr]B<t> [I<label>]
450 Branch to the B<:> function with the specified I<label> if any B<s>
451 substitutions have been made since the most recent reading of an input line
452 or execution of a B<t> function. If no label is given, branch to the end of
458 #--------------------------------------------------------------------------
459 $ComTab{'w'}=[ 2, 'str', \&Write, "{ _w( '-X-' ) }" ]; #ok
461 =item [2addr]B<w> I<file>
463 The contents of the pattern space are written to the I<file>.
467 #--------------------------------------------------------------------------
468 $ComTab{'x'}=[ 2, '', \&Emit, '{ ($Hold, $_) = ($_, $Hold) }' ]; #ok
472 Swap the contents of the pattern space and the hold space.
476 #--------------------------------------------------------------------------
477 $ComTab{'y'}=[ 2, 'tra', \&Emit, '' ]; #ok
478 =item [2addr]B<y>B</>I<string1>B</>I<string2>B</>
480 In the pattern space, replace all characters occuring in I<string1> by the
481 character at the corresponding position in I<string2>. It is possible
482 to use any character (other than a backslash or newline) instead of a
483 slash to delimit the strings. Within I<string1> and I<string2>, a
484 backslash followed by any character other than a newline is that literal
485 character, and a backslash followed by an `n' is replaced by a newline
490 #--------------------------------------------------------------------------
491 $ComTab{'='}=[ 1, '', \&Emit, '{ print "$.\n" }' ]; #ok
495 Prints the current line number on the standard output.
499 #--------------------------------------------------------------------------
500 $ComTab{':'}=[ 0, 'str', \&Label, '' ]; #ok
502 =item [0addr]B<:> [I<label>]
504 The command specifies the position of the I<label>. It has no other effect.
508 #--------------------------------------------------------------------------
509 $ComTab{'{'}=[ 2, '', \&BeginBlock, '{' ]; #ok
510 $ComTab{'}'}=[ 0, '', \&EndBlock, ';}' ]; #ok
511 # ';' to avoid warning on empty {}-block
513 =item [2addr]B<{> [I<command>]
517 These two commands begin and end a command list. The first command may
518 be given on the same line as the opening B<{> command. The commands
519 within the list are jointly selected by the address(es) given on the
520 B<{> command (but may still have individual addresses).
524 #--------------------------------------------------------------------------
525 $ComTab{'#'}=[ 0, 'str', \&Comment, '' ]; #ok
527 =item [0addr]B<#> [I<comment>]
529 The entire line is ignored (treated as a comment). If, however, the first
530 two characters in the script are `C<#n>', automatic printing of output is
531 suppressed, as if the B<-n> option were given on the command line.
537 use vars qw{ $isEOF $Hold %wFiles @Q $CondReg $doPrint };
539 my $useDEBUG = exists( $ENV{PSEDDEBUG} );
540 my $useEXTBRE = $ENV{PSEDEXTBRE} || '';
541 $useEXTBRE =~ s/[^<>wWyB]//g; # gawk RE's handle these
543 my $doAutoPrint = 1; # automatic printing of pattern space (-n => 0)
544 my $doOpenWrite = 1; # open w command output files at start (-a => 0)
545 my $svOpenWrite = 0; # save $doOpenWrite
546 my $doGenerate = $0 eq 's2p';
548 # Collected and compiled script
550 my( @Commands, %Defined, @BlockStack, %Label, $labNum, $Code, $Func );
561 my( $msg, $loc ) = @_;
563 $loc .= ': ' if length( $loc );
564 warn( "$0: $loc$msg\n" );
569 return 'L_'.++$labNum;
572 # safeHere: create safe here delimiter and modify opcode and argument
575 my( $codref, $argref ) = @_;
577 while( $$argref =~ /^$eod$/m ){
580 $$codref =~ s/TheEnd/$eod/e;
581 $$argref .= "$eod\n";
584 # Emit: create address logic and emit command
587 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
589 if( defined( $addr1 ) ){
590 if( defined( $addr2 ) ){
591 $addr1 .= $addr2 =~ /^\d+$/ ? "..$addr2" : "...$addr2";
593 $addr1 .= ' == $.' if $addr1 =~ /^\d+$/;
595 $cond = $negated ? "unless( $addr1 )\n" : "if( $addr1 )\n";
599 $Code .= "$cond$arg\n";
601 } elsif( $opcode =~ s/-X-/$arg/e ){
602 $Code .= "$cond$opcode\n";
604 } elsif( $opcode =~ /TheEnd/ ){
605 safeHere( \$opcode, \$arg );
606 $Code .= "$cond$opcode$arg";
609 $Code .= "$cond$opcode\n";
614 # Write (w command, w flag): store pathname
617 my( $addr1, $addr2, $negated, $opcode, $path, $fl ) = @_;
619 Emit( $addr1, $addr2, $negated, $opcode, $path, $fl );
623 # Label (: command): label definition
626 my( $addr1, $addr2, $negated, $opcode, $lab, $fl ) = @_;
629 if( length( $lab ) ){
631 if( ! exists( $Label{$lab} ) ){
632 $h = $Label{$lab}{name} = newLabel();
634 $h = $Label{$lab}{name};
635 if( exists( $Label{$lab}{defined} ) ){
636 my $dl = $Label{$lab}{defined};
637 Warn( "duplicate label $lab (first defined at $dl)", $fl );
641 $Label{$lab}{defined} = $fl;
647 # BeginBlock ({ command): push block start
649 sub BeginBlock($$$$$$){
650 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
651 push( @BlockStack, [ $fl, $addr1, $addr2, $negated ] );
652 Emit( $addr1, $addr2, $negated, $opcode, $arg, $fl );
655 # EndBlock (} command): check proper nesting
657 sub EndBlock($$$$$$){
658 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
660 my $jcom = pop( @BlockStack );
661 if( defined( $jcom ) ){
662 $rc = Emit( $addr1, $addr2, $negated, $opcode, $arg, $fl );
664 Warn( "unexpected `}'", $fl );
670 # Branch (t, b commands): check or create label, substitute default
673 my( $addr1, $addr2, $negated, $opcode, $lab, $fl ) = @_;
674 $lab =~ s/\s+//; # no spaces at end
676 if( length( $lab ) ){
677 if( ! exists( $Label{$lab} ) ){
678 $h = $Label{$lab}{name} = newLabel();
680 $h = $Label{$lab}{name};
682 push( @{$Label{$lab}{used}}, $fl );
686 $opcode =~ s/XXX/$h/e;
687 Emit( $addr1, $addr2, $negated, $opcode, '', $fl );
690 # Change (c command): is special due to range end watching
693 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
694 my $kwd = $negated ? 'unless' : 'if';
695 if( defined( $addr2 ) ){
696 $addr1 .= $addr2 =~ /^\d+$/ ? "..$addr2" : "...$addr2";
698 $addr1 = '$icnt = ('.$addr1.')';
699 $opcode = 'if( $icnt =~ /E0$/ )' . $opcode;
702 $addr1 .= ' == $.' if $addr1 =~ /^\d+$/;
704 safeHere( \$opcode, \$arg );
705 $Code .= "$kwd( $addr1 ){\n $opcode$arg}\n";
710 # Comment (# command): A no-op. Who would've thought that!
713 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
714 ### $Code .= "# $arg\n";
720 my( $del, $sref ) = @_;
722 print "stripRegex:$del:$$sref:\n" if $useDEBUG;
723 while( $$sref =~ s{^(.*?)(\\*)\Q$del\E(\s*)}{}s ){
725 $regex .= $1.$sl.$del;
726 if( length( $sl ) % 2 == 0 ){
734 # stripTrans: take a <del> terminated string from y command
735 # honoring and cleaning up of \-escaped <del>'s
738 my( $del, $sref ) = @_;
740 print "stripTrans:$del:$$sref:\n" if $useDEBUG;
741 while( $$sref =~ s{^(.*?)(\\*)\Q$del\E}{}s ){
744 if( length( $sl ) % 2 == 0 ){
755 # makey - construct Perl y/// from sed y///
758 my( $fr, $to, $fl ) = @_;
761 # Ensure that any '-' is up front.
762 # Diagnose duplicate contradicting mappings
764 for( my $i = 0; $i < length($fr); $i++ ){
765 my $fc = substr($fr,$i,1);
766 my $tc = substr($to,$i,1);
767 if( exists( $tr{$fc} ) && $tr{$fc} ne $tc ){
768 Warn( "ambiguos translation for character `$fc' in `y' command",
775 if( exists( $tr{'-'} ) ){
776 ( $fr, $to ) = ( '-', $tr{'-'} );
781 # might just as well sort it...
782 for my $fc ( sort keys( %tr ) ){
786 # make embedded delimiters and newlines safe
787 $fr =~ s/([{}])/\$1/g;
788 $to =~ s/([{}])/\$1/g;
791 return $error ? undef() : "{ y{$fr}{$to}; }";
795 # makes - construct Perl s/// from sed s///
798 my( $regex, $subst, $path, $global, $print, $nmatch, $fl ) = @_;
800 # make embedded newlines safe
801 $regex =~ s/\n/\\n/g;
802 $subst =~ s/\n/\\n/g;
807 if( length( $nmatch ) ){
810 while( --\$n && ( \$s = m ${regex}g ) ){}
811 \$s = ( substr( \$_, pos() ) =~ s ${regex}${subst}s ) if \$s;
816 { \$s = s ${regex}${subst}s${global};
821 $code .= ' print $_, "\n" if $s;'."\n";
823 if( defined( $path ) ){
825 $code .= " _w( '$path' ) if \$s;\n";
831 =head1 BASIC REGULAR EXPRESSIONS
833 A I<Basic Regular Expression> (BRE), as defined in POSIX 1003.2, consists
834 of I<atoms>, for matching parts of a string, and I<bounds>, specifying
835 repetitions of a preceding atom.
839 The possible atoms of a BRE are: B<.>, matching any single character;
840 B<^> and B<$>, matching the null string at the beginning or end
841 of a string, respectively; a I<bracket expressions>, enclosed
842 in B<[> and B<]> (see below); and any single character with no
843 other significance (matching that character). A B<\> before one
844 of: B<.>, B<^>, B<$>, B<[>, B<*>, B<\>, matching the character
845 after the backslash. A sequence of atoms enclosed in B<\(> and B<\)>
846 becomes an atom and establishes the target for a I<backreference>,
847 consisting of the substring that actually matches the enclosed atoms.
848 Finally, B<\> followed by one of the digits B<0> through B<9> is a
851 A B<^> that is not first, or a B<$> that is not last does not have
852 a special significance and need not be preceded by a backslash to
853 become literal. The same is true for a B<]>, that does not terminate
854 a bracket expression.
856 An unescaped backslash cannot be last in a BRE.
860 The BRE bounds are: B<*>, specifying 0 or more matches of the preceding
861 atom; B<\{>I<count>B<\}>, specifying that many repetitions;
862 B<\{>I<minimum>B<,\}>, giving a lower limit; and
863 B<\{>I<minimum>B<,>I<maximum>B<\}> finally defines a lower and upper
866 A bound appearing as the first item in a BRE is taken literally.
868 =head2 Bracket Expressions
870 A I<bracket expression> is a list of characters, character ranges
871 and character classes enclosed in B<[> and B<]> and matches any
872 single character from the represented set of characters.
874 A character range is written as two characters separated by B<-> and
875 represents all characters (according to the character collating sequence)
876 that are not less than the first and not greater than the second.
877 (Ranges are very collating-sequence-dependent, and portable programs
878 should avoid relying on them.)
880 A character class is one of the class names
887 enclosed in B<[:> and B<:]> and represents the set of characters
888 as defined in ctype(3).
890 If the first character after B<[> is B<^>, the sense of matching is
893 To include a literal `C<^>', place it anywhere else but first. To
894 include a literal 'C<]>' place it first or immediately after an
895 initial B<^>. To include a literal `C<->' make it the first (or
896 second after B<^>) or last character, or the second endpoint of
899 The special bracket expression constructs C<[[:E<lt>:]]> and C<[[:E<gt>:]]>
900 match the null string at the beginning and end of a word respectively.
901 (Note that neither is identical to Perl's `\b' atom.)
903 =head2 Additional Atoms
905 Since some sed implementations provide additional regular expression
906 atoms (not defined in POSIX 1003.2), B<psed> is capable of translating
907 the following backslash escapes:
911 =item B<\E<lt>> This is the same as C<[[:E<gt>:]]>.
913 =item B<\E<gt>> This is the same as C<[[:E<lt>:]]>.
915 =item B<\w> This is an abbreviation for C<[[:alnum:]_]>.
917 =item B<\W> This is an abbreviation for C<[^[:alnum:]_]>.
919 =item B<\y> Match the empty string at a word boundary.
921 =item B<\B> Match the empty string between any two either word or non-word characters.
925 To enable this feature, the environment variable PSEDEXTBRE must be set
926 to a string containing the requested characters, e.g.:
927 C<PSEDEXTBRE='E<lt>E<gt>wW'>.
932 # bre2p - convert BRE to Perl RE
935 my( $pref, $ic ) = @_;
936 $ic < length($$pref)-1 ? substr( $$pref, $ic+1, 1 ) : '';
940 my( $del, $pat, $fl ) = @_;
942 $led =~ tr/{([</})]>/;
943 $led = '' if $led eq $del;
945 $pat = substr( $pat, 1, length($pat) - 2 );
950 for( my $ic = 0; $ic < length( $pat ); $ic++ ){
951 my $c = substr( $pat, $ic, 1 );
953 ### backslash escapes
954 my $nc = peek($pat,$ic);
956 Warn( "`\\' cannot be last in pattern", $fl );
960 if( $nc eq $del ){ ## \<pattern del> => \<pattern del>
963 } elsif( $nc =~ /([[.*\\n])/ ){
964 ## check for \-escaped magics and \n:
965 ## \[ \. \* \\ \n stay as they are
968 } elsif( $nc eq '(' ){ ## \( => (
972 } elsif( $nc eq ')' ){ ## \) => )
976 Warn( "unmatched `\\)'", $fl );
981 } elsif( $nc eq '{' ){ ## repetition factor \{<i>[,[<j>]]\}
982 my $endpos = index( $pat, '\\}', $ic );
984 Warn( "unmatched `\\{'", $fl );
987 my $rep = substr( $pat, $ic+1, $endpos-($ic+1) );
990 if( $res =~ /^\^?$/ ){
992 } elsif( $rep =~ /^(\d+)(,?)(\d*)?$/ ){
996 if( length( $max ) ){
998 Warn( "maximum less than minimum in `\\{$rep\\}'",
1006 if( $min == 0 && $max eq '1' ){
1008 } elsif( $min == 1 && "$com$max" eq ',' ){
1010 } elsif( $min == 0 && "$com$max" eq ',' ){
1013 $res .= "{$min$com$max}";
1016 Warn( "invalid repeat clause `\\{$rep\\}'", $fl );
1020 } elsif( $nc =~ /^[1-9]$/ ){
1021 ## \1 .. \9 => \1 .. \9, but check for a following digit
1022 if( $nc > $backref ){
1023 Warn( "invalid backreference ($nc)", $fl );
1027 if( peek($pat,$ic) =~ /[0-9]/ ){
1031 } elsif( $useEXTBRE && ( $nc =~ /[$useEXTBRE]/ ) ){
1032 ## extensions - at most <>wWyB - not in POSIX
1033 if( $nc eq '<' ){ ## \< => \b(?=\w), be precise
1034 $res .= '\\b(?<=\\W)';
1035 } elsif( $nc eq '>' ){ ## \> => \b(?=\W), be precise
1036 $res .= '\\b(?=\\W)';
1037 } elsif( $nc eq 'y' ){ ## \y => \b
1039 } else { ## \B, \w, \W remain the same
1042 } elsif( $nc eq $led ){
1043 ## \<closing bracketing-delimiter> - keep '\'
1046 } else { ## \ <char> => <char> ("as if `\' were not present")
1050 } elsif( $c eq '.' ){ ## . => .
1053 } elsif( $c eq '*' ){ ## * => * but \* if there's nothing preceding it
1054 if( $res =~ /^\^?$/ ){
1056 } elsif( substr( $res, -1, 1 ) ne '*' ){
1060 } elsif( $c eq '[' ){
1061 ## parse []: [^...] [^]...] [-...]
1063 if( peek($pat,$ic) eq '^' ){
1067 my $nc = peek($pat,$ic);
1068 if( $nc eq ']' || $nc eq '-' ){
1072 # check that [ is not trailing
1073 if( $ic >= length( $pat ) - 1 ){
1074 Warn( "unmatched `['", $fl );
1077 # look for [:...:] and x-y
1078 my $rstr = substr( $pat, $ic+1 );
1079 if( $rstr =~ /^((?:\[:\(\w+|[><]\):\]|[^]-](?:-[^]])?)*)/ ){
1081 $ic += length( $cnt );
1082 $cnt =~ s/([\\\$])/\\$1/g; # `\', `$' are magic in Perl []
1083 # try some simplifications
1085 if( $red =~ s/0-9// ){
1087 if( $red =~ s/A-Z// && $red =~ s/a-z// && $red =~ s/_// ){
1093 # POSIX 1003.2 has this (optional) for begin/end word
1094 $add = '\\b(?=\\W)' if $add eq '[[:<:]]';
1095 $add = '\\b(?<=\\W)' if $add eq '[[:>:]]';
1099 ## may have a trailing `-' before `]'
1100 if( $ic < length($pat) - 1 &&
1101 substr( $pat, $ic+1 ) =~ /^(-?])/ ){
1102 $ic += length( $1 );
1104 # another simplification
1105 $add =~ s/^\[(\^?)(\\[dw])]$/ $1 eq '^' ? uc($2) : $2 /e;
1108 Warn( "unmatched `['", $fl );
1112 } elsif( $c eq $led ){ ## unescaped <closing bracketing-delimiter>
1115 } elsif( $c eq ']' ){ ## unmatched ] is not magic
1118 } elsif( $c =~ /[|+?{}()]/ ){ ## not magic in BRE, but in Perl: \-quote
1121 } elsif( $c eq '^' ){ ## not magic unless 1st, but in Perl: \-quote
1122 $res .= length( $res ) ? '\\^' : '^';
1124 } elsif( $c eq '$' ){ ## not magic unless last, but in Perl: \-quote
1125 $res .= $ic == length( $pat ) - 1 ? '$' : '\\$';
1133 Warn( "unmatched `\\('", $fl );
1137 # final cleanup: eliminate raw HTs
1139 return $del . $res . ( $led ? $led : $del );
1144 # sub2p - convert sed substitution to Perl substitution
1147 my( $del, $subst, $fl ) = @_;
1149 $led =~ tr/{([</})]>/;
1150 $led = '' if $led eq $del;
1152 $subst = substr( $subst, 1, length($subst) - 2 );
1155 for( my $ic = 0; $ic < length( $subst ); $ic++ ){
1156 my $c = substr( $subst, $ic, 1 );
1158 ### backslash escapes
1159 my $nc = peek($subst,$ic);
1161 Warn( "`\\' cannot be last in substitution", $fl );
1165 if( $nc =~ /[\\$del$led]/ ){ ## \ and delimiter
1167 } elsif( $nc =~ /[1-9]/ ){ ## \1 - \9 => ${1} - ${9}
1168 $res .= '${' . $nc . '}';
1169 } else { ## everything else (includes &): omit \
1172 } elsif( $c eq '&' ){ ## & => $&
1174 } elsif( $c =~ /[\$\@$led]/ ){ ## magic in Perl's substitution string
1181 # final cleanup: eliminate raw HTs
1183 return ( $led ? $del : $led ) . $res . ( $led ? $led : $del );
1189 my( $pdef, $pfil, $plin );
1190 for( my $icom = 0; $icom < @Commands; $icom++ ){
1191 my $cmd = $Commands[$icom];
1192 print "Parse:$cmd:\n" if $useDEBUG;
1194 next unless length( $cmd );
1196 if( exists( $Defined{$icom} ) ){
1197 $pdef = $Defined{$icom};
1198 if( $pdef =~ /^ #(\d+)/ ){
1199 $pfil = 'expression #';
1208 my $fl = "$pfil$plin";
1210 # insert command as comment in gnerated code
1212 $Code .= "# $cmd\n" if $doGenerate;
1216 my( $negated, $naddr, $addr1, $addr2 );
1218 if( $cmd =~ s/^(\d+)\s*// ){
1219 $addr1 = "$1"; $naddr++;
1220 } elsif( $cmd =~ s/^\$\s*// ){
1221 $addr1 = 'eofARGV()'; $naddr++;
1222 } elsif( $cmd =~ s{^(/)}{} || $cmd =~ s{^\\(.)}{} ){
1224 my $regex = stripRegex( $del, \$cmd );
1225 if( defined( $regex ) ){
1226 $addr1 = 'm '.bre2p( $del, $regex, $fl ).'s';
1229 Warn( "malformed regex, 1st address", $fl );
1234 if( defined( $addr1 ) && $cmd =~ s/,\s*// ){
1235 if( $cmd =~ s/^(\d+)\s*// ){
1236 $addr2 = "$1"; $naddr++;
1237 } elsif( $cmd =~ s/^\$\s*// ){
1238 $addr2 = 'eofARGV()'; $naddr++;
1239 } elsif( $cmd =~ s{^(/)}{} || $cmd =~ s{^\\(.)}{} ){
1241 my $regex = stripRegex( $del, \$cmd );
1242 if( defined( $regex ) ){
1243 $addr2 = 'm '. bre2p( $del, $regex, $fl ).'s';
1246 Warn( "malformed regex, 2nd address", $fl );
1251 Warn( "invalid address after `,'", $fl );
1257 # address modifier `!'
1259 $negated = $cmd =~ s/^!\s*//;
1260 if( defined( $addr1 ) ){
1261 print "Parse: addr1=$addr1" if $useDEBUG;
1262 if( defined( $addr2 ) ){
1263 print ", addr2=$addr2 " if $useDEBUG;
1264 # both numeric and addr1 > addr2 => eliminate addr2
1265 undef( $addr2 ) if $addr1 =~ /^\d+$/ &&
1266 $addr2 =~ /^\d+$/ && $addr1 > $addr2;
1269 print 'negated' if $useDEBUG && $negated;
1270 print " command:$cmd\n" if $useDEBUG;
1274 if( $cmd !~ s/^([:#={}abcdDgGhHilnNpPqrstwxy])\s*// ){
1275 my $h = substr( $cmd, 0, 1 );
1276 Warn( "unknown command `$h'", $fl );
1282 my $tabref = $ComTab{$key};
1284 if( $naddr > $tabref->[0] ){
1285 Warn( "excess address(es)", $fl );
1291 if( $tabref->[1] eq 'str' ){
1292 # take remainder - don't care if it is empty
1296 } elsif( $tabref->[1] eq 'txt' ){
1298 my $goon = $cmd =~ /(.*)\\$/;
1300 Warn( "extra characters after command ($cmd)", $fl );
1305 if( $icom > $#Commands ){
1306 Warn( "unexpected end of script", $fl );
1310 $cmd = $Commands[$icom];
1311 $Code .= "# $cmd\n" if $doGenerate;
1312 $goon = $cmd =~ s/\\$//;
1313 $cmd =~ s/\\(.)/$1/g;
1314 $arg .= "\n" if length( $arg );
1317 $arg .= "\n" if length( $arg );
1320 } elsif( $tabref->[1] eq 'sub' ){
1322 if( ! length( $cmd ) ){
1323 Warn( "`s' command requires argument", $fl );
1327 if( $cmd =~ s{^([^\\\n])}{} ){
1329 my $regex = stripRegex( $del, \$cmd );
1330 if( ! defined( $regex ) ){
1331 Warn( "malformed regular expression", $fl );
1335 $regex = bre2p( $del, $regex, $fl );
1337 # a trailing \ indicates embedded NL (in replacement string)
1338 while( $cmd =~ s/(?<!\\)\\$/\n/ ){
1340 if( $icom > $#Commands ){
1341 Warn( "unexpected end of script", $fl );
1345 $cmd .= $Commands[$icom];
1346 $Code .= "# $Commands[$icom]\n" if $doGenerate;
1349 my $subst = stripRegex( $del, \$cmd );
1350 if( ! defined( $regex ) ){
1351 Warn( "malformed substitution expression", $fl );
1355 $subst = sub2p( $del, $subst, $fl );
1357 # parse s/// modifier: g|p|0-9|w <file>
1358 my( $global, $nmatch, $print, $write ) =
1359 ( '', '', 0, undef );
1360 while( $cmd =~ s/^([gp0-9])// ){
1361 $1 eq 'g' ? ( $global = 'g' ) :
1362 $1 eq 'p' ? ( $print = $1 ) : ( $nmatch .= $1 );
1364 $write = $1 if $cmd =~ s/w\s*(.*)$//;
1365 ### $nmatch =~ s/^(\d)\1*$/$1/; ### may be dangerous?
1366 if( $global && length( $nmatch ) || length( $nmatch ) > 1 ){
1367 Warn( "conflicting flags `$global$nmatch'", $fl );
1372 $arg = makes( $regex, $subst,
1373 $write, $global, $print, $nmatch, $fl );
1374 if( ! defined( $arg ) ){
1380 Warn( "improper delimiter in s command", $fl );
1385 } elsif( $tabref->[1] eq 'tra' ){
1387 # a trailing \ indicates embedded newline
1388 while( $cmd =~ s/(?<!\\)\\$/\n/ ){
1390 if( $icom > $#Commands ){
1391 Warn( "unexpected end of script", $fl );
1395 $cmd .= $Commands[$icom];
1396 $Code .= "# $Commands[$icom]\n" if $doGenerate;
1398 if( ! length( $cmd ) ){
1399 Warn( "`y' command requires argument", $fl );
1403 my $d = substr( $cmd, 0, 1 ); $cmd = substr( $cmd, 1 );
1405 Warn( "`\\' not valid as delimiter in `y' command", $fl );
1409 my $fr = stripTrans( $d, \$cmd );
1410 if( ! defined( $fr ) || ! length( $cmd ) ){
1411 Warn( "malformed `y' command argument", $fl );
1415 my $to = stripTrans( $d, \$cmd );
1416 if( ! defined( $to ) ){
1417 Warn( "malformed `y' command argument", $fl );
1421 if( length($fr) != length($to) ){
1422 Warn( "string lengths in `y' command differ", $fl );
1426 if( ! defined( $arg = makey( $fr, $to, $fl ) ) ){
1433 # $cmd must be now empty - exception is {
1434 if( $cmd !~ /^\s*$/ ){
1436 # dirty hack to process command on '{' line
1437 $Commands[$icom--] = $cmd;
1439 Warn( "extra characters after command ($cmd)", $fl );
1447 if( &{$tabref->[2]}( $addr1, $addr2, $negated,
1448 $tabref->[3], $arg, $fl ) ){
1453 while( @BlockStack ){
1454 my $bl = pop( @BlockStack );
1455 Warn( "start of unterminated `{'", $bl );
1459 for my $lab ( keys( %Label ) ){
1460 if( ! exists( $Label{$lab}{defined} ) ){
1461 for my $used ( @{$Label{$lab}{used}} ){
1462 Warn( "undefined label `$lab'", $used );
1468 exit( 1 ) if $error;
1477 print STDERR "Usage: sed [-an] command [file...]\n";
1478 print STDERR " [-an] [-e command] [-f script-file] [file...]\n";
1482 # Here we go again...
1485 while( @ARGV && $ARGV[0] =~ /^-(.)(.*)$/ ){
1490 if( length( $arg ) ){
1491 push( @Commands, split( "\n", $arg ) );
1493 push( @Commands, shift( @ARGV ) );
1495 Warn( "option -e requires an argument" );
1500 $Defined{$#Commands} = " #$expr";
1505 if( length( $arg ) ){
1508 $path = shift( @ARGV );
1510 Warn( "option -f requires an argument" );
1514 my $fst = $#Commands + 1;
1515 open( SCRIPT, "<$path" ) || die( "$0: $path: could not open ($!)\n" );
1517 while( defined( $cmd = <SCRIPT> ) ){
1519 push( @Commands, $cmd );
1522 if( $#Commands >= $fst ){
1523 $Defined{$fst} = "$path";
1527 if( $opt eq '-' && $arg eq '' ){
1530 if( $opt eq 'h' || $opt eq '?' ){
1536 } elsif( $opt eq 'a' ){
1539 Warn( "illegal option `$opt'" );
1543 if( length( $arg ) ){
1544 unshift( @ARGV, "-$arg" );
1548 # A singleton command may be the 1st argument when there are no options.
1550 if( @Commands == 0 ){
1552 Warn( "no script command given" );
1556 push( @Commands, split( "\n", shift( @ARGV ) ) );
1557 $Defined{0} = ' #1';
1560 print STDERR "Files: @ARGV\n" if $useDEBUG;
1562 # generate leading code
1564 $Func = <<'[TheEnd]';
1566 # openARGV: open 1st input file
1569 unshift( @ARGV, '-' ) unless @ARGV;
1570 my $file = shift( @ARGV );
1571 open( ARG, "<$file" )
1572 || die( "$0: can't open $file for reading ($!)\n" );
1576 # getsARGV: Read another input line into argument (default: $_).
1577 # Move on to next input file, and reset EOF flag $isEOF.
1579 my $argref = @_ ? shift() : \$_;
1580 while( $isEOF || ! defined( $$argref = <ARG> ) ){
1582 return 0 unless @ARGV;
1583 my $file = shift( @ARGV );
1584 open( ARG, "<$file" )
1585 || die( "$0: can't open $file for reading ($!)\n" );
1591 # eofARGV: end-of-file test
1594 return @ARGV == 0 && ( $isEOF = eof( ARG ) );
1597 # makeHandle: Generates another file handle for some file (given by its path)
1598 # to be written due to a w command or an s command's w flag.
1602 if( ! exists( $wFiles{$path} ) || $wFiles{$path} eq '' ){
1603 $handle = $wFiles{$path} = gensym();
1605 if( ! open( $handle, ">$path" ) ){
1606 die( "$0: can't open $path for writing: ($!)\n" );
1610 $handle = $wFiles{$path};
1615 # printQ: Print queued output which is either a string or a reference
1620 # flush open w files so that reading this file gets it all
1621 if( exists( $wFiles{$$q} ) && $wFiles{$$q} ne '' ){
1622 open( $wFiles{$$q}, ">>$$q" );
1624 # copy file to stdout: slow, but safe
1625 if( open( RF, "<$$q" ) ){
1626 while( defined( my $line = <RF> ) ){
1640 # generate the sed loop
1642 $Code .= <<'[TheEnd]';
1648 # Run: the sed loop reading input and applying the script
1651 my( $h, $icnt, $s, $n );
1652 # hack (not unbreakable :-/) to avoid // matching an empty string
1653 my $z = "\000"; $z =~ /$z/;
1658 $doPrint = $doAutoPrint;
1660 while( getsARGV() ){
1662 $CondReg = 0; # cleared on t
1666 # parse - avoid opening files when doing s2p
1668 ( $svOpenWrite, $doOpenWrite ) = ( $doOpenWrite, $svOpenWrite )
1671 ( $svOpenWrite, $doOpenWrite ) = ( $doOpenWrite, $svOpenWrite )
1674 # append trailing code
1676 $Code .= <<'[TheEnd]';
1677 EOS: if( $doPrint ){
1680 $doPrint = $doAutoPrint;
1690 # append optional functions, prepend prototypes
1692 my $Proto = "# prototypes\n";
1694 $Proto .= "sub _l();\n";
1695 $Func .= <<'[TheEnd]';
1696 # _l: l command processing
1701 # transform non printing chars into escape notation
1703 if( $h =~ /[^[:print:]]/ ){
1710 $h =~ s/([^[:print:]])/sprintf("\\%03o", ord($1))/ge;
1712 # split into lines of length $mcpl
1713 while( length( $h ) > $mcpl ){
1714 my $l = substr( $h, 0, $mcpl-1 );
1715 $h = substr( $h, $mcpl );
1716 # remove incomplete \-escape from end of line
1717 if( $l =~ s/(?<!\\)(\\[0-7]{0,2})$// ){
1729 $Proto .= "sub _r(\$);\n";
1730 $Func .= <<'[TheEnd]';
1731 # _r: r command processing: Save a reference to the pathname.
1742 $Proto .= "sub _t();\n";
1743 $Func .= <<'[TheEnd]';
1744 # _t: t command - condition register test/reset
1756 $Proto .= "sub _w(\$);\n";
1757 $Func .= <<'[TheEnd]';
1758 # _w: w command and s command's w flag - write to file
1762 my $handle = $wFiles{$path};
1763 if( ! $doOpenWrite && ! defined( fileno( $handle ) ) ){
1764 open( $handle, ">$path" )
1765 || die( "$0: $path: cannot open ($!)\n" );
1767 print $handle $_, "\n";
1773 $Code = $Proto . $Code;
1775 # magic "#n" - same as -n option
1777 $doAutoPrint = 0 if substr( $Commands[0], 0, 2 ) eq '#n';
1779 # eval code - check for errors
1781 print "Code:\n$Code$Func" if $useDEBUG;
1784 print "Code:\n$Code$Func";
1785 die( "$0: internal error - generated incorrect Perl code: $@\n" );
1790 # write full Perl program
1793 # bang line, declarations, prototypes
1796 eval 'exec $perlpath -S \$0 \${1+"\$@"}'
1798 \$0 =~ s/^.*?(\\w+)\[\\.\\w+\]*\$/\$1/;
1802 use vars qw{ \$isEOF \$Hold \%wFiles \@Q \$CondReg
1803 \$doAutoPrint \$doOpenWrite \$doPrint };
1804 \$doAutoPrint = $doAutoPrint;
1805 \$doOpenWrite = $doOpenWrite;
1808 my $wf = "'" . join( "', '", keys( %wFiles ) ) . "'";
1813 exit( 1 ) unless makeHandle( \$p );
1825 # execute: make handles (and optionally open) all w files; run!
1826 for my $p ( keys( %wFiles ) ){
1827 exit( 1 ) unless makeHandle( $p );
1835 The environment variable C<PSEDEXTBRE> may be set to extend BREs.
1836 See L<"Additional Atoms">.
1842 =item ambiguos translation for character `%s' in `y' command
1844 The indicated character appears twice, with different translations.
1846 =item `[' cannot be last in pattern
1848 A `[' in a BRE indicates the beginning of a I<bracket expression>.
1850 =item `\' cannot be last in pattern
1852 A `\' in a BRE is used to make the subsequent character literal.
1854 =item `\' cannot be last in substitution
1856 A `\' in a subsitution string is used to make the subsequent character literal.
1858 =item conflicting flags `%s'
1860 In an B<s> command, either the `g' flag and an n-th occurrence flag, or
1861 multiple n-th occurrence flags are specified. Note that only the digits
1862 `1' through `9' are permitted.
1864 =item duplicate label %s (first defined at %s)
1866 =item excess address(es)
1868 The command has more than the permitted number of addresses.
1870 =item extra characters after command (%s)
1872 =item illegal option `%s'
1874 =item improper delimiter in s command
1876 The BRE and substitution may not be delimited with `\' or newline.
1878 =item invalid address after `,'
1880 =item invalid backreference (%s)
1882 The specified backreference number exceeds the number of backreferences
1885 =item invalid repeat clause `\{%s\}'
1887 The repeat clause does not contain a valid integer value, or pair of
1890 =item malformed regex, 1st address
1892 =item malformed regex, 2nd address
1894 =item malformed regular expression
1896 =item malformed substitution expression
1898 =item malformed `y' command argument
1900 The first or second string of a B<y> command is syntactically incorrect.
1902 =item maximum less than minimum in `\{%s\}'
1904 =item no script command given
1906 There must be at least one B<-e> or one B<-f> option specifying a
1907 script or script file.
1909 =item `\' not valid as delimiter in `y' command
1911 =item option -e requires an argument
1913 =item option -f requires an argument
1915 =item `s' command requires argument
1917 =item start of unterminated `{'
1919 =item string lengths in `y' command differ
1921 The translation table strings in a B<y> commanf must have equal lengths.
1923 =item undefined label `%s'
1925 =item unexpected `}'
1927 A B<}> command without a preceding B<{> command was encountered.
1929 =item unexpected end of script
1931 The end of the script was reached although a text line after a
1932 B<a>, B<c> or B<i> command indicated another line.
1934 =item unknown command `%s'
1936 =item unterminated `['
1938 A BRE contains an unterminated bracket expression.
1940 =item unterminated `\('
1942 A BRE contains an unterminated backreference.
1944 =item `\{' without closing `\}'
1946 A BRE contains an unterminated bounds specification.
1948 =item `\)' without preceding `\('
1950 =item `y' command requires argument
1956 The basic material for the preceding section was generated by running
1960 s/^.*Warn( *"\([^"]*\)".*$/\1/
1965 s/$[_[:alnum:]]\{1,\}/%s/g
1970 on the program's own text, and piping the output into C<sort -u>.
1973 =head1 SED SCRIPT TRANSLATION
1975 If this program is invoked with the name F<s2p> it will act as a
1976 sed-to-Perl translator. After option processing (all other
1977 arguments are ignored), a Perl program is printed on standard
1978 output, which will process the input stream (as read from all
1979 arguments) in the way defined by the sed script and the option setting
1980 used for the translation.
1984 perl(1), re_format(7)
1988 The B<l> command will show escape characters (ESC) as `C<\e>', but
1989 a vertical tab (VT) in octal.
1991 Trailing spaces are truncated from labels in B<:>, B<t> and B<b> commands.
1993 The meaning of an empty regular expression (`C<//>'), as defined by B<sed>,
1994 is "the last pattern used, at run time". This deviates from the Perl
1995 interpretation, which will re-use the "last last successfully executed
1996 regular expression". Since keeping track of pattern usage would create
1997 terribly cluttered code, and differences would only appear in obscure
1998 context (where other B<sed> implementations appear to deviate, too),
1999 the Perl semantics was adopted. Note that common usage of this feature,
2000 such as in C</abc/s//xyz/>, will work as expected.
2002 Collating elements (of bracket expressions in BREs) are not implemented.
2006 This B<sed> implementation conforms to the IEEE Std1003.2-1992 ("POSIX.2")
2007 definition of B<sed>, and is compatible with the I<OpenBSD>
2008 implementation, except where otherwise noted (see L<"BUGS">).
2012 This Perl implementation of I<sed> was written by Wolfgang Laun,
2013 I<Wolfgang.Laun@alcatel.at>.
2015 =head1 COPYRIGHT and LICENSE
2017 This program is free and open software. You may use, modify,
2018 distribute, and sell this program (and any modified variants) in any
2019 way you wish, provided you do not restrict others from doing the same.
2025 close OUT or die "Can't close $file: $!";
2026 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
2028 print "Linking s2p to psed.\n";
2029 if (defined $Config{d_link}) {
2032 unshift @INC, '../lib';
2034 File::Copy::syscopy('s2p', 'psed');
2036 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';