perlfaq6.1

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

\&
\&        my $stream = File::Stream\->new(
\&                $filehandle,
\&                separator => qr/\es*,\es*/,
\&                );
\&
\&        print "$_\en" while <$stream>;
.Ve
.PP
If you don't have File::Stream, you have to do a little more work.
.PP
You can use the four argument form of sysread to continually add to
a buffer.  After you add to the buffer, you check if you have a
complete line (using your regular expression).
.PP
.Vb 7
\&        local $_ = "";
\&        while( sysread FH, $_, 8192, length ) {
\&                while( s/^((?s).*?)your_pattern/ ) {
\&                        my $record = $1;
\&                        # do stuff here.
\&                }
\&        }
\&
\& You can do the same thing with foreach and a match using the
\& c flag and the \eG anchor, if you do not mind your entire file
\& being in memory at the end.
\&
\&        local $_ = "";
\&        while( sysread FH, $_, 8192, length ) {
\&                foreach my $record ( m/\eG((?s).*?)your_pattern/gc ) {
\&                        # do stuff here.
\&                }
\&        substr( $_, 0, pos ) = "" if pos;
\&        }
.Ve
.Sh "How do I substitute case insensitively on the \s-1LHS\s0 while preserving case on the \s-1RHS\s0?"
.IX Xref "replace, case preserving substitute, case preserving substitution, case preserving s, case preserving"
.IX Subsection "How do I substitute case insensitively on the LHS while preserving case on the RHS?"
Here's a lovely Perlish solution by Larry Rosler.  It exploits
properties of bitwise xor on \s-1ASCII\s0 strings.
.PP
.Vb 1
\&        $_= "this is a TEsT case";
\&
\&        $old = \*(Aqtest\*(Aq;
\&        $new = \*(Aqsuccess\*(Aq;
\&
\&        s{(\eQ$old\eE)}
\&        { uc $new | (uc $1 ^ $1) .
\&                (uc(substr $1, \-1) ^ substr $1, \-1) x
\&                (length($new) \- length $1)
\&        }egi;
\&
\&        print;
.Ve
.PP
And here it is as a subroutine, modeled after the above:
.PP
.Vb 3
\&        sub preserve_case($$) {
\&                my ($old, $new) = @_;
\&                my $mask = uc $old ^ $old;
\&
\&                uc $new | $mask .
\&                        substr($mask, \-1) x (length($new) \- length($old))
\&    }
\&
\&        $a = "this is a TEsT case";
\&        $a =~ s/(test)/preserve_case($1, "success")/egi;
\&        print "$a\en";
.Ve
.PP
This prints:
.PP
.Vb 1
\&        this is a SUcCESS case
.Ve
.PP
As an alternative, to keep the case of the replacement word if it is
longer than the original, you can use this code, by Jeff Pinyan:
.PP
.Vb 3
\&        sub preserve_case {
\&                my ($from, $to) = @_;
\&                my ($lf, $lt) = map length, @_;
\&
\&                if ($lt < $lf) { $from = substr $from, 0, $lt }
\&                else { $from .= substr $to, $lf }
\&
\&                return uc $to | ($from ^ uc $from);
\&                }
.Ve
.PP
This changes the sentence to \*(L"this is a SUcCess case.\*(R"
.PP
Just to show that C programmers can write C in any programming language,
if you prefer a more C\-like solution, the following script makes the
substitution have the same case, letter by letter, as the original.
(It also happens to run about 240% slower than the Perlish solution runs.)
If the substitution has more characters than the string being substituted,
the case of the last character is used for the rest of the substitution.
.PP
.Vb 8
\&        # Original by Nathan Torkington, massaged by Jeffrey Friedl
\&        #
\&        sub preserve_case($$)
\&        {
\&                my ($old, $new) = @_;
\&                my ($state) = 0; # 0 = no change; 1 = lc; 2 = uc
\&                my ($i, $oldlen, $newlen, $c) = (0, length($old), length($new));
\&                my ($len) = $oldlen < $newlen ? $oldlen : $newlen;
\&
\&                for ($i = 0; $i < $len; $i++) {
\&                        if ($c = substr($old, $i, 1), $c =~ /[\eW\ed_]/) {
\&                                $state = 0;
\&                        } elsif (lc $c eq $c) {
\&                                substr($new, $i, 1) = lc(substr($new, $i, 1));
\&                                $state = 1;
\&                        } else {
\&                                substr($new, $i, 1) = uc(substr($new, $i, 1));
\&                                $state = 2;
\&                        }
\&                }
\&                # finish up with any remaining new (for when new is longer than old)
\&                if ($newlen > $oldlen) {
\&                        if ($state == 1) {
\&                                substr($new, $oldlen) = lc(substr($new, $oldlen));
\&                        } elsif ($state == 2) {
\&                                substr($new, $oldlen) = uc(substr($new, $oldlen));
\&                        }
\&                }
\&                return $new;
\&        }
.Ve
.ie n .Sh "How can I make ""\ew"" match national character sets?"
.el .Sh "How can I make \f(CW\ew\fP match national character sets?"
.IX Xref "\ew"
.IX Subsection "How can I make w match national character sets?"
Put \f(CW\*(C`use locale;\*(C'\fR in your script.  The \ew character class is taken
from the current locale.
.PP
See perllocale for details.
.ie n .Sh "How can I match a locale-smart version of ""/[a\-zA\-Z]/""?"
.el .Sh "How can I match a locale-smart version of \f(CW/[a\-zA\-Z]/\fP?"
.IX Xref "alpha"
.IX Subsection "How can I match a locale-smart version of /[a-zA-Z]/?"
You can use the \s-1POSIX\s0 character class syntax \f(CW\*(C`/[[:alpha:]]/\*(C'\fR
documented in perlre.
.PP
No matter which locale you are in, the alphabetic characters are
the characters in \ew without the digits and the underscore.
As a regex, that looks like \f(CW\*(C`/[^\eW\ed_]/\*(C'\fR.  Its complement,
the non-alphabetics, is then everything in \eW along with
the digits and the underscore, or \f(CW\*(C`/[\eW\ed_]/\*(C'\fR.
.Sh "How can I quote a variable to use in a regex?"
.IX Xref "regex, escaping regexp, escaping regular expression, escaping"
.IX Subsection "How can I quote a variable to use in a regex?"
The Perl parser will expand \f(CW$variable\fR and \f(CW@variable\fR references in
regular expressions unless the delimiter is a single quote.  Remember,
too, that the right-hand side of a \f(CW\*(C`s///\*(C'\fR substitution is considered
a double-quoted string (see perlop for more details).  Remember
also that any regex special characters will be acted on unless you
precede the substitution with \eQ.  Here's an example:
.PP
.Vb 2
\&        $string = "Placido P. Octopus";
\&        $regex  = "P.";
\&
\&        $string =~ s/$regex/Polyp/;
\&        # $string is now "Polypacido P. Octopus"
.Ve
.PP
Because \f(CW\*(C`.\*(C'\fR is special in regular expressions, and can match any
single character, the regex \f(CW\*(C`P.\*(C'\fR here has matched the <Pl> in the
original string.
.PP
To escape the special meaning of \f(CW\*(C`.\*(C'\fR, we use \f(CW\*(C`\eQ\*(C'\fR:
.PP
.Vb 2
\&        $string = "Placido P. Octopus";
\&        $regex  = "P.";
\&
\&        $string =~ s/\eQ$regex/Polyp/;
\&        # $string is now "Placido Polyp Octopus"
.Ve
.PP
The use of \f(CW\*(C`\eQ\*(C'\fR causes the <.> in the regex to be treated as a
regular character, so that \f(CW\*(C`P.\*(C'\fR matches a \f(CW\*(C`P\*(C'\fR followed by a dot.
.ie n .Sh "What is ""/o"" really for?"
.el .Sh "What is \f(CW/o\fP really for?"
.IX Xref " o, regular expressions compile, regular expressions"
.IX Subsection "What is /o really for?"
(contributed by brian d foy)
.PP
The \f(CW\*(C`/o\*(C'\fR option for regular expressions (documented in perlop and
perlreref) tells Perl to compile the regular expression only once.
This is only useful when the pattern contains a variable. Perls 5.6
and later handle this automatically if the pattern does not change.
.PP
Since the match operator \f(CW\*(C`m//\*(C'\fR, the substitution operator \f(CW\*(C`s///\*(C'\fR,
and the regular expression quoting operator \f(CW\*(C`qr//\*(C'\fR are double-quotish
constructs, you can interpolate variables into the pattern. See the
answer to \*(L"How can I quote a variable to use in a regex?\*(R" for more
details.
.PP
This example takes a regular expression from the argument list and
prints the lines of input that match it:
.PP
.Vb 1
\&        my $pattern = shift @ARGV;
\&        
\&        while( <> ) {
\&                print if m/$pattern/;
\&                }
.Ve
.PP
Versions of Perl prior to 5.6 would recompile the regular expression
for each iteration, even if \f(CW$pattern\fR had not changed. The \f(CW\*(C`/o\*(C'\fR
would prevent this by telling Perl to compile the pattern the first
time, then reuse that for subsequent iterations:
.PP
.Vb 1
\&        my $pattern = shift @ARGV;
\&        
\&        while( <> ) {
\&                print if m/$pattern/o; # useful for Perl < 5.6
\&                }
.Ve
.PP
In versions 5.6 and later, Perl won't recompile the regular expression
if the variable hasn't changed, so you probably don't need the \f(CW\*(C`/o\*(C'\fR
option. It doesn't hurt, but it doesn't help either. If you want any
version of Perl to compile the regular expression only once even if
the variable changes (thus, only using its initial value), you still
need the \f(CW\*(C`/o\*(C'\fR.
.PP
You can watch Perl's regular expression engine at work to verify for
yourself if Perl is recompiling a regular expression. The \f(CW\*(C`use re
\&\*(Aqdebug\*(Aq\*(C'\fR pragma (comes with Perl 5.005 and later) shows the details.
With Perls before 5.6, you should see \f(CW\*(C`re\*(C'\fR reporting that its
compiling the regular expression on each iteration. With Perl 5.6 or
later, you should only see \f(CW\*(C`re\*(C'\fR report that for the first iteration.
.PP
.Vb 1
\&        use re \*(Aqdebug\*(Aq;
\&        
\&        $regex = \*(AqPerl\*(Aq;
\&        foreach ( qw(Perl Java Ruby Python) ) {
\&                print STDERR "\-" x 73, "\en";
\&                print STDERR "Trying $_...\en";
\&                print STDERR "\et$_ is good!\en" if m/$regex/;
\&                }
.Ve
.Sh "How do I use a regular expression to strip C style comments from a file?"
.IX Subsection "How do I use a regular expression to strip C style comments from a file?"
While this actually can be done, it's much harder than you'd think.
For example, this one-liner
.PP
.Vb 1
\&        perl \-0777 \-pe \*(Aqs{/\e*.*?\e*/}{}gs\*(Aq foo.c
.Ve
.PP
will work in many but not all cases.  You see, it's too simple-minded for
certain kinds of C programs, in particular, those with what appear to be
comments in quoted strings.  For that, you'd need something like this,
created by Jeffrey Friedl and later modified by Fred Curtis.
.PP
.Vb 4
\&        $/ = undef;
\&        $_ = <>;
\&        s#/\e*[^*]*\e*+([^/*][^*]*\e*+)*/|("(\e\e.|[^"\e\e])*"|\*(Aq(\e\e.|[^\*(Aq\e\e])*\*(Aq|.[^/"\*(Aq\e\e]*)#defined $2 ? $2 : ""#gse;
\&        print;
.Ve
.PP
This could, of course, be more legibly written with the \f(CW\*(C`/x\*(C'\fR modifier, adding
whitespace and comments.  Here it is expanded, courtesy of Fred Curtis.
.PP
.Vb 8
\&    s{
\&       /\e*         ##  Start of /* ... */ comment
\&       [^*]*\e*+    ##  Non\-* followed by 1\-or\-more *\*(Aqs
\&       (
\&         [^/*][^*]*\e*+
\&       )*          ##  0\-or\-more things which don\*(Aqt start with /
\&                   ##    but do end with \*(Aq*\*(Aq
\&       /           ##  End of /* ... */ comment
\&
\&     |         ##     OR  various things which aren\*(Aqt comments:
\&
\&       (
\&         "           ##  Start of " ... " string
\&         (
\&           \e\e.           ##  Escaped char
\&         |               ##    OR
\&           [^"\e\e]        ##  Non "\e
\&         )*
\&         "           ##  End of " ... " string
\&
\&       |         ##     OR
\&
\&         \*(Aq           ##  Start of \*(Aq ... \*(Aq string
\&         (
\&           \e\e.           ##  Escaped char
\&         |               ##    OR
\&           [^\*(Aq\e\e]        ##  Non \*(Aq\e