?? tieregistry.pm
字號(hào):
}
sub _Path
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
@_ and croak "Usage: \$arrRef= \$key->_Path;";
$self= $RegObj unless ref($self);
$self->{PATH};
}
sub Machine
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
@_ and croak "Usage: \$machine= \$key->Machine;";
$self= $RegObj unless ref($self);
$self->{MACHINE};
}
sub Access
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
@_ and croak "Usage: \$access= \$key->Access;";
$self= $RegObj unless ref($self);
$self->{ACCESS};
}
sub OS_Delimiter
{
my $self= shift(@_);
@_ and croak "Usage: \$backslash= \$key->OS_Delimiter;";
$self->{OS_DELIM};
}
sub _Roots
{
my $self= shift(@_);
$self= tied(%$self) if ref($self) && tied(%$self);
@_ and croak "Usage: \$varName= \$key->_Roots;";
$self= $RegObj unless ref($self);
$self->{ROOTS};
}
sub Roots
{
my $self= shift(@_);
$self= tied(%$self) if ref($self) && tied(%$self);
@_ and croak "Usage: \$hashRef= \$key->Roots;";
$self= $RegObj unless ref($self);
eval "\\%$self->{ROOTS}";
}
sub TIEHASH
{
my( $this )= shift(@_);
$this= tied(%$this) if ref($this) && tied(%$this);
my( $key )= @_;
if( 1 == @_ && ref($key) && "$key" =~ /=/ ) {
return $key; # $key is already an object (blessed reference).
}
return $this->new( @_ );
}
sub Tie
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my( $hRef )= @_;
if( 1 != @_ || ! ref($hRef) || "$hRef" !~ /(^|=)HASH\(/ ) {
croak "Usage: \$key->Tie(\\\%hash);";
}
tie %$hRef, ref($self), $self;
}
sub TiedRef
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $hRef= @_ ? shift(@_) : {};
return wantarray ? () : undef if ! defined($self);
$self->Tie($hRef);
bless $hRef, ref($self);
$hRef;
}
sub _Flags
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $oldFlags= $self->{FLAGS};
if( 1 == @_ ) {
$self->{FLAGS}= shift(@_);
} elsif( 0 != @_ ) {
croak "Usage: \$oldBits= \$key->_Flags(\$newBits);";
}
$oldFlags;
}
sub ArrayValues
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $oldFlag= $Flag_ArrVal == ( $Flag_ArrVal & $self->{FLAGS} );
if( 1 == @_ ) {
my $bool= shift(@_);
if( $bool ) {
$self->{FLAGS} |= $Flag_ArrVal;
} else {
$self->{FLAGS} &= ~( $Flag_ArrVal | $Flag_TieVal );
}
} elsif( 0 != @_ ) {
croak "Usage: \$oldBool= \$key->ArrayValues(\$newBool);";
}
$oldFlag;
}
sub TieValues
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $oldFlag= $Flag_TieVal == ( $Flag_TieVal & $self->{FLAGS} );
if( 1 == @_ ) {
my $bool= shift(@_);
if( $bool ) {
croak "${PACK}->TieValues cannot be enabled with this version";
$self->{FLAGS} |= $Flag_TieVal;
} else {
$self->{FLAGS} &= ~$Flag_TieVal;
}
} elsif( 0 != @_ ) {
croak "Usage: \$oldBool= \$key->TieValues(\$newBool);";
}
$oldFlag;
}
sub FastDelete
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $oldFlag= $Flag_FastDel == ( $Flag_FastDel & $self->{FLAGS} );
if( 1 == @_ ) {
my $bool= shift(@_);
if( $bool ) {
$self->{FLAGS} |= $Flag_FastDel;
} else {
$self->{FLAGS} &= ~$Flag_FastDel;
}
} elsif( 0 != @_ ) {
croak "Usage: \$oldBool= \$key->FastDelete(\$newBool);";
}
$oldFlag;
}
sub SplitMultis
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $oldFlag= $Flag_Split == ( $Flag_Split & $self->{FLAGS} );
if( 1 == @_ ) {
my $bool= shift(@_);
if( $bool ) {
$self->{FLAGS} |= $Flag_Split;
} else {
$self->{FLAGS} &= ~$Flag_Split;
}
} elsif( 0 != @_ ) {
croak "Usage: \$oldBool= \$key->SplitMultis(\$newBool);";
}
$oldFlag;
}
sub DWordsToHex
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $oldFlag= $Flag_HexDWord == ( $Flag_HexDWord & $self->{FLAGS} );
if( 1 == @_ ) {
my $bool= shift(@_);
if( $bool ) {
$self->{FLAGS} |= $Flag_HexDWord;
} else {
$self->{FLAGS} &= ~$Flag_HexDWord;
}
} elsif( 0 != @_ ) {
croak "Usage: \$oldBool= \$key->DWordsToHex(\$newBool);";
}
$oldFlag;
}
sub FixSzNulls
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $oldFlag= $Flag_FixNulls == ( $Flag_FixNulls & $self->{FLAGS} );
if( 1 == @_ ) {
my $bool= shift(@_);
if( $bool ) {
$self->{FLAGS} |= $Flag_FixNulls;
} else {
$self->{FLAGS} &= ~$Flag_FixNulls;
}
} elsif( 0 != @_ ) {
croak "Usage: \$oldBool= \$key->FixSzNulls(\$newBool);";
}
$oldFlag;
}
sub DualTypes
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $oldFlag= $Flag_DualTyp == ( $Flag_DualTyp & $self->{FLAGS} );
if( 1 == @_ ) {
my $bool= shift(@_);
if( $bool ) {
croak "${PACK}->DualTypes cannot be enabled since ",
"SetDualVar module not installed"
unless $_SetDualVar;
$self->{FLAGS} |= $Flag_DualTyp;
} else {
$self->{FLAGS} &= ~$Flag_DualTyp;
}
} elsif( 0 != @_ ) {
croak "Usage: \$oldBool= \$key->DualTypes(\$newBool);";
}
$oldFlag;
}
sub DualBinVals
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $oldFlag= $Flag_DualBin == ( $Flag_DualBin & $self->{FLAGS} );
if( 1 == @_ ) {
my $bool= shift(@_);
if( $bool ) {
croak "${PACK}->DualBinVals cannot be enabled since ",
"SetDualVar module not installed"
unless $_SetDualVar;
$self->{FLAGS} |= $Flag_DualBin;
} else {
$self->{FLAGS} &= ~$Flag_DualBin;
}
} elsif( 0 != @_ ) {
croak "Usage: \$oldBool= \$key->DualBinVals(\$newBool);";
}
$oldFlag;
}
sub GetOptions
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my( $opt, $meth, @old );
foreach $opt ( @_ ) {
$meth= $_opt_subs{$opt};
if( defined $meth ) {
if( $opt eq "AllowLoad" || $opt eq "AllowSave" ) {
croak "${PACK}->GetOptions: Getting current setting of $opt ",
"not supported in this release";
}
push( @old, $self->$meth() );
} else {
croak "${PACK}->GetOptions: Invalid option ($opt) ",
"not one of ( ", join(" ",grep !/^Allow/, @_opt_subs), " )";
}
}
return wantarray ? @old : $old[-1];
}
sub SetOptions
{
my $self= shift(@_);
# Don't get object if hash ref so "ref" returns original ref.
my( $opt, $meth, @old );
while( @_ ) {
$opt= shift(@_);
$meth= $_opt_subs{$opt};
if( ! @_ ) {
croak "${PACK}->SetOptions: Option value missing ",
"after option name ($opt)";
} elsif( defined $meth ) {
push( @old, $self->$meth( shift(@_) ) );
} elsif( $opt eq substr("reference",0,length($opt)) ) {
shift(@_) if @_;
push( @old, $self );
} else {
croak "${PACK}->SetOptions: Invalid option ($opt) ",
"not one of ( @_opt_subs )";
}
}
return wantarray ? @old : $old[-1];
}
sub _parseTiedEnt
{
my $self= shift(@_);
$self= tied(%$self) if tied(%$self);
my $ent= shift(@_);
my $delim= shift(@_);
my $dlen= length( $delim );
my $parent= @_ ? shift(@_) : 0;
my $off;
if( $delim x 2 eq substr($ent,0,2*$dlen) && "NONE" eq $self->Handle ) {
if( 0 <= ( $off= index( $ent, $delim x 2, 2*$dlen ) ) ) {
( substr( $ent, 0, $off ), substr( $ent, 2*$dlen+$off ) );
} elsif( $delim eq substr($ent,-$dlen) ) {
( substr($ent,0,-$dlen) );
} elsif( 2*$dlen <= ( $off= rindex( $ent, $delim ) ) ) {
( substr( $ent, 0, $off ), undef, substr( $ent, $dlen+$off ) );
} elsif( $parent ) {
();
} else {
( $ent );
}
} elsif( $delim eq substr($ent,0,$dlen) && "NONE" ne $self->Handle ) {
( undef, substr($ent,$dlen) );
} elsif( $self->{MEMBERS} && $self->_MembersHash->{$ent} ) {
( substr($ent,0,-$dlen) );
} elsif( 0 <= ( $off= index( $ent, $delim x 2 ) ) ) {
( substr( $ent, 0, $off ), substr( $ent, 2*$dlen+$off ) );
} elsif( $delim eq substr($ent,-$dlen) ) {
if( $parent
&& 0 <= ( $off= rindex( $ent, $delim, length($ent)-2*$dlen ) ) ) {
( substr($ent,0,$off), undef, undef,
substr($ent,$dlen+$off,-$dlen) );
} else {
( substr($ent,0,-$dlen) );
}
} elsif( 0 <= ( $off= rindex( $ent, $delim ) ) ) {
( substr( $ent, 0, $off ), undef, substr( $ent, $dlen+$off ) );
} else {
( undef, undef, $ent );
}
}
sub FETCH
{
my $self= shift(@_);
my $ent= shift(@_);
my $delim= $self->Delimiter;
my( $key, $val, $ambig )= $self->_parseTiedEnt( $ent, $delim, 0 );
my $sub;
if( defined($key) ) {
if( defined($self->{MEMBHASH})
&& $self->{MEMBHASH}->{$key.$delim}
&& 0 <= index($key,$delim) ) {
return wantarray ? () : undef
unless $sub= $self->new( $key,
{"Delimiter"=>$self->OS_Delimiter} );
$sub->Delimiter($delim);
} else {
return wantarray ? () : undef
unless $sub= $self->new( $key );
}
} else {
$sub= $self;
}
if( defined($val) ) {
return $self->ArrayValues ? [ $sub->GetValue( $val ) ]
: $sub->GetValue( $val );
} elsif( ! defined($ambig) ) {
return $sub->TiedRef;
} elsif( defined($key) ) {
return $sub->FETCH( $ambig );
} elsif( "" eq $ambig ) {
return $self->ArrayValues ? [ $sub->GetValue( $ambig ) ]
: $sub->GetValue( $ambig );
} else {
my $data= [ $sub->GetValue( $ambig ) ];
return $sub->ArrayValues ? $data : $$data[0]
if 0 != @$data;
$data= $sub->new( $ambig );
return defined($data) ? $data->TiedRef : wantarray ? () : undef;
}
}
sub _FetchOld
{
my( $self, $key )= @_;
my $old= $self->FETCH($key);
if( $old ) {
my $copy= {};
%$copy= %$old;
return $copy;
}
# return $^E;
return _Err;
}
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -