4 use File::Basename qw(&basename &dirname);
8 sub link { # This is a cut-down version of installperl:link().
13 CORE::link($from, $to)
15 : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
16 ? die "AFS" # okay inside eval {}
17 : die "Couldn't link $from to $to: $!\n";
21 File::Copy::copy($from, $to)
23 : warn "Couldn't copy $from to $to: $!\n";
28 # List explicitly here the variables you want Configure to
29 # generate. Metaconfig only looks for shell variables, so you
30 # have to mention them as if they were shell variables, not
31 # %Config entries. Thus you write
33 # to ensure Configure will look for $Config{startperl}.
35 # This forces PL files to create target in same directory as PL file.
36 # This is so that make depend always knows where to find PL derivatives.
39 $file = basename($0, '.PL');
40 $file .= '.com' if $^O eq 'VMS';
42 open OUT,">$file" or die "Can't create $file: $!";
44 print "Extracting $file (with variable substitutions)\n";
46 # In this section, perl variables will be expanded during extraction.
47 # You can use $Config{...} to use Configure variables.
49 print OUT <<"!GROK!THIS!";
51 eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
52 if \$running_under_some_shell;
55 (\$startperl = <<'/../') =~ s/\\s*\\z//;
58 (\$perlpath = <<'/../') =~ s/\\s*\\z//;
63 # In the following, perl variables are not expanded during extraction.
65 print OUT <<'!NO!SUBS!';
67 $0 =~ s/^.*?(\w+)[\.\w]*$/$1/;
69 # (p)sed - a stream editor
70 # History: Aug 12 2000: Original version.
71 # Mar 25 2002: Rearrange generated Perl program.
72 # Jul 23 2007: Fix bug in regex stripping (M.Thorland)
80 psed - a stream editor
84 psed [-an] script [file ...]
85 psed [-an] [-e script] [-f script-file] [file ...]
87 s2p [-an] [-e script] [-f script-file]
91 A stream editor reads the input stream consisting of the specified files
92 (or standard input, if none are given), processes is line by line by
93 applying a script consisting of edit commands, and writes resulting lines
94 to standard output. The filename `C<->' may be used to read standard input.
96 The edit script is composed from arguments of B<-e> options and
97 script-files, in the given order. A single script argument may be specified
98 as the first parameter.
100 If this program is invoked with the name F<s2p>, it will act as a
101 sed-to-Perl translator. See L<"sed Script Translation">.
103 B<sed> returns an exit code of 0 on success or >0 if an error occurred.
111 A file specified as argument to the B<w> edit command is by default
112 opened before input processing starts. Using B<-a>, opening of such
113 files is delayed until the first line is actually written to the file.
115 =item B<-e> I<script>
117 The editing commands defined by I<script> are appended to the script.
118 Multiple commands must be separated by newlines.
120 =item B<-f> I<script-file>
122 Editing commands from the specified I<script-file> are read and appended
127 By default, a line is written to standard output after the editing script
128 has been applied to it. The B<-n> option suppresses automatic printing.
134 B<sed> command syntax is defined as
136 Z<> Z<> Z<> Z<>[I<address>[B<,>I<address>]][B<!>]I<function>[I<argument>]
138 with whitespace being permitted before or after addresses, and between
139 the function character and the argument. The I<address>es and the
140 address inverter (C<!>) are used to restrict the application of a
141 command to the selected line(s) of input.
143 Each command must be on a line of its own, except where noted in
146 The edit cycle performed on each input line consist of reading the line
147 (without its trailing newline character) into the I<pattern space>,
148 applying the applicable commands of the edit script, writing the final
149 contents of the pattern space and a newline to the standard output.
150 A I<hold space> is provided for saving the contents of the
151 pattern space for later use.
155 A sed address is either a line number or a pattern, which may be combined
156 arbitrarily to construct ranges. Lines are numbered across all input files.
158 Any address may be followed by an exclamation mark (`C<!>'), selecting
159 all lines not matching that address.
165 The line with the given number is selected.
169 A dollar sign (C<$>) is the line number of the last line of the input stream.
171 =item B</>I<regular expression>B</>
173 A pattern address is a basic regular expression (see
174 L<"Basic Regular Expressions">), between the delimiting character C</>.
175 Any other character except C<\> or newline may be used to delimit a
176 pattern address when the initial delimiter is prefixed with a
181 If no address is given, the command selects every line.
183 If one address is given, it selects the line (or lines) matching the
186 Two addresses select a range that begins whenever the first address
187 matches, and ends (including that line) when the second address matches.
188 If the first (second) address is a matching pattern, the second
189 address is not applied to the very same line to determine the end of
190 the range. Likewise, if the second address is a matching pattern, the
191 first address is not applied to the very same line to determine the
192 begin of another range. If both addresses are line numbers,
193 and the second line number is less than the first line number, then
194 only the first line is selected.
199 The maximum permitted number of addresses is indicated with each
200 function synopsis below.
202 The argument I<text> consists of one or more lines following the command.
203 Embedded newlines in I<text> must be preceded with a backslash. Other
204 backslashes in I<text> are deleted and the following character is taken
213 #--------------------------------------------------------------------------
214 $ComTab{'a'}=[ 1, 'txt', \&Emit, '{ push( @Q, <<'."'TheEnd' ) }\n" ]; #ok
216 =item [1addr]B<a\> I<text>
218 Write I<text> (which must start on the line following the command)
219 to standard output immediately before reading the next line
220 of input, either by executing the B<N> function or by beginning a new cycle.
224 #--------------------------------------------------------------------------
225 $ComTab{'b'}=[ 2, 'str', \&Branch, '{ goto XXX; }' ]; #ok
227 =item [2addr]B<b> [I<label>]
229 Branch to the B<:> function with the specified I<label>. If no label
230 is given, branch to the end of the script.
234 #--------------------------------------------------------------------------
235 $ComTab{'c'}=[ 2, 'txt', \&Change, <<'-X-' ]; #ok
236 { print <<'TheEnd'; } $doPrint = 0; goto EOS;
238 ### continue OK => next CYCLE;
240 =item [2addr]B<c\> I<text>
242 The line, or range of lines, selected by the address is deleted.
243 The I<text> (which must start on the line following the command)
244 is written to standard output. With an address range, this occurs at
245 the end of the range.
249 #--------------------------------------------------------------------------
250 $ComTab{'d'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
255 ### continue OK => next CYCLE;
259 Deletes the pattern space and starts the next cycle.
263 #--------------------------------------------------------------------------
264 $ComTab{'D'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
266 if(length($_)){ goto BOS } else { goto EOS }
269 ### continue OK => next CYCLE;
273 Deletes the pattern space through the first embedded newline or to the end.
274 If the pattern space becomes empty, a new cycle is started, otherwise
275 execution of the script is restarted.
279 #--------------------------------------------------------------------------
280 $ComTab{'g'}=[ 2, '', \&Emit, '{ $_ = $Hold };' ]; #ok
284 Replace the contents of the pattern space with the hold space.
288 #--------------------------------------------------------------------------
289 $ComTab{'G'}=[ 2, '', \&Emit, '{ $_ .= "\n"; $_ .= $Hold };' ]; #ok
293 Append a newline and the contents of the hold space to the pattern space.
297 #--------------------------------------------------------------------------
298 $ComTab{'h'}=[ 2, '', \&Emit, '{ $Hold = $_ }' ]; #ok
302 Replace the contents of the hold space with the pattern space.
306 #--------------------------------------------------------------------------
307 $ComTab{'H'}=[ 2, '', \&Emit, '{ $Hold .= "\n"; $Hold .= $_; }' ]; #ok
311 Append a newline and the contents of the pattern space to the hold space.
315 #--------------------------------------------------------------------------
316 $ComTab{'i'}=[ 1, 'txt', \&Emit, '{ print <<'."'TheEnd' }\n" ]; #ok
318 =item [1addr]B<i\> I<text>
320 Write the I<text> (which must start on the line following the command)
325 #--------------------------------------------------------------------------
326 $ComTab{'l'}=[ 2, '', \&Emit, '{ _l() }' ]; #okUTF8
330 Print the contents of the pattern space: non-printable characters are
331 shown in C-style escaped form; long lines are split and have a trailing
332 `C<\>' at the point of the split; the true end of a line is marked with
333 a `C<$>'. Escapes are: `\a', `\t', `\n', `\f', `\r', `\e' for
334 BEL, HT, LF, FF, CR, ESC, respectively, and `\' followed by a three-digit
335 octal number for all other non-printable characters.
339 #--------------------------------------------------------------------------
340 $ComTab{'n'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
341 { print $_, "\n" if $doPrint;
344 last CYCLE unless getsARGV();
351 If automatic printing is enabled, write the pattern space to the standard
352 output. Replace the pattern space with the next line of input. If
353 there is no more input, processing is terminated.
357 #--------------------------------------------------------------------------
358 $ComTab{'N'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
361 last CYCLE unless getsARGV( $h );
369 Append a newline and the next line of input to the pattern space. If
370 there is no more input, processing is terminated.
374 #--------------------------------------------------------------------------
375 $ComTab{'p'}=[ 2, '', \&Emit, '{ print $_, "\n"; }' ]; #ok
379 Print the pattern space to the standard output. (Use the B<-n> option
380 to suppress automatic printing at the end of a cycle if you want to
381 avoid double printing of lines.)
385 #--------------------------------------------------------------------------
386 $ComTab{'P'}=[ 2, '', \&Emit, <<'-X-' ]; #ok
387 { if( /^(.*)/ ){ print $1, "\n"; } }
392 Prints the pattern space through the first embedded newline or to the end.
396 #--------------------------------------------------------------------------
397 $ComTab{'q'}=[ 1, '', \&Emit, <<'-X-' ]; #ok
398 { print $_, "\n" if $doPrint;
405 Branch to the end of the script and quit without starting a new cycle.
409 #--------------------------------------------------------------------------
410 $ComTab{'r'}=[ 1, 'str', \&Emit, "{ _r( '-X-' ) }" ]; #ok
412 =item [1addr]B<r> I<file>
414 Copy the contents of the I<file> to standard output immediately before
415 the next attempt to read a line of input. Any error encountered while
416 reading I<file> is silently ignored.
420 #--------------------------------------------------------------------------
421 $ComTab{'s'}=[ 2, 'sub', \&Emit, '' ]; #ok
423 =item [2addr]B<s/>I<regular expression>B</>I<replacement>B</>I<flags>
425 Substitute the I<replacement> string for the first substring in
426 the pattern space that matches the I<regular expression>.
427 Any character other than backslash or newline can be used instead of a
428 slash to delimit the regular expression and the replacement.
429 To use the delimiter as a literal character within the regular expression
430 and the replacement, precede the character by a backslash (`C<\>').
432 Literal newlines may be embedded in the replacement string by
433 preceding a newline with a backslash.
435 Within the replacement, an ampersand (`C<&>') is replaced by the string
436 matching the regular expression. The strings `C<\1>' through `C<\9>' are
437 replaced by the corresponding subpattern (see L<"Basic Regular Expressions">).
438 To get a literal `C<&>' or `C<\>' in the replacement text, precede it
441 The following I<flags> modify the behaviour of the B<s> command:
447 The replacement is performed for all matching, non-overlapping substrings
448 of the pattern space.
452 Replace only the n-th matching substring of the pattern space.
456 If the substitution was made, print the new value of the pattern space.
460 If the substitution was made, write the new value of the pattern space
461 to the specified file.
467 #--------------------------------------------------------------------------
468 $ComTab{'t'}=[ 2, 'str', \&Branch, '{ goto XXX if _t() }' ]; #ok
470 =item [2addr]B<t> [I<label>]
472 Branch to the B<:> function with the specified I<label> if any B<s>
473 substitutions have been made since the most recent reading of an input line
474 or execution of a B<t> function. If no label is given, branch to the end of
480 #--------------------------------------------------------------------------
481 $ComTab{'w'}=[ 2, 'str', \&Write, "{ _w( '-X-' ) }" ]; #ok
483 =item [2addr]B<w> I<file>
485 The contents of the pattern space are written to the I<file>.
489 #--------------------------------------------------------------------------
490 $ComTab{'x'}=[ 2, '', \&Emit, '{ ($Hold, $_) = ($_, $Hold) }' ]; #ok
494 Swap the contents of the pattern space and the hold space.
498 #--------------------------------------------------------------------------
499 $ComTab{'y'}=[ 2, 'tra', \&Emit, '' ]; #ok
500 =item [2addr]B<y>B</>I<string1>B</>I<string2>B</>
502 In the pattern space, replace all characters occuring in I<string1> by the
503 character at the corresponding position in I<string2>. It is possible
504 to use any character (other than a backslash or newline) instead of a
505 slash to delimit the strings. Within I<string1> and I<string2>, a
506 backslash followed by any character other than a newline is that literal
507 character, and a backslash followed by an `n' is replaced by a newline
512 #--------------------------------------------------------------------------
513 $ComTab{'='}=[ 1, '', \&Emit, '{ print "$.\n" }' ]; #ok
517 Prints the current line number on the standard output.
521 #--------------------------------------------------------------------------
522 $ComTab{':'}=[ 0, 'str', \&Label, '' ]; #ok
524 =item [0addr]B<:> [I<label>]
526 The command specifies the position of the I<label>. It has no other effect.
530 #--------------------------------------------------------------------------
531 $ComTab{'{'}=[ 2, '', \&BeginBlock, '{' ]; #ok
532 $ComTab{'}'}=[ 0, '', \&EndBlock, ';}' ]; #ok
533 # ';' to avoid warning on empty {}-block
535 =item [2addr]B<{> [I<command>]
539 These two commands begin and end a command list. The first command may
540 be given on the same line as the opening B<{> command. The commands
541 within the list are jointly selected by the address(es) given on the
542 B<{> command (but may still have individual addresses).
546 #--------------------------------------------------------------------------
547 $ComTab{'#'}=[ 0, 'str', \&Comment, '' ]; #ok
549 =item [0addr]B<#> [I<comment>]
551 The entire line is ignored (treated as a comment). If, however, the first
552 two characters in the script are `C<#n>', automatic printing of output is
553 suppressed, as if the B<-n> option were given on the command line.
559 use vars qw{ $isEOF $Hold %wFiles @Q $CondReg $doPrint };
561 my $useDEBUG = exists( $ENV{PSEDDEBUG} );
562 my $useEXTBRE = $ENV{PSEDEXTBRE} || '';
563 $useEXTBRE =~ s/[^<>wWyB]//g; # gawk RE's handle these
565 my $doAutoPrint = 1; # automatic printing of pattern space (-n => 0)
566 my $doOpenWrite = 1; # open w command output files at start (-a => 0)
567 my $svOpenWrite = 0; # save $doOpenWrite
569 # lower case $0 below as a VMSism. The VMS build procedure creates the
570 # s2p file traditionally in upper case on the disk. When VMS is in a
571 # case preserved or case sensitive mode, $0 will be returned in the exact
572 # case which will be on the disk, and that is not predictable at this time.
574 my $doGenerate = lc($0) eq 's2p';
576 # Collected and compiled script
578 my( @Commands, %Defined, @BlockStack, %Label, $labNum, $Code, $Func );
589 my( $msg, $loc ) = @_;
591 $loc .= ': ' if length( $loc );
592 warn( "$0: $loc$msg\n" );
597 return 'L_'.++$labNum;
600 # safeHere: create safe here delimiter and modify opcode and argument
603 my( $codref, $argref ) = @_;
605 while( $$argref =~ /^$eod$/m ){
608 $$codref =~ s/TheEnd/$eod/e;
609 $$argref .= "$eod\n";
612 # Emit: create address logic and emit command
615 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
617 if( defined( $addr1 ) ){
618 if( defined( $addr2 ) ){
619 $addr1 .= $addr2 =~ /^\d+$/ ? "..$addr2" : "...$addr2";
621 $addr1 .= ' == $.' if $addr1 =~ /^\d+$/;
623 $cond = $negated ? "unless( $addr1 )\n" : "if( $addr1 )\n";
627 $Code .= "$cond$arg\n";
629 } elsif( $opcode =~ s/-X-/$arg/e ){
630 $Code .= "$cond$opcode\n";
632 } elsif( $opcode =~ /TheEnd/ ){
633 safeHere( \$opcode, \$arg );
634 $Code .= "$cond$opcode$arg";
637 $Code .= "$cond$opcode\n";
642 # Write (w command, w flag): store pathname
645 my( $addr1, $addr2, $negated, $opcode, $path, $fl ) = @_;
647 Emit( $addr1, $addr2, $negated, $opcode, $path, $fl );
651 # Label (: command): label definition
654 my( $addr1, $addr2, $negated, $opcode, $lab, $fl ) = @_;
657 if( length( $lab ) ){
659 if( ! exists( $Label{$lab} ) ){
660 $h = $Label{$lab}{name} = newLabel();
662 $h = $Label{$lab}{name};
663 if( exists( $Label{$lab}{defined} ) ){
664 my $dl = $Label{$lab}{defined};
665 Warn( "duplicate label $lab (first defined at $dl)", $fl );
669 $Label{$lab}{defined} = $fl;
675 # BeginBlock ({ command): push block start
677 sub BeginBlock($$$$$$){
678 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
679 push( @BlockStack, [ $fl, $addr1, $addr2, $negated ] );
680 Emit( $addr1, $addr2, $negated, $opcode, $arg, $fl );
683 # EndBlock (} command): check proper nesting
685 sub EndBlock($$$$$$){
686 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
688 my $jcom = pop( @BlockStack );
689 if( defined( $jcom ) ){
690 $rc = Emit( $addr1, $addr2, $negated, $opcode, $arg, $fl );
692 Warn( "unexpected `}'", $fl );
698 # Branch (t, b commands): check or create label, substitute default
701 my( $addr1, $addr2, $negated, $opcode, $lab, $fl ) = @_;
702 $lab =~ s/\s+//; # no spaces at end
704 if( length( $lab ) ){
705 if( ! exists( $Label{$lab} ) ){
706 $h = $Label{$lab}{name} = newLabel();
708 $h = $Label{$lab}{name};
710 push( @{$Label{$lab}{used}}, $fl );
714 $opcode =~ s/XXX/$h/e;
715 Emit( $addr1, $addr2, $negated, $opcode, '', $fl );
718 # Change (c command): is special due to range end watching
721 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
722 my $kwd = $negated ? 'unless' : 'if';
723 if( defined( $addr2 ) ){
724 $addr1 .= $addr2 =~ /^\d+$/ ? "..$addr2" : "...$addr2";
726 $addr1 = '$icnt = ('.$addr1.')';
727 $opcode = 'if( $icnt =~ /E0$/ )' . $opcode;
730 $addr1 .= ' == $.' if $addr1 =~ /^\d+$/;
732 safeHere( \$opcode, \$arg );
733 $Code .= "$kwd( $addr1 ){\n $opcode$arg}\n";
738 # Comment (# command): A no-op. Who would've thought that!
741 my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
742 ### $Code .= "# $arg\n";
746 # stripRegex from the current command. If we're in the first
747 # part of s///, trailing spaces have to be kept as the initial
748 # part of the replacement string.
750 sub stripRegex($$;$){
751 my( $del, $sref, $sub ) = @_;
753 print "stripRegex:$del:$$sref:\n" if $useDEBUG;
754 while( $$sref =~ s{^(.*?)(\\*)\Q$del\E(\s*)}{}s ){
756 $regex .= $1.$sl.$del;
757 if( length( $sl ) % 2 == 0 ){
758 if( $sub && (length( $3 ) > 0) ){
759 $$sref = $3 . $$sref;
768 # stripTrans: take a <del> terminated string from y command
769 # honoring and cleaning up of \-escaped <del>'s
772 my( $del, $sref ) = @_;
774 print "stripTrans:$del:$$sref:\n" if $useDEBUG;
775 while( $$sref =~ s{^(.*?)(\\*)\Q$del\E}{}s ){
778 if( length( $sl ) % 2 == 0 ){
789 # makey - construct Perl y/// from sed y///
792 my( $fr, $to, $fl ) = @_;
795 # Ensure that any '-' is up front.
796 # Diagnose duplicate contradicting mappings
798 for( my $i = 0; $i < length($fr); $i++ ){
799 my $fc = substr($fr,$i,1);
800 my $tc = substr($to,$i,1);
801 if( exists( $tr{$fc} ) && $tr{$fc} ne $tc ){
802 Warn( "ambiguous translation for character `$fc' in `y' command",
809 if( exists( $tr{'-'} ) ){
810 ( $fr, $to ) = ( '-', $tr{'-'} );
815 # might just as well sort it...
816 for my $fc ( sort keys( %tr ) ){
820 # make embedded delimiters and newlines safe
821 $fr =~ s/([{}])/\$1/g;
822 $to =~ s/([{}])/\$1/g;
825 return $error ? undef() : "{ y{$fr}{$to}; }";
829 # makes - construct Perl s/// from sed s///
832 my( $regex, $subst, $path, $global, $print, $nmatch, $fl ) = @_;
834 # make embedded newlines safe
835 $regex =~ s/\n/\\n/g;
836 $subst =~ s/\n/\\n/g;
841 if( length( $nmatch ) ){
844 while( --\$n && ( \$s = m ${regex}g ) ){}
845 \$s = ( substr( \$_, pos() ) =~ s ${regex}${subst}s ) if \$s;
850 { \$s = s ${regex}${subst}s${global};
855 $code .= ' print $_, "\n" if $s;'."\n";
857 if( defined( $path ) ){
859 $code .= " _w( '$path' ) if \$s;\n";
865 =head1 BASIC REGULAR EXPRESSIONS
867 A I<Basic Regular Expression> (BRE), as defined in POSIX 1003.2, consists
868 of I<atoms>, for matching parts of a string, and I<bounds>, specifying
869 repetitions of a preceding atom.
873 The possible atoms of a BRE are: B<.>, matching any single character;
874 B<^> and B<$>, matching the null string at the beginning or end
875 of a string, respectively; a I<bracket expressions>, enclosed
876 in B<[> and B<]> (see below); and any single character with no
877 other significance (matching that character). A B<\> before one
878 of: B<.>, B<^>, B<$>, B<[>, B<*>, B<\>, matching the character
879 after the backslash. A sequence of atoms enclosed in B<\(> and B<\)>
880 becomes an atom and establishes the target for a I<backreference>,
881 consisting of the substring that actually matches the enclosed atoms.
882 Finally, B<\> followed by one of the digits B<0> through B<9> is a
885 A B<^> that is not first, or a B<$> that is not last does not have
886 a special significance and need not be preceded by a backslash to
887 become literal. The same is true for a B<]>, that does not terminate
888 a bracket expression.
890 An unescaped backslash cannot be last in a BRE.
894 The BRE bounds are: B<*>, specifying 0 or more matches of the preceding
895 atom; B<\{>I<count>B<\}>, specifying that many repetitions;
896 B<\{>I<minimum>B<,\}>, giving a lower limit; and
897 B<\{>I<minimum>B<,>I<maximum>B<\}> finally defines a lower and upper
900 A bound appearing as the first item in a BRE is taken literally.
902 =head2 Bracket Expressions
904 A I<bracket expression> is a list of characters, character ranges
905 and character classes enclosed in B<[> and B<]> and matches any
906 single character from the represented set of characters.
908 A character range is written as two characters separated by B<-> and
909 represents all characters (according to the character collating sequence)
910 that are not less than the first and not greater than the second.
911 (Ranges are very collating-sequence-dependent, and portable programs
912 should avoid relying on them.)
914 A character class is one of the class names
921 enclosed in B<[:> and B<:]> and represents the set of characters
922 as defined in ctype(3).
924 If the first character after B<[> is B<^>, the sense of matching is
927 To include a literal `C<^>', place it anywhere else but first. To
928 include a literal 'C<]>' place it first or immediately after an
929 initial B<^>. To include a literal `C<->' make it the first (or
930 second after B<^>) or last character, or the second endpoint of
933 The special bracket expression constructs C<[[:E<lt>:]]> and C<[[:E<gt>:]]>
934 match the null string at the beginning and end of a word respectively.
935 (Note that neither is identical to Perl's `\b' atom.)
937 =head2 Additional Atoms
939 Since some sed implementations provide additional regular expression
940 atoms (not defined in POSIX 1003.2), B<psed> is capable of translating
941 the following backslash escapes:
945 =item B<\E<lt>> This is the same as C<[[:E<gt>:]]>.
947 =item B<\E<gt>> This is the same as C<[[:E<lt>:]]>.
949 =item B<\w> This is an abbreviation for C<[[:alnum:]_]>.
951 =item B<\W> This is an abbreviation for C<[^[:alnum:]_]>.
953 =item B<\y> Match the empty string at a word boundary.
955 =item B<\B> Match the empty string between any two either word or non-word characters.
959 To enable this feature, the environment variable PSEDEXTBRE must be set
960 to a string containing the requested characters, e.g.:
961 C<PSEDEXTBRE='E<lt>E<gt>wW'>.
966 # bre2p - convert BRE to Perl RE
969 my( $pref, $ic ) = @_;
970 $ic < length($$pref)-1 ? substr( $$pref, $ic+1, 1 ) : '';
974 my( $del, $pat, $fl ) = @_;
976 $led =~ tr/{([</})]>/;
977 $led = '' if $led eq $del;
979 $pat = substr( $pat, 1, length($pat) - 2 );
984 for( my $ic = 0; $ic < length( $pat ); $ic++ ){
985 my $c = substr( $pat, $ic, 1 );
987 ### backslash escapes
988 my $nc = peek($pat,$ic);
990 Warn( "`\\' cannot be last in pattern", $fl );
994 if( $nc eq $del ){ ## \<pattern del> => \<pattern del>
997 } elsif( $nc =~ /([[.*\\n])/ ){
998 ## check for \-escaped magics and \n:
999 ## \[ \. \* \\ \n stay as they are
1002 } elsif( $nc eq '(' ){ ## \( => (
1006 } elsif( $nc eq ')' ){ ## \) => )
1010 Warn( "unmatched `\\)'", $fl );
1015 } elsif( $nc eq '{' ){ ## repetition factor \{<i>[,[<j>]]\}
1016 my $endpos = index( $pat, '\\}', $ic );
1018 Warn( "unmatched `\\{'", $fl );
1021 my $rep = substr( $pat, $ic+1, $endpos-($ic+1) );
1024 if( $res =~ /^\^?$/ ){
1025 $res .= "\\{$rep\}";
1026 } elsif( $rep =~ /^(\d+)(,?)(\d*)?$/ ){
1030 if( length( $max ) ){
1032 Warn( "maximum less than minimum in `\\{$rep\\}'",
1040 if( $min == 0 && $max eq '1' ){
1042 } elsif( $min == 1 && "$com$max" eq ',' ){
1044 } elsif( $min == 0 && "$com$max" eq ',' ){
1047 $res .= "{$min$com$max}";
1050 Warn( "invalid repeat clause `\\{$rep\\}'", $fl );
1054 } elsif( $nc =~ /^[1-9]$/ ){
1055 ## \1 .. \9 => \1 .. \9, but check for a following digit
1056 if( $nc > $backref ){
1057 Warn( "invalid backreference ($nc)", $fl );
1061 if( peek($pat,$ic) =~ /[0-9]/ ){
1065 } elsif( $useEXTBRE && ( $nc =~ /[$useEXTBRE]/ ) ){
1066 ## extensions - at most <>wWyB - not in POSIX
1067 if( $nc eq '<' ){ ## \< => \b(?=\w), be precise
1068 $res .= '\\b(?<=\\W)';
1069 } elsif( $nc eq '>' ){ ## \> => \b(?=\W), be precise
1070 $res .= '\\b(?=\\W)';
1071 } elsif( $nc eq 'y' ){ ## \y => \b
1073 } else { ## \B, \w, \W remain the same
1076 } elsif( $nc eq $led ){
1077 ## \<closing bracketing-delimiter> - keep '\'
1080 } else { ## \ <char> => <char> ("as if `\' were not present")
1084 } elsif( $c eq '.' ){ ## . => .
1087 } elsif( $c eq '*' ){ ## * => * but \* if there's nothing preceding it
1088 if( $res =~ /^\^?$/ ){
1090 } elsif( substr( $res, -1, 1 ) ne '*' ){
1094 } elsif( $c eq '[' ){
1095 ## parse []: [^...] [^]...] [-...]
1097 if( peek($pat,$ic) eq '^' ){
1101 my $nc = peek($pat,$ic);
1102 if( $nc eq ']' || $nc eq '-' ){
1106 # check that [ is not trailing
1107 if( $ic >= length( $pat ) - 1 ){
1108 Warn( "unmatched `['", $fl );
1111 # look for [:...:] and x-y
1112 my $rstr = substr( $pat, $ic+1 );
1113 if( $rstr =~ /^((?:\[:\(\w+|[><]\):\]|[^]-](?:-[^]])?)*)/ ){
1115 $ic += length( $cnt );
1116 $cnt =~ s/([\\\$])/\\$1/g; # `\', `$' are magic in Perl []
1117 # try some simplifications
1119 if( $red =~ s/0-9// ){
1121 if( $red =~ s/A-Z// && $red =~ s/a-z// && $red =~ s/_// ){
1127 # POSIX 1003.2 has this (optional) for begin/end word
1128 $add = '\\b(?=\\W)' if $add eq '[[:<:]]';
1129 $add = '\\b(?<=\\W)' if $add eq '[[:>:]]';
1133 ## may have a trailing `-' before `]'
1134 if( $ic < length($pat) - 1 &&
1135 substr( $pat, $ic+1 ) =~ /^(-?])/ ){
1136 $ic += length( $1 );
1138 # another simplification
1139 $add =~ s/^\[(\^?)(\\[dw])]$/ $1 eq '^' ? uc($2) : $2 /e;
1142 Warn( "unmatched `['", $fl );
1146 } elsif( $c eq $led ){ ## unescaped <closing bracketing-delimiter>
1149 } elsif( $c eq ']' ){ ## unmatched ] is not magic
1152 } elsif( $c =~ /[|+?{}()]/ ){ ## not magic in BRE, but in Perl: \-quote
1155 } elsif( $c eq '^' ){ ## not magic unless 1st, but in Perl: \-quote
1156 $res .= length( $res ) ? '\\^' : '^';
1158 } elsif( $c eq '$' ){ ## not magic unless last, but in Perl: \-quote
1159 $res .= $ic == length( $pat ) - 1 ? '$' : '\\$';
1167 Warn( "unmatched `\\('", $fl );
1171 # final cleanup: eliminate raw HTs
1173 return $del . $res . ( $led ? $led : $del );
1178 # sub2p - convert sed substitution to Perl substitution
1181 my( $del, $subst, $fl ) = @_;
1183 $led =~ tr/{([</})]>/;
1184 $led = '' if $led eq $del;
1186 $subst = substr( $subst, 1, length($subst) - 2 );
1189 for( my $ic = 0; $ic < length( $subst ); $ic++ ){
1190 my $c = substr( $subst, $ic, 1 );
1192 ### backslash escapes
1193 my $nc = peek($subst,$ic);
1195 Warn( "`\\' cannot be last in substitution", $fl );
1199 if( $nc =~ /[\\$del$led]/ ){ ## \ and delimiter
1201 } elsif( $nc =~ /[1-9]/ ){ ## \1 - \9 => ${1} - ${9}
1202 $res .= '${' . $nc . '}';
1203 } else { ## everything else (includes &): omit \
1206 } elsif( $c eq '&' ){ ## & => $&
1208 } elsif( $c =~ /[\$\@$led]/ ){ ## magic in Perl's substitution string
1215 # final cleanup: eliminate raw HTs
1217 return ( $led ? $del : $led ) . $res . ( $led ? $led : $del );
1223 my( $pdef, $pfil, $plin );
1224 for( my $icom = 0; $icom < @Commands; $icom++ ){
1225 my $cmd = $Commands[$icom];
1226 print "Parse:$cmd:\n" if $useDEBUG;
1228 next unless length( $cmd );
1230 if( exists( $Defined{$icom} ) ){
1231 $pdef = $Defined{$icom};
1232 if( $pdef =~ /^ #(\d+)/ ){
1233 $pfil = 'expression #';
1242 my $fl = "$pfil$plin";
1244 # insert command as comment in gnerated code
1246 $Code .= "# $cmd\n" if $doGenerate;
1250 my( $negated, $naddr, $addr1, $addr2 );
1252 if( $cmd =~ s/^(\d+)\s*// ){
1253 $addr1 = "$1"; $naddr++;
1254 } elsif( $cmd =~ s/^\$\s*// ){
1255 $addr1 = 'eofARGV()'; $naddr++;
1256 } elsif( $cmd =~ s{^(/)}{} || $cmd =~ s{^\\(.)}{} ){
1258 my $regex = stripRegex( $del, \$cmd );
1259 if( defined( $regex ) ){
1260 $addr1 = 'm '.bre2p( $del, $regex, $fl ).'s';
1263 Warn( "malformed regex, 1st address", $fl );
1268 if( defined( $addr1 ) && $cmd =~ s/,\s*// ){
1269 if( $cmd =~ s/^(\d+)\s*// ){
1270 $addr2 = "$1"; $naddr++;
1271 } elsif( $cmd =~ s/^\$\s*// ){
1272 $addr2 = 'eofARGV()'; $naddr++;
1273 } elsif( $cmd =~ s{^(/)}{} || $cmd =~ s{^\\(.)}{} ){
1275 my $regex = stripRegex( $del, \$cmd );
1276 if( defined( $regex ) ){
1277 $addr2 = 'm '. bre2p( $del, $regex, $fl ).'s';
1280 Warn( "malformed regex, 2nd address", $fl );
1285 Warn( "invalid address after `,'", $fl );
1291 # address modifier `!'
1293 $negated = $cmd =~ s/^!\s*//;
1294 if( defined( $addr1 ) ){
1295 print "Parse: addr1=$addr1" if $useDEBUG;
1296 if( defined( $addr2 ) ){
1297 print ", addr2=$addr2 " if $useDEBUG;
1298 # both numeric and addr1 > addr2 => eliminate addr2
1299 undef( $addr2 ) if $addr1 =~ /^\d+$/ &&
1300 $addr2 =~ /^\d+$/ && $addr1 > $addr2;
1303 print 'negated' if $useDEBUG && $negated;
1304 print " command:$cmd\n" if $useDEBUG;
1308 if( $cmd !~ s/^([:#={}abcdDgGhHilnNpPqrstwxy])\s*// ){
1309 my $h = substr( $cmd, 0, 1 );
1310 Warn( "unknown command `$h'", $fl );
1316 my $tabref = $ComTab{$key};
1318 if( $naddr > $tabref->[0] ){
1319 Warn( "excess address(es)", $fl );
1325 if( $tabref->[1] eq 'str' ){
1326 # take remainder - don't care if it is empty
1330 } elsif( $tabref->[1] eq 'txt' ){
1332 my $goon = $cmd =~ /(.*)\\$/;
1334 Warn( "extra characters after command ($cmd)", $fl );
1339 if( $icom > $#Commands ){
1340 Warn( "unexpected end of script", $fl );
1344 $cmd = $Commands[$icom];
1345 $Code .= "# $cmd\n" if $doGenerate;
1346 $goon = $cmd =~ s/\\$//;
1347 $cmd =~ s/\\(.)/$1/g;
1348 $arg .= "\n" if length( $arg );
1351 $arg .= "\n" if length( $arg );
1354 } elsif( $tabref->[1] eq 'sub' ){
1356 if( ! length( $cmd ) ){
1357 Warn( "`s' command requires argument", $fl );
1361 if( $cmd =~ s{^([^\\\n])}{} ){
1363 my $regex = stripRegex( $del, \$cmd, "s" );
1364 if( ! defined( $regex ) ){
1365 Warn( "malformed regular expression", $fl );
1369 $regex = bre2p( $del, $regex, $fl );
1371 # a trailing \ indicates embedded NL (in replacement string)
1372 while( $cmd =~ s/(?<!\\)\\$/\n/ ){
1374 if( $icom > $#Commands ){
1375 Warn( "unexpected end of script", $fl );
1379 $cmd .= $Commands[$icom];
1380 $Code .= "# $Commands[$icom]\n" if $doGenerate;
1383 my $subst = stripRegex( $del, \$cmd );
1384 if( ! defined( $regex ) ){
1385 Warn( "malformed substitution expression", $fl );
1389 $subst = sub2p( $del, $subst, $fl );
1391 # parse s/// modifier: g|p|0-9|w <file>
1392 my( $global, $nmatch, $print, $write ) =
1393 ( '', '', 0, undef );
1394 while( $cmd =~ s/^([gp0-9])// ){
1395 $1 eq 'g' ? ( $global = 'g' ) :
1396 $1 eq 'p' ? ( $print = $1 ) : ( $nmatch .= $1 );
1398 $write = $1 if $cmd =~ s/w\s*(.*)$//;
1399 ### $nmatch =~ s/^(\d)\1*$/$1/; ### may be dangerous?
1400 if( $global && length( $nmatch ) || length( $nmatch ) > 1 ){
1401 Warn( "conflicting flags `$global$nmatch'", $fl );
1406 $arg = makes( $regex, $subst,
1407 $write, $global, $print, $nmatch, $fl );
1408 if( ! defined( $arg ) ){
1414 Warn( "improper delimiter in s command", $fl );
1419 } elsif( $tabref->[1] eq 'tra' ){
1421 # a trailing \ indicates embedded newline
1422 while( $cmd =~ s/(?<!\\)\\$/\n/ ){
1424 if( $icom > $#Commands ){
1425 Warn( "unexpected end of script", $fl );
1429 $cmd .= $Commands[$icom];
1430 $Code .= "# $Commands[$icom]\n" if $doGenerate;
1432 if( ! length( $cmd ) ){
1433 Warn( "`y' command requires argument", $fl );
1437 my $d = substr( $cmd, 0, 1 ); $cmd = substr( $cmd, 1 );
1439 Warn( "`\\' not valid as delimiter in `y' command", $fl );
1443 my $fr = stripTrans( $d, \$cmd );
1444 if( ! defined( $fr ) || ! length( $cmd ) ){
1445 Warn( "malformed `y' command argument", $fl );
1449 my $to = stripTrans( $d, \$cmd );
1450 if( ! defined( $to ) ){
1451 Warn( "malformed `y' command argument", $fl );
1455 if( length($fr) != length($to) ){
1456 Warn( "string lengths in `y' command differ", $fl );
1460 if( ! defined( $arg = makey( $fr, $to, $fl ) ) ){
1467 # $cmd must be now empty - exception is {
1468 if( $cmd !~ /^\s*$/ ){
1470 # dirty hack to process command on '{' line
1471 $Commands[$icom--] = $cmd;
1473 Warn( "extra characters after command ($cmd)", $fl );
1481 if( &{$tabref->[2]}( $addr1, $addr2, $negated,
1482 $tabref->[3], $arg, $fl ) ){
1487 while( @BlockStack ){
1488 my $bl = pop( @BlockStack );
1489 Warn( "start of unterminated `{'", $bl );
1493 for my $lab ( keys( %Label ) ){
1494 if( ! exists( $Label{$lab}{defined} ) ){
1495 for my $used ( @{$Label{$lab}{used}} ){
1496 Warn( "undefined label `$lab'", $used );
1502 exit( 1 ) if $error;
1511 print STDERR "Usage: sed [-an] command [file...]\n";
1512 print STDERR " [-an] [-e command] [-f script-file] [file...]\n";
1516 # Here we go again...
1519 while( @ARGV && $ARGV[0] =~ /^-(.)(.*)$/ ){
1524 if( length( $arg ) ){
1525 push( @Commands, split( "\n", $arg ) );
1527 push( @Commands, shift( @ARGV ) );
1529 Warn( "option -e requires an argument" );
1534 $Defined{$#Commands} = " #$expr";
1539 if( length( $arg ) ){
1542 $path = shift( @ARGV );
1544 Warn( "option -f requires an argument" );
1548 my $fst = $#Commands + 1;
1549 open( SCRIPT, "<$path" ) || die( "$0: $path: could not open ($!)\n" );
1551 while( defined( $cmd = <SCRIPT> ) ){
1553 push( @Commands, $cmd );
1556 if( $#Commands >= $fst ){
1557 $Defined{$fst} = "$path";
1561 if( $opt eq '-' && $arg eq '' ){
1564 if( $opt eq 'h' || $opt eq '?' ){
1570 } elsif( $opt eq 'a' ){
1573 Warn( "illegal option `$opt'" );
1577 if( length( $arg ) ){
1578 unshift( @ARGV, "-$arg" );
1582 # A singleton command may be the 1st argument when there are no options.
1584 if( @Commands == 0 ){
1586 Warn( "no script command given" );
1590 push( @Commands, split( "\n", shift( @ARGV ) ) );
1591 $Defined{0} = ' #1';
1594 print STDERR "Files: @ARGV\n" if $useDEBUG;
1596 # generate leading code
1598 $Func = <<'[TheEnd]';
1600 # openARGV: open 1st input file
1603 unshift( @ARGV, '-' ) unless @ARGV;
1604 my $file = shift( @ARGV );
1605 open( ARG, "<$file" )
1606 || die( "$0: can't open $file for reading ($!)\n" );
1610 # getsARGV: Read another input line into argument (default: $_).
1611 # Move on to next input file, and reset EOF flag $isEOF.
1613 my $argref = @_ ? shift() : \$_;
1614 while( $isEOF || ! defined( $$argref = <ARG> ) ){
1616 return 0 unless @ARGV;
1617 my $file = shift( @ARGV );
1618 open( ARG, "<$file" )
1619 || die( "$0: can't open $file for reading ($!)\n" );
1625 # eofARGV: end-of-file test
1628 return @ARGV == 0 && ( $isEOF = eof( ARG ) );
1631 # makeHandle: Generates another file handle for some file (given by its path)
1632 # to be written due to a w command or an s command's w flag.
1636 if( ! exists( $wFiles{$path} ) || $wFiles{$path} eq '' ){
1637 $handle = $wFiles{$path} = gensym();
1639 if( ! open( $handle, ">$path" ) ){
1640 die( "$0: can't open $path for writing: ($!)\n" );
1644 $handle = $wFiles{$path};
1649 # printQ: Print queued output which is either a string or a reference
1654 # flush open w files so that reading this file gets it all
1655 if( exists( $wFiles{$$q} ) && $wFiles{$$q} ne '' ){
1656 open( $wFiles{$$q}, ">>$$q" );
1658 # copy file to stdout: slow, but safe
1659 if( open( RF, "<$$q" ) ){
1660 while( defined( my $line = <RF> ) ){
1674 # generate the sed loop
1676 $Code .= <<'[TheEnd]';
1682 # Run: the sed loop reading input and applying the script
1685 my( $h, $icnt, $s, $n );
1686 # hack (not unbreakable :-/) to avoid // matching an empty string
1687 my $z = "\000"; $z =~ /$z/;
1692 $doPrint = $doAutoPrint;
1694 while( getsARGV() ){
1696 $CondReg = 0; # cleared on t
1700 # parse - avoid opening files when doing s2p
1702 ( $svOpenWrite, $doOpenWrite ) = ( $doOpenWrite, $svOpenWrite )
1705 ( $svOpenWrite, $doOpenWrite ) = ( $doOpenWrite, $svOpenWrite )
1708 # append trailing code
1710 $Code .= <<'[TheEnd]';
1711 EOS: if( $doPrint ){
1714 $doPrint = $doAutoPrint;
1724 # append optional functions, prepend prototypes
1726 my $Proto = "# prototypes\n";
1728 $Proto .= "sub _l();\n";
1729 $Func .= <<'[TheEnd]';
1730 # _l: l command processing
1735 # transform non printing chars into escape notation
1737 if( $h =~ /[^[:print:]]/ ){
1744 $h =~ s/([^[:print:]])/sprintf("\\%03o", ord($1))/ge;
1746 # split into lines of length $mcpl
1747 while( length( $h ) > $mcpl ){
1748 my $l = substr( $h, 0, $mcpl-1 );
1749 $h = substr( $h, $mcpl );
1750 # remove incomplete \-escape from end of line
1751 if( $l =~ s/(?<!\\)(\\[0-7]{0,2})$// ){
1763 $Proto .= "sub _r(\$);\n";
1764 $Func .= <<'[TheEnd]';
1765 # _r: r command processing: Save a reference to the pathname.
1776 $Proto .= "sub _t();\n";
1777 $Func .= <<'[TheEnd]';
1778 # _t: t command - condition register test/reset
1790 $Proto .= "sub _w(\$);\n";
1791 $Func .= <<'[TheEnd]';
1792 # _w: w command and s command's w flag - write to file
1796 my $handle = $wFiles{$path};
1797 if( ! $doOpenWrite && ! defined( fileno( $handle ) ) ){
1798 open( $handle, ">$path" )
1799 || die( "$0: $path: cannot open ($!)\n" );
1801 print $handle $_, "\n";
1807 $Code = $Proto . $Code;
1809 # magic "#n" - same as -n option
1811 $doAutoPrint = 0 if substr( $Commands[0], 0, 2 ) eq '#n';
1813 # eval code - check for errors
1815 print "Code:\n$Code$Func" if $useDEBUG;
1818 print "Code:\n$Code$Func";
1819 die( "$0: internal error - generated incorrect Perl code: $@\n" );
1824 # write full Perl program
1827 # bang line, declarations, prototypes
1830 eval 'exec $perlpath -S \$0 \${1+"\$@"}'
1832 \$0 =~ s/^.*?(\\w+)\[\\.\\w+\]*\$/\$1/;
1836 use vars qw{ \$isEOF \$Hold \%wFiles \@Q \$CondReg
1837 \$doAutoPrint \$doOpenWrite \$doPrint };
1838 \$doAutoPrint = $doAutoPrint;
1839 \$doOpenWrite = $doOpenWrite;
1842 my $wf = "'" . join( "', '", keys( %wFiles ) ) . "'";
1847 exit( 1 ) unless makeHandle( \$p );
1859 # execute: make handles (and optionally open) all w files; run!
1860 for my $p ( keys( %wFiles ) ){
1861 exit( 1 ) unless makeHandle( $p );
1869 The environment variable C<PSEDEXTBRE> may be set to extend BREs.
1870 See L<"Additional Atoms">.
1876 =item ambiguous translation for character `%s' in `y' command
1878 The indicated character appears twice, with different translations.
1880 =item `[' cannot be last in pattern
1882 A `[' in a BRE indicates the beginning of a I<bracket expression>.
1884 =item `\' cannot be last in pattern
1886 A `\' in a BRE is used to make the subsequent character literal.
1888 =item `\' cannot be last in substitution
1890 A `\' in a subsitution string is used to make the subsequent character literal.
1892 =item conflicting flags `%s'
1894 In an B<s> command, either the `g' flag and an n-th occurrence flag, or
1895 multiple n-th occurrence flags are specified. Note that only the digits
1896 `1' through `9' are permitted.
1898 =item duplicate label %s (first defined at %s)
1900 =item excess address(es)
1902 The command has more than the permitted number of addresses.
1904 =item extra characters after command (%s)
1906 =item illegal option `%s'
1908 =item improper delimiter in s command
1910 The BRE and substitution may not be delimited with `\' or newline.
1912 =item invalid address after `,'
1914 =item invalid backreference (%s)
1916 The specified backreference number exceeds the number of backreferences
1919 =item invalid repeat clause `\{%s\}'
1921 The repeat clause does not contain a valid integer value, or pair of
1924 =item malformed regex, 1st address
1926 =item malformed regex, 2nd address
1928 =item malformed regular expression
1930 =item malformed substitution expression
1932 =item malformed `y' command argument
1934 The first or second string of a B<y> command is syntactically incorrect.
1936 =item maximum less than minimum in `\{%s\}'
1938 =item no script command given
1940 There must be at least one B<-e> or one B<-f> option specifying a
1941 script or script file.
1943 =item `\' not valid as delimiter in `y' command
1945 =item option -e requires an argument
1947 =item option -f requires an argument
1949 =item `s' command requires argument
1951 =item start of unterminated `{'
1953 =item string lengths in `y' command differ
1955 The translation table strings in a B<y> command must have equal lengths.
1957 =item undefined label `%s'
1959 =item unexpected `}'
1961 A B<}> command without a preceding B<{> command was encountered.
1963 =item unexpected end of script
1965 The end of the script was reached although a text line after a
1966 B<a>, B<c> or B<i> command indicated another line.
1968 =item unknown command `%s'
1970 =item unterminated `['
1972 A BRE contains an unterminated bracket expression.
1974 =item unterminated `\('
1976 A BRE contains an unterminated backreference.
1978 =item `\{' without closing `\}'
1980 A BRE contains an unterminated bounds specification.
1982 =item `\)' without preceding `\('
1984 =item `y' command requires argument
1990 The basic material for the preceding section was generated by running
1994 s/^.*Warn( *"\([^"]*\)".*$/\1/
1999 s/$[_[:alnum:]]\{1,\}/%s/g
2004 on the program's own text, and piping the output into C<sort -u>.
2007 =head1 SED SCRIPT TRANSLATION
2009 If this program is invoked with the name F<s2p> it will act as a
2010 sed-to-Perl translator. After option processing (all other
2011 arguments are ignored), a Perl program is printed on standard
2012 output, which will process the input stream (as read from all
2013 arguments) in the way defined by the sed script and the option setting
2014 used for the translation.
2018 perl(1), re_format(7)
2022 The B<l> command will show escape characters (ESC) as `C<\e>', but
2023 a vertical tab (VT) in octal.
2025 Trailing spaces are truncated from labels in B<:>, B<t> and B<b> commands.
2027 The meaning of an empty regular expression (`C<//>'), as defined by B<sed>,
2028 is "the last pattern used, at run time". This deviates from the Perl
2029 interpretation, which will re-use the "last last successfully executed
2030 regular expression". Since keeping track of pattern usage would create
2031 terribly cluttered code, and differences would only appear in obscure
2032 context (where other B<sed> implementations appear to deviate, too),
2033 the Perl semantics was adopted. Note that common usage of this feature,
2034 such as in C</abc/s//xyz/>, will work as expected.
2036 Collating elements (of bracket expressions in BREs) are not implemented.
2040 This B<sed> implementation conforms to the IEEE Std1003.2-1992 ("POSIX.2")
2041 definition of B<sed>, and is compatible with the I<OpenBSD>
2042 implementation, except where otherwise noted (see L<"BUGS">).
2046 This Perl implementation of I<sed> was written by Wolfgang Laun,
2047 I<Wolfgang.Laun@alcatel.at>.
2049 =head1 COPYRIGHT and LICENSE
2051 This program is free and open software. You may use, modify,
2052 distribute, and sell this program (and any modified variants) in any
2053 way you wish, provided you do not restrict others from doing the same.
2059 close OUT or die "Can't close $file: $!";
2060 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
2062 print "Linking $file to psed.\n";
2063 if (defined $Config{d_link}) {
2066 unshift @INC, '../lib';
2068 File::Copy::syscopy('s2p', 'psed');
2070 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';