perltooc.1

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

\&    package Some_Class;
\&    my %ClassData = (
\&        CData1 => "",
\&        CData2 => "",
\&    );
\&    sub CData1 {
\&        shift;  # XXX: ignore calling class/object
\&        $ClassData{CData1} = shift if @_;
\&        return $ClassData{CData1};
\&    } 
\&    sub CData2 {
\&        shift;  # XXX: ignore calling class/object
\&        $ClassData{CData2} = shift if @_;
\&        return $ClassData{CData2};
\&    }
.Ve
.PP
To make this more scalable as other class attributes are added, we can
again register closures into the package symbol table to create accessor
methods for them.
.PP
.Vb 10
\&    package Some_Class;
\&    my %ClassData = (
\&        CData1 => "",
\&        CData2 => "",
\&    );
\&    for my $datum (keys %ClassData) { 
\&        no strict "refs";
\&        *$datum = sub { 
\&            shift;      # XXX: ignore calling class/object
\&            $ClassData{$datum} = shift if @_;
\&            return $ClassData{$datum};
\&        };
\&    }
.Ve
.PP
Requiring even your own class to use accessor methods like anybody else is
probably a good thing.  But demanding and expecting that everyone else,
be they subclass or superclass, friend or foe, will all come to your
object through mediation is more than just a good idea.  It's absolutely
critical to the model.  Let there be in your mind no such thing as
\&\*(L"public\*(R" data, nor even \*(L"protected\*(R" data, which is a seductive but
ultimately destructive notion.  Both will come back to bite at you.
That's because as soon as you take that first step out of the solid
position in which all state is considered completely private, save from the
perspective of its own accessor methods, you have violated the envelope.
And, having pierced that encapsulating envelope, you shall doubtless
someday pay the price when future changes in the implementation break
unrelated code.  Considering that avoiding this infelicitous outcome was
precisely why you consented to suffer the slings and arrows of obsequious
abstraction by turning to object orientation in the first place, such
breakage seems unfortunate in the extreme.
.Sh "More Inheritance Concerns"
.IX Subsection "More Inheritance Concerns"
Suppose that Some_Class were used as a base class from which to derive
Another_Class.  If you invoke a &CData method on the derived class or
on an object of that class, what do you get?  Would the derived class
have its own state, or would it piggyback on its base class's versions
of the class attributes?
.PP
The answer is that under the scheme outlined above, the derived class
would \fBnot\fR have its own state data.  As before, whether you consider
this a good thing or a bad one depends on the semantics of the classes
involved.
.PP
The cleanest, sanest, simplest way to address per-class state in a
lexical is for the derived class to override its base class's version
of the method that accesses the class attributes.  Since the actual method
called is the one in the object's derived class if this exists, you
automatically get per-class state this way.  Any urge to provide an
unadvertised method to sneak out a reference to the \f(CW%ClassData\fR hash
should be strenuously resisted.
.PP
As with any other overridden method, the implementation in the
derived class always has the option of invoking its base class's
version of the method in addition to its own.  Here's an example:
.PP
.Vb 2
\&    package Another_Class;
\&    @ISA = qw(Some_Class);
\&
\&    my %ClassData = (
\&        CData1 => "",
\&    );
\&
\&    sub CData1 {
\&        my($self, $newvalue) = @_;
\&        if (@_ > 1) { 
\&            # set locally first
\&            $ClassData{CData1} = $newvalue;  
\&
\&            # then pass the buck up to the first 
\&            # overridden version, if there is one
\&            if ($self\->can("SUPER::CData1")) { 
\&                $self\->SUPER::CData1($newvalue);
\&            }
\&        }
\&        return $ClassData{CData1};
\&    }
.Ve
.PP
Those dabbling in multiple inheritance might be concerned
about there being more than one override.
.PP
.Vb 6
\&    for my $parent (@ISA) {
\&        my $methname = $parent . "::CData1";
\&        if ($self\->can($methname)) { 
\&            $self\->$methname($newvalue);
\&        }
\&    }
.Ve
.PP
Because the &UNIVERSAL::can method returns a reference
to the function directly, you can use this directly
for a significant performance improvement:
.PP
.Vb 5
\&    for my $parent (@ISA) {
\&        if (my $coderef = $self\->can($parent . "::CData1")) {
\&            $self\->$coderef($newvalue);
\&        }
\&    }
.Ve
.PP
If you override \f(CW\*(C`UNIVERSAL::can\*(C'\fR in your own classes, be sure to return the
reference appropriately.
.Sh "Locking the Door and Throwing Away the Key"
.IX Subsection "Locking the Door and Throwing Away the Key"
As currently implemented, any code within the same scope as the
file-scoped lexical \f(CW%ClassData\fR can alter that hash directly.  Is that
ok?  Is it acceptable or even desirable to allow other parts of the
implementation of this class to access class attributes directly?
.PP
That depends on how careful you want to be.  Think back to the Cosmos
class.  If the &supernova method had directly altered \f(CW$Cosmos::Stars\fR or
\&\f(CW$Cosmos::Cosmos{stars}\fR, then we wouldn't have been able to reuse the
class when it came to inventing a Multiverse.  So letting even the class
itself access its own class attributes without the mediating intervention of
properly designed accessor methods is probably not a good idea after all.
.PP
Restricting access to class attributes from the class itself is usually
not enforceable even in strongly object-oriented languages.  But in Perl,
you can.
.PP
Here's one way:
.PP
.Vb 1
\&    package Some_Class;
\&
\&    {  # scope for hiding $CData1
\&        my $CData1;
\&        sub CData1 {
\&            shift;      # XXX: unused
\&            $CData1 = shift if @_;
\&            return $CData1;
\&        } 
\&    }
\&
\&    {  # scope for hiding $CData2
\&        my $CData2;
\&        sub CData2 {
\&            shift;      # XXX: unused
\&            $CData2 = shift if @_;
\&            return $CData2;
\&        } 
\&    }
.Ve
.PP
No one\*(--absolutely no one\*(--is allowed to read or write the class
attributes without the mediation of the managing accessor method, since
only that method has access to the lexical variable it's managing.
This use of mediated access to class attributes is a form of privacy far
stronger than most \s-1OO\s0 languages provide.
.PP
The repetition of code used to create per-datum accessor methods chafes
at our Laziness, so we'll again use closures to create similar
methods.
.PP
.Vb 1
\&    package Some_Class;
\&
\&    {  # scope for ultra\-private meta\-object for class attributes
\&        my %ClassData = ( 
\&            CData1 => "",
\&            CData2 => "",
\&        );
\&
\&        for my $datum (keys %ClassData ) { 
\&            no strict "refs";    
\&            *$datum = sub {
\&                use strict "refs";    
\&                my ($self, $newvalue) = @_;
\&                $ClassData{$datum} = $newvalue if @_ > 1;
\&                return $ClassData{$datum};
\&            }
\&        }
\&
\&    }
.Ve
.PP
The closure above can be modified to take inheritance into account using
the &UNIVERSAL::can method and \s-1SUPER\s0 as shown previously.
.Sh "Translucency Revisited"
.IX Subsection "Translucency Revisited"
The Vermin class demonstrates translucency using a package variable,
eponymously named \f(CW%Vermin\fR, as its meta-object.  If you prefer to
use absolutely no package variables beyond those necessary to appease
inheritance or possibly the Exporter, this strategy is closed to you.
That's too bad, because translucent attributes are an appealing
technique, so it would be valuable to devise an implementation using
only lexicals.
.PP
There's a second reason why you might wish to avoid the eponymous
package hash.  If you use class names with double-colons in them, you
would end up poking around somewhere you might not have meant to poke.
.PP
.Vb 4
\&    package Vermin;
\&    $class = "Vermin";
\&    $class\->{PopCount}++;       
\&    # accesses $Vermin::Vermin{PopCount}
\&
\&    package Vermin::Noxious;
\&    $class = "Vermin::Noxious";
\&    $class\->{PopCount}++;       
\&    # accesses $Vermin::Noxious{PopCount}
.Ve
.PP
In the first case, because the class name had no double-colons, we got
the hash in the current package.  But in the second case, instead of
getting some hash in the current package, we got the hash \f(CW%Noxious\fR in
the Vermin package.  (The noxious vermin just invaded another package and
sprayed their data around it. :\-) Perl doesn't support relative packages
in its naming conventions, so any double-colons trigger a fully-qualified
lookup instead of just looking in the current package.
.PP
In practice, it is unlikely that the Vermin class had an existing
package variable named \f(CW%Noxious\fR that you just blew away.  If you're
still mistrustful, you could always stake out your own territory
where you know the rules, such as using Eponymous::Vermin::Noxious or
Hieronymus::Vermin::Boschious or Leave_Me_Alone::Vermin::Noxious as class
names instead.  Sure, it's in theory possible that someone else has
a class named Eponymous::Vermin with its own \f(CW%Noxious\fR hash, but this
kind of thing is always true.  There's no arbiter of package names.
It's always the case that globals like \f(CW@Cwd::ISA\fR would collide if more
than one class uses the same Cwd package.
.PP
If this still leaves you with an uncomfortable twinge of paranoia,
we have another solution for you.  There's nothing that says that you
have to have a package variable to hold a class meta-object, either for
monadic classes or for translucent attributes.  Just code up the methods
so that they access a lexical instead.
.PP
Here's another implementation of the Vermin class with semantics identical
to those given previously, but this time using no package variables.
.PP
.Vb 1
\&    package Vermin;
\&
\&
\&    # Here\*(Aqs the class meta\-object, eponymously named.
\&    # It holds all class data, and also all instance data 
\&    # so the latter can be used for both initialization 
\&    # and translucency.  it\*(Aqs a template.
\&    my %ClassData = (                   
\&        PopCount => 0,          # capital for class attributes
\&        color    => "beige",    # small for instance attributes         
\&    );
\&
\&    # constructor method
\&    # invoked as class method or object method
\&    sub spawn {
\&        my $obclass = shift;
\&        my $class   = ref($obclass) || $obclass;
\&        my $self = {};
\&        bless($self, $class);
\&        $ClassData{PopCount}++;
\&        # init fields from invoking object, or omit if 
\&        # invoking object is the class to provide translucency
\&        %$self = %$obclass if ref $obclass;
\&        return $self;
\&    } 
\&
\&    # translucent accessor for "color" attribute
\&    # invoked as class method or object method
\&    sub color {
\&        my $self  = shift;
\&
\&        # handle class invocation
\&        unless (ref $self) {
\&            $ClassData{color} = shift if @_;
\&            return $ClassData{color}
\&        }
\&
\&        # handle object invocation
\&        $self\->{color} = shift if @_;
\&        if (defined $self\->{color}) {  # not exists!
\&            return $self\->{color};
\&        } else {
\&            return $ClassData{color};
\&        } 
\&    } 
\&
\&    # class attribute accessor for "PopCount" attribute
\&    # invoked as class method or object method
\&    sub population {
\&        return $ClassData{PopCount};
\&    } 
\&
\&    # instance destructor; invoked only as object method
\&    sub DESTROY {
\&        $ClassData{PopCount}\-\-;
\&    }
\&
\&    # detect whether an object attribute is translucent
\&    # (typically?) invoked only as object method
\&    sub is_translucent {
\&        my($self, $attr)  = @_;
\&        $self = \e%ClassData if !ref $self;
\&        return !defined $self\->{$attr};  
\&    }
\&
\&    # test for presence of attribute in class
\&    # invoked as class method or object method
\&    sub has_attribute {
\&        my($self, $attr)  = @_;
\&        return exists $ClassData{$attr};  
\&    }
.Ve
.SH "NOTES"
.IX Header "NOTES"
Inheritance is a powerful but subtle device, best used only after careful
forethought and design.  Aggregation instead of inheritance is often a
better approach.
.PP
You can't use file-scoped lexicals in conjunction with the SelfLoader
or the AutoLoader, because they alter the lexical scope in which the
module's methods wind up getting compiled.
.PP
The usual mealy-mouthed package-munging doubtless applies to setting
up names of object attributes.  For example, \f(CW\*(C`$self\->{ObData1}\*(C'\fR
should probably be \f(CW\*(C`$self\->{ _\|_PACKAGE_\|_ . "_ObData1" }\*(C'\fR, but that
would just confuse the examples.
.SH "SEE ALSO"
.IX Header "SEE ALSO"
perltoot, perlobj, perlmod, and perlbot.
.PP
The Tie::SecureHash and Class::Data::Inheritable modules from \s-1CPAN\s0 are
worth checking out.
.SH "AUTHOR AND COPYRIGHT"
.IX Header "AUTHOR AND COPYRIGHT"
Copyright (c) 1999 Tom Christiansen.
All rights reserved.
.PP
This documentation is free; you can redistribute it and/or modify it
under the same terms as Perl itself.
.PP
Irrespective of its distribution, all code examples in this file
are hereby placed into the public domain.  You are permitted and
encouraged to use this code in your own programs for fun
or for profit as you see fit.  A simple comment in the code giving
credit would be courteous but is not required.
.SH "ACKNOWLEDGEMENTS"
.IX Header "ACKNOWLEDGEMENTS"
Russ Allbery, Jon Orwant, Randy Ray, Larry Rosler, Nat Torkington,
and Stephen Warren all contributed suggestions and corrections to this
piece.  Thanks especially to Damian Conway for his ideas and feedback,
and without whose indirect prodding I might never have taken the time
to show others how much Perl has to offer in the way of objects once
you start thinking outside the tiny little box that today's \*(L"popular\*(R"
object-oriented languages enforce.
.SH "HISTORY"
.IX Header "HISTORY"
Last edit: Sun Feb  4 20:50:28 \s-1EST\s0 2001