P e r l d o c B r o w s e r
●
5 . 4 0 . 0
L a t e s t
5 . 4 0 . 0
5 . 3 8 . 2
5 . 3 8 . 1
5 . 3 8 . 0
5 . 3 6 . 3
5 . 3 6 . 2
5 . 3 6 . 1
5 . 3 6 . 0
5 . 3 4 . 3
5 . 3 4 . 2
5 . 3 4 . 1
5 . 3 4 . 0
5 . 3 2 . 1
5 . 3 2 . 0
5 . 3 0 . 3
5 . 3 0 . 2
5 . 3 0 . 1
5 . 3 0 . 0
5 . 2 8 . 3
5 . 2 8 . 2
5 . 2 8 . 1
5 . 2 8 . 0
5 . 2 6 . 3
5 . 2 6 . 2
5 . 2 6 . 1
5 . 2 6 . 0
5 . 2 4 . 4
5 . 2 4 . 3
5 . 2 4 . 2
5 . 2 4 . 1
5 . 2 4 . 0
5 . 2 2 . 4
5 . 2 2 . 3
5 . 2 2 . 2
5 . 2 2 . 1
5 . 2 2 . 0
5 . 2 0 . 3
5 . 2 0 . 2
5 . 2 0 . 1
5 . 2 0 . 0
5 . 1 8 . 4
5 . 1 8 . 3
5 . 1 8 . 2
5 . 1 8 . 1
5 . 1 8 . 0
5 . 1 6 . 3
5 . 1 6 . 2
5 . 1 6 . 1
5 . 1 6 . 0
5 . 1 4 . 4
5 . 1 4 . 3
5 . 1 4 . 2
5 . 1 4 . 1
5 . 1 4 . 0
5 . 1 2 . 5
5 . 1 2 . 4
5 . 1 2 . 3
5 . 1 2 . 2
5 . 1 2 . 1
5 . 1 2 . 0
5 . 1 0 . 1
5 . 1 0 . 0
5 . 8 . 9
5 . 8 . 8
5 . 8 . 7
5 . 8 . 6
5 . 8 . 5
5 . 8 . 4
5 . 8 . 3
5 . 8 . 2
5 . 8 . 1
5 . 8 . 0
5 . 6 . 2
5 . 6 . 1
5 . 6 . 0
5 . 0 0 5 _ 0 4
5 . 0 0 5 _ 0 3
5 . 0 0 5 _ 0 2
5 . 0 0 5 _ 0 1
5 . 0 0 5
●
D e v
b l e a d
5 . 4 1 . 2
5 . 4 1 . 1
5 . 4 0 . 0 - R C 2
5 . 4 0 . 0 - R C 1
5 . 3 9 . 1 0
5 . 3 9 . 9
5 . 3 9 . 8
5 . 3 9 . 6
5 . 3 9 . 5
5 . 3 9 . 4
5 . 3 9 . 3
5 . 3 9 . 2
5 . 3 9 . 1
5 . 3 7 . 1 1
5 . 3 7 . 1 0
5 . 3 7 . 9
5 . 3 7 . 8
5 . 3 7 . 7
5 . 3 7 . 6
5 . 3 7 . 5
5 . 3 7 . 4
5 . 3 7 . 3
5 . 3 7 . 2
5 . 3 7 . 1
5 . 3 7 . 0
●
D o c u m e n t a t i o n
P e r l
I n t r o
T u t o r i a l s
F A Q s
R e f e r e n c e
O p e r a t o r s
F u n c t i o n s
V a r i a b l e s
M o d u l e s
U t i l i t i e s
C o m m u n i t y
H i s t o r y
E x p a n d
p e r l t i e
( s o u r c e ,
C P A N )
Y o u a r e v i e w i n g t h e v e r s i o n o f t h i s d o c u m e n t a t i o n f r o m P e r l 5 . 4 0 . 0 .
V i e w t h e l a t e s t v e r s i o n
●
N A M E
●
S Y N O P S I S
●
D E S C R I P T I O N
●
T y i n g S c a l a r s
●
T y i n g A r r a y s
●
T y i n g H a s h e s
●
T y i n g F i l e H a n d l e s
●
U N T I E t h i s
●
T h e u n t i e G o t c h a
●
S E E A L S O
●
B U G S
●
A U T H O R
# N A M E
p e r l t i e - h o w t o h i d e a n o b j e c t c l a s s i n a s i m p l e v a r i a b l e
# S Y N O P S I S
tie VARIABLE, CLASSNAME, LIST
$object = tied VARIABLE
untie VARIABLE
# D E S C R I P T I O N
P r i o r t o r e l e a s e 5 . 0 o f P e r l , a p r o g r a m m e r c o u l d u s e d b m o p e n ( ) t o c o n n e c t a n o n - d i s k d a t a b a s e i n t h e s t a n d a r d U n i x d b m ( 3 x ) f o r m a t m a g i c a l l y t o a % H A S H i n t h e i r p r o g r a m . H o w e v e r , t h e i r P e r l w a s e i t h e r b u i l t w i t h o n e p a r t i c u l a r d b m l i b r a r y o r a n o t h e r , b u t n o t b o t h , a n d y o u c o u l d n ' t e x t e n d t h i s m e c h a n i s m t o o t h e r p a c k a g e s o r t y p e s o f v a r i a b l e s .
N o w y o u c a n .
T h e t i e ( ) f u n c t i o n b i n d s a v a r i a b l e t o a c l a s s ( p a c k a g e ) t h a t w i l l p r o v i d e t h e i m p l e m e n t a t i o n f o r a c c e s s m e t h o d s f o r t h a t v a r i a b l e . O n c e t h i s m a g i c h a s b e e n p e r f o r m e d , a c c e s s i n g a t i e d v a r i a b l e a u t o m a t i c a l l y t r i g g e r s m e t h o d c a l l s i n t h e p r o p e r c l a s s . T h e c o m p l e x i t y o f t h e c l a s s i s h i d d e n b e h i n d m a g i c m e t h o d s c a l l s . T h e m e t h o d n a m e s a r e i n A L L C A P S , w h i c h i s a c o n v e n t i o n t h a t P e r l u s e s t o i n d i c a t e t h a t t h e y ' r e c a l l e d i m p l i c i t l y r a t h e r t h a n e x p l i c i t l y - - j u s t l i k e t h e B E G I N ( ) a n d E N D ( ) f u n c t i o n s .
I n t h e t i e ( ) c a l l , V A R I A B L E
i s t h e n a m e o f t h e v a r i a b l e t o b e e n c h a n t e d . C L A S S N A M E
i s t h e n a m e o f a c l a s s i m p l e m e n t i n g o b j e c t s o f t h e c o r r e c t t y p e . A n y a d d i t i o n a l a r g u m e n t s i n t h e L I S T
a r e p a s s e d t o t h e a p p r o p r i a t e c o n s t r u c t o r m e t h o d f o r t h a t c l a s s - - m e a n i n g T I E S C A L A R ( ) , T I E A R R A Y ( ) , T I E H A S H ( ) , o r T I E H A N D L E ( ) . ( T y p i c a l l y t h e s e a r e a r g u m e n t s s u c h a s m i g h t b e p a s s e d t o t h e d b m i n i t ( ) f u n c t i o n o f C . ) T h e o b j e c t r e t u r n e d b y t h e " n e w " m e t h o d i s a l s o r e t u r n e d b y t h e t i e ( ) f u n c t i o n , w h i c h w o u l d b e u s e f u l i f y o u w a n t e d t o a c c e s s o t h e r m e t h o d s i n C L A
S S N A M E
. ( Y o u d o n ' t a c t u a l l y h a v e t o r e t u r n a r e f e r e n c e t o a r i g h t " t y p e " ( e . g . , H A S H o r C L A S S N A M
E
) s o l o n g a s i t ' s a p r o p e r l y b l e s s e d o b j e c t . ) Y o u c a n a l s o r e t r i e v e a r e f e r e n c e t o t h e u n d e r l y i n g o b j e c t u s i n g t h e t i e d ( ) f u n c t i o n .
U n l i k e d b m o p e n ( ) , t h e t i e ( ) f u n c t i o n w i l l n o t u s e
or r e q u i r e
a m o d u l e f o r y o u - - y o u n e e d t o d o t h a t e x p l i c i t l y y o u r s e l f .
# T y i n g S c a l a r s
A c l a s s i m p l e m e n t i n g a t i e d s c a l a r s h o u l d d e f i n e t h e f o l l o w i n g m e t h o d s : T I E S C A L A R , F E T C H , S T O R E , a n d p o s s i b l y U N T I E a n d / o r D E S T R O Y .
L e t ' s l o o k a t e a c h i n t u r n , u s i n g a s a n e x a m p l e a t i e c l a s s f o r s c a l a r s t h a t a l l o w s t h e u s e r t o d o s o m e t h i n g l i k e :
tie $his_speed, 'Nice', getppid();
tie $my_speed, 'Nice', $$;
A n d n o w w h e n e v e r e i t h e r o f t h o s e v a r i a b l e s i s a c c e s s e d , i t s c u r r e n t s y s t e m p r i o r i t y i s r e t r i e v e d a n d r e t u r n e d . I f t h o s e v a r i a b l e s a r e s e t , t h e n t h e p r o c e s s ' s p r i o r i t y i s c h a n g e d !
W e ' l l u s e J a r k k o H i e t a n i e m i < j h i @ i k i . f i > ' s B S D : : R e s o u r c e c l a s s ( n o t i n c l u d e d ) t o a c c e s s t h e P R I O _ P R O C E S S , P R I O _ M I N , a n d P R I O _ M A X c o n s t a n t s f r o m y o u r s y s t e m , a s w e l l a s t h e g e t p r i o r i t y ( ) a n d s e t p r i o r i t y ( ) s y s t e m c a l l s . H e r e ' s t h e p r e a m b l e o f t h e c l a s s .
package Nice;
use Carp;
use BSD::Resource;
use strict;
$Nice::DEBUG = 0 unless defined $Nice::DEBUG;
# T I E S C A L A R c l a s s n a m e , L I S T
T h i s i s t h e c o n s t r u c t o r f o r t h e c l a s s . T h a t m e a n s i t i s e x p e c t e d t o r e t u r n a b l e s s e d r e f e r e n c e t o a n e w s c a l a r ( p r o b a b l y a n o n y m o u s ) t h a t i t ' s c r e a t i n g . F o r e x a m p l e :
sub TIESCALAR {
my $class = shift;
my $pid = shift || $$; # 0 means me
if ($pid !~ /^\d+$/) {
carp "Nice::Tie::Scalar got non-numeric pid $pid" if $^W;
return undef;
}
unless (kill 0, $pid) { # EPERM or ERSCH, no doubt
carp "Nice::Tie::Scalar got bad pid $pid: $!" if $^W;
return undef;
}
return bless \$pid, $class;
}
T h i s t i e c l a s s h a s c h o s e n t o r e t u r n a n e r r o r r a t h e r t h a n r a i s i n g a n e x c e p t i o n i f i t s c o n s t r u c t o r s h o u l d f a i l . W h i l e t h i s i s h o w d b m o p e n ( ) w o r k s , o t h e r c l a s s e s m a y w e l l n o t w i s h t o b e s o f o r g i v i n g . I t c h e c k s t h e g l o b a l v a r i a b l e $ ^ W
t o s e e w h e t h e r t o e m i t a b i t o f n o i s e a n y w a y .
# F E T C H t h i s
T h i s m e t h o d w i l l b e t r i g g e r e d e v e r y t i m e t h e t i e d v a r i a b l e i s a c c e s s e d ( r e a d ) . I t t a k e s n o a r g u m e n t s b e y o n d i t s s e l f r e f e r e n c e , w h i c h i s t h e o b j e c t r e p r e s e n t i n g t h e s c a l a r w e ' r e d e a l i n g w i t h . B e c a u s e i n t h i s c a s e w e ' r e u s i n g j u s t a S C A L A R r e f f o r t h e t i e d s c a l a r o b j e c t , a s i m p l e $ $ s e l f a l l o w s t h e m e t h o d t o g e t a t t h e r e a l v a l u e s t o r e d t h e r e . I n o u r e x a m p l e b e l o w , t h a t r e a l v a l u e i s t h e p r o c e s s I D t o w h i c h w e ' v e t i e d o u r v a r i a b l e .
sub FETCH {
my $self = shift;
confess "wrong type" unless ref $self;
croak "usage error" if @_;
my $nicety;
local($!) = 0;
$nicety = getpriority(PRIO_PROCESS, $$self);
if ($!) { croak "getpriority failed: $!" }
return $nicety;
}
T h i s t i m e w e ' v e d e c i d e d t o b l o w u p ( r a i s e a n e x c e p t i o n ) i f t h e r e n i c e f a i l s - - t h e r e ' s n o p l a c e f o r u s t o r e t u r n a n e r r o r o t h e r w i s e , a n d i t ' s p r o b a b l y t h e r i g h t t h i n g t o d o .
# S T O R E t h i s , v a l u e
T h i s m e t h o d w i l l b e t r i g g e r e d e v e r y t i m e t h e t i e d v a r i a b l e i s s e t ( a s s i g n e d ) . B e y o n d i t s s e l f r e f e r e n c e , i t a l s o e x p e c t s o n e ( a n d o n l y o n e ) a r g u m e n t : t h e n e w v a l u e t h e u s e r i s t r y i n g t o a s s i g n . D o n ' t w o r r y a b o u t r e t u r n i n g a v a l u e f r o m S T O R E ; t h e s e m a n t i c o f a s s i g n m e n t r e t u r n i n g t h e a s s i g n e d v a l u e i s i m p l e m e n t e d w i t h F E T C H .
sub STORE {
my $self = shift;
confess "wrong type" unless ref $self;
my $new_nicety = shift;
croak "usage error" if @_;
if ($new_nicety < PRIO_MIN) {
carp sprintf
"WARNING: priority %d less than minimum system priority %d",
$new_nicety, PRIO_MIN if $^W;
$new_nicety = PRIO_MIN;
}
if ($new_nicety > PRIO_MAX) {
carp sprintf
"WARNING: priority %d greater than maximum system priority %d",
$new_nicety, PRIO_MAX if $^W;
$new_nicety = PRIO_MAX;
}
unless (defined setpriority(PRIO_PROCESS,
$$self,
$new_nicety))
{
confess "setpriority failed: $!";
}
}
# U N T I E t h i s
T h i s m e t h o d w i l l b e t r i g g e r e d w h e n t h e u n t i e
o c c u r s . T h i s c a n b e u s e f u l i f t h e c l a s s n e e d s t o k n o w w h e n n o f u r t h e r c a l l s w i l l b e m a d e . ( E x c e p t D E S T R O Y o f c o u r s e . ) S e e " T h e u n t i e
G o t c h a " b e l o w f o r m o r e d e t a i l s .
# D E S T R O Y t h i s
T h i s m e t h o d w i l l b e t r i g g e r e d w h e n t h e t i e d v a r i a b l e n e e d s t o b e d e s t r u c t e d . A s w i t h o t h e r o b j e c t c l a s s e s , s u c h a m e t h o d i s s e l d o m n e c e s s a r y , b e c a u s e P e r l d e a l l o c a t e s i t s m o r i b u n d o b j e c t ' s m e m o r y f o r y o u a u t o m a t i c a l l y - - t h i s i s n ' t C + + , y o u k n o w . W e ' l l u s e a D E S T R O Y m e t h o d h e r e f o r d e b u g g i n g p u r p o s e s o n l y .
sub DESTROY {
my $self = shift;
confess "wrong type" unless ref $self;
carp "[ Nice::DESTROY pid $$self ]" if $Nice::DEBUG;
}
T h a t ' s a b o u t a l l t h e r e i s t o i t . A c t u a l l y , i t ' s m o r e t h a n a l l t h e r e i s t o i t , b e c a u s e w e ' v e d o n e a f e w n i c e t h i n g s h e r e f o r t h e s a k e o f c o m p l e t e n e s s , r o b u s t n e s s , a n d g e n e r a l a e s t h e t i c s . S i m p l e r T I E S C A L A R c l a s s e s a r e c e r t a i n l y p o s s i b l e .
# T y i n g A r r a y s
A c l a s s i m p l e m e n t i n g a t i e d o r d i n a r y a r r a y s h o u l d d e f i n e t h e f o l l o w i n g m e t h o d s : T I E A R R A Y , F E T C H , S T O R E , F E T C H S I Z E , S T O R E S I Z E , C L E A R a n d p e r h a p s U N T I E a n d / o r D E S T R O Y .
F E T C H S I Z E a n d S T O R E S I Z E a r e u s e d t o p r o v i d e $ # a r r a y
a n d e q u i v a l e n t s c a l a r ( @ a r r a y )
a c c e s s .
T h e m e t h o d s P O P , P U S H , S H I F T , U N S H I F T , S P L I C E , D E L E T E , a n d E X I S T S a r e r e q u i r e d i f t h e p e r l o p e r a t o r w i t h t h e c o r r e s p o n d i n g ( b u t l o w e r c a s e ) n a m e i s t o o p e r a t e o n t h e t i e d a r r a y . T h e T i e : : A r r a y c l a s s c a n b e u s e d a s a b a s e c l a s s t o i m p l e m e n t t h e f i r s t f i v e o f t h e s e i n t e r m s o f t h e b a s i c m e t h o d s a b o v e . T h e d e f a u l t i m p l e m e n t a t i o n s o f D E L E T E a n d E X I S T S i n T i e : : A r r a y s i m p l y c r o a k
.
I n a d d i t i o n E X T E N D w i l l b e c a l l e d w h e n p e r l w o u l d h a v e p r e - e x t e n d e d a l l o c a t i o n i n a r e a l a r r a y .
F o r t h i s d i s c u s s i o n , w e ' l l i m p l e m e n t a n a r r a y w h o s e e l e m e n t s a r e a f i x e d s i z e a t c r e a t i o n . I f y o u t r y t o c r e a t e a n e l e m e n t l a r g e r t h a n t h e f i x e d s i z e , y o u ' l l t a k e a n e x c e p t i o n . F o r e x a m p l e :
use FixedElem_Array;
tie @array, 'FixedElem_Array', 3;
$array[0] = 'cat'; # ok.
$array[1 ] = 'dogs'; # exception, length('dogs') > 3.
T h e p r e a m b l e c o d e f o r t h e c l a s s i s a s f o l l o w s :
package FixedElem_Array;
use Carp;
use strict;
# T I E A R R A Y c l a s s n a m e , L I S T
T h i s i s t h e c o n s t r u c t o r f o r t h e c l a s s . T h a t m e a n s i t i s e x p e c t e d t o r e t u r n a b l e s s e d r e f e r e n c e t h r o u g h w h i c h t h e n e w a r r a y ( p r o b a b l y a n a n o n y m o u s A R R A Y r e f ) w i l l b e a c c e s s e d .
I n o u r e x a m p l e , j u s t t o s h o w y o u t h a t y o u d o n ' t r e a l l y h a v e t o r e t u r n a n A R R A Y r e f e r e n c e , w e ' l l c h o o s e a H A S H r e f e r e n c e t o r e p r e s e n t o u r o b j e c t . A H A S H w o r k s o u t w e l l a s a g e n e r i c r e c o r d t y p e : t h e { E L E M S I Z E }
f i e l d w i l l s t o r e t h e m a x i m u m e l e m e n t s i z e a l l o w e d , a n d t h e { A R R A Y }
f i e l d w i l l h o l d t h e t r u e A R R A Y r e f . I f s o m e o n e o u t s i d e t h e c l a s s t r i e s t o d e r e f e r e n c e t h e o b j e c t r e t u r n e d ( d o u b t l e s s t h i n k i n g i t a n A R R A Y r e f ) , t h e y ' l l b l o w u p . T h i s j u s t g o e s t o s h o w y o u t h a t y o u s h o u l d r e s p e c t a n o b j e c t ' s p r i v a c y .
sub TIEARRAY {
my $class = shift;
my $elemsize = shift;
if ( @_ || $elemsize =~ /\D/ ) {
croak "usage: tie ARRAY, '" . __PACKAGE__ . "', elem_size";
}
return bless {
ELEMSIZE => $elemsize,
ARRAY => [],
}, $class;
}
# F E T C H t h i s , i n d e x
T h i s m e t h o d w i l l b e t r i g g e r e d e v e r y t i m e a n i n d i v i d u a l e l e m e n t t h e t i e d a r r a y i s a c c e s s e d ( r e a d ) . I t t a k e s o n e a r g u m e n t b e y o n d i t s s e l f r e f e r e n c e : t h e i n d e x w h o s e v a l u e w e ' r e t r y i n g t o f e t c h .
sub FETCH {
my $self = shift;
my $index = shift;
return $self->{ARRAY}->[$index];
}
I f a n e g a t i v e a r r a y i n d e x i s u s e d t o r e a d f r o m a n a r r a y , t h e i n d e x w i l l b e t r a n s l a t e d t o a p o s i t i v e o n e i n t e r n a l l y b y c a l l i n g F E T C H S I Z E b e f o r e b e i n g p a s s e d t o F E T C H . Y o u m a y d i s a b l e t h i s f e a t u r e b y a s s i g n i n g a t r u e v a l u e t o t h e v a r i a b l e $ N E G A T I V E _ I
N D I C E S
i n t h e t i e d a r r a y c l a s s .
A s y o u m a y h a v e n o t i c e d , t h e n a m e o f t h e F E T C H m e t h o d ( e t a l . ) i s t h e s a m e f o r a l l a c c e s s e s , e v e n t h o u g h t h e c o n s t r u c t o r s d i f f e r i n n a m e s ( T I E S C A L A R v s T I E A R R A Y ) . W h i l e i n t h e o r y y o u c o u l d h a v e t h e s a m e c l a s s s e r v i c i n g s e v e r a l t i e d t y p e s , i n p r a c t i c e t h i s b e c o m e s c u m b e r s o m e , a n d i t ' s e a s i e s t t o k e e p t h e m a t s i m p l y o n e t i e t y p e p e r c l a s s .
# S T O R E t h i s , i n d e x , v a l u e
T h i s m e t h o d w i l l b e t r i g g e r e d e v e r y t i m e a n e l e m e n t i n t h e t i e d a r r a y i s s e t ( w r i t t e n ) . I t t a k e s t w o a r g u m e n t s b e y o n d i t s s e l f r e f e r e n c e : t h e i n d e x a t w h i c h w e ' r e t r y i n g t o s t o r e s o m e t h i n g a n d t h e v a l u e w e ' r e t r y i n g t o p u t t h e r e .
I n o u r e x a m p l e , u n d e f
i s r e a l l y $ s e l f - > { E L E M S I Z E }
n u m b e r o f s p a c e s s o w e h a v e a l i t t l e m o r e w o r k t o d o h e r e :
sub STORE {
my $self = shift;
my( $index, $value ) = @_;
if ( length $value > $self->{ELEMSIZE} ) {
croak "length of $value is greater than $self->{ELEMSIZE}";
}
# fill in the blanks
$self->STORESIZE( $index ) if $index > $self->FETCHSIZE();
# right justify to keep element size for smaller elements
$self->{ARRAY}->[$index] = sprintf "%$self->{ELEMSIZE}s", $value;
}
N e g a t i v e i n d e x e s a r e t r e a t e d t h e s a m e a s w i t h F E T C H .
# F E T C H S I Z E t h i s
R e t u r n s t h e t o t a l n u m b e r o f i t e m s i n t h e t i e d a r r a y a s s o c i a t e d w i t h o b j e c t t h i s . ( E q u i v a l e n t t o s c a l a r ( @ a r r a y )
) . F o r e x a m p l e :
sub FETCHSIZE {
my $self = shift;
return scalar $self->{ARRAY}->@*;
}
# S T O R E S I Z E t h i s , c o u n t
S e t s t h e t o t a l n u m b e r o f i t e m s i n t h e t i e d a r r a y a s s o c i a t e d w i t h o b j e c t t h i s t o b e c o u n t . I f t h i s m a k e s t h e a r r a y l a r g e r t h e n c l a s s ' s m a p p i n g o f u n d e f
s h o u l d b e r e t u r n e d f o r n e w p o s i t i o n s . I f t h e a r r a y b e c o m e s s m a l l e r t h e n e n t r i e s b e y o n d c o u n t s h o u l d b e d e l e t e d .
I n o u r e x a m p l e , ' u n d e f ' i s r e a l l y a n e l e m e n t c o n t a i n i n g $ s e l f -
> { E L E M S I Z E }
n u m b e r o f s p a c e s . O b s e r v e :
sub STORESIZE {
my $self = shift;
my $count = shift;
if ( $count > $self->FETCHSIZE() ) {
foreach ( $count - $self->FETCHSIZE() .. $count ) {
$self->STORE( $_, '' );
}
} elsif ( $count < $self->FETCHSIZE() ) {
foreach ( 0 .. $self->FETCHSIZE() - $count - 2 ) {
$self->POP();
}
}
}
# E X T E N D t h i s , c o u n t
I n f o r m a t i v e c a l l t h a t a r r a y i s l i k e l y t o g r o w t o h a v e c o u n t e n t r i e s . C a n b e u s e d t o o p t i m i z e a l l o c a t i o n . T h i s m e t h o d n e e d d o n o t h i n g .
I n o u r e x a m p l e t h e r e i s n o r e a s o n t o i m p l e m e n t t h i s m e t h o d , s o w e l e a v e i t a s a n o - o p . T h i s m e t h o d i s o n l y r e l e v a n t t o t i e d a r r a y i m p l e m e n t a t i o n s w h e r e t h e r e i s t h e p o s s i b i l i t y o f h a v i n g t h e a l l o c a t e d s i z e o f t h e a r r a y b e l a r g e r t h a n i s v i s i b l e t o a p e r l p r o g r a m m e r i n s p e c t i n g t h e s i z e o f t h e a r r a y . M a n y t i e d a r r a y i m p l e m e n t a t i o n s w i l l h a v e n o r e a s o n t o i m p l e m e n t i t .
sub EXTEND {
my $self = shift;
my $count = shift;
# nothing to see here, move along.
}
N O T E : I t i s g e n e r a l l y a n e r r o r t o m a k e t h i s e q u i v a l e n t t o S T O R E S I Z E . P e r l m a y f r o m t i m e t o t i m e c a l l E X T E N D w i t h o u t w a n t i n g t o a c t u a l l y c h a n g e t h e a r r a y s i z e d i r e c t l y . A n y t i e d a r r a y s h o u l d f u n c t i o n c o r r e c t l y i f t h i s m e t h o d i s a n o - o p , e v e n i f p e r h a p s t h e y m i g h t n o t b e a s e f f i c i e n t a s t h e y w o u l d i f t h i s m e t h o d w a s i m p l e m e n t e d .
# E X I S T S t h i s , k e y
V e r i f y t h a t t h e e l e m e n t a t i n d e x k e y e x i s t s i n t h e t i e d a r r a y t h i s .
I n o u r e x a m p l e , w e w i l l d e t e r m i n e t h a t i f a n e l e m e n t c o n s i s t s o f $ s e l f - > { E L E M S I Z E }
s p a c e s o n l y , i t d o e s n o t e x i s t :
sub EXISTS {
my $self = shift;
my $index = shift;
return 0 if ! defined $self->{ARRAY}->[$index] ||
$self->{ARRAY}->[$index] eq ' ' x $self->{ELEMSIZE};
return 1;
}
# D E L E T E t h i s , k e y
D e l e t e t h e e l e m e n t a t i n d e x k e y f r o m t h e t i e d a r r a y t h i s .
I n o u r e x a m p l e , a d e l e t e d i t e m i s $ s e l f - > { E L E M S I Z E }
s p a c e s :
sub DELETE {
my $self = shift;
my $index = shift;
return $self->STORE( $index, '' );
}
# C L E A R t h i s
C l e a r ( r e m o v e , d e l e t e , . . . ) a l l v a l u e s f r o m t h e t i e d a r r a y a s s o c i a t e d w i t h o b j e c t t h i s . F o r e x a m p l e :
sub CLEAR {
my $self = shift;
return $self->{ARRAY} = [];
}
# P U S H t h i s , L I S T
A p p e n d e l e m e n t s o f L I S T t o t h e a r r a y . F o r e x a m p l e :
sub PUSH {
my $self = shift;
my @list = @_;
my $last = $self->FETCHSIZE();
$self->STORE( $last + $_, $list[$_] ) foreach 0 .. $#list;
return $self->FETCHSIZE();
}
# P O P t h i s
R e m o v e l a s t e l e m e n t o f t h e a r r a y a n d r e t u r n i t . F o r e x a m p l e :
sub POP {
my $self = shift;
return pop $self->{ARRAY}->@*;
}
# S H I F T t h i s
R e m o v e t h e f i r s t e l e m e n t o f t h e a r r a y ( s h i f t i n g o t h e r e l e m e n t s d o w n ) a n d r e t u r n i t . F o r e x a m p l e :
sub SHIFT {
my $self = shift;
return shift $self->{ARRAY}->@*;
}
# U N S H I F T t h i s , L I S T
I n s e r t L I S T e l e m e n t s a t t h e b e g i n n i n g o f t h e a r r a y , m o v i n g e x i s t i n g e l e m e n t s u p t o m a k e r o o m . F o r e x a m p l e :
sub UNSHIFT {
my $self = shift;
my @list = @_;
my $size = scalar( @list );
# make room for our list
$self->{ARRAY}[ $size .. $self->{ARRAY}->$#* + $size ]->@*
= $self->{ARRAY}->@*
$self->STORE( $_, $list[$_] ) foreach 0 .. $#list;
}
# S P L I C E t h i s , o f f s e t , l e n g t h , L I S T
P e r f o r m t h e e q u i v a l e n t o f s p l i c
e
o n t h e a r r a y .
o f f s e t i s o p t i o n a l a n d d e f a u l t s t o z e r o , n e g a t i v e v a l u e s c o u n t b a c k f r o m t h e e n d o f t h e a r r a y .
l e n g t h i s o p t i o n a l a n d d e f a u l t s t o r e s t o f t h e a r r a y .
L I S T m a y b e e m p t y .
R e t u r n s a l i s t o f t h e o r i g i n a l l e n g t h e l e m e n t s a t o f f s e t .
I n o u r e x a m p l e , w e ' l l u s e a l i t t l e s h o r t c u t i f t h e r e i s a L I S T :
sub SPLICE {
my $self = shift;
my $offset = shift || 0;
my $length = shift || $self->FETCHSIZE() - $offset;
my @list = ();
if ( @_ ) {
tie @list, __PACKAGE__, $self->{ELEMSIZE};
@list = @_;
}
return splice $self->{ARRAY}->@*, $offset, $length, @list;
}
# U N T I E t h i s
W i l l b e c a l l e d w h e n u n t i e
h a p p e n s . ( S e e " T h e u n t i e
G o t c h a " b e l o w . )
# D E S T R O Y t h i s
T h i s m e t h o d w i l l b e t r i g g e r e d w h e n t h e t i e d v a r i a b l e n e e d s t o b e d e s t r u c t e d . A s w i t h t h e s c a l a r t i e c l a s s , t h i s i s a l m o s t n e v e r n e e d e d i n a l a n g u a g e t h a t d o e s i t s o w n g a r b a g e c o l l e c t i o n , s o t h i s t i m e w e ' l l j u s t l e a v e i t o u t .
# T y i n g H a s h e s
H a s h e s w e r e t h e f i r s t P e r l d a t a t y p e t o b e t i e d ( s e e d b m o p e n ( ) ) . A c l a s s i m p l e m e n t i n g a t i e d h a s h s h o u l d d e f i n e t h e f o l l o w i n g m e t h o d s : T I E H A S H i s t h e c o n s t r u c t o r . F E T C H a n d S T O R E a c c e s s t h e k e y a n d v a l u e p a i r s . E X I S T S r e p o r t s w h e t h e r a k e y i s p r e s e n t i n t h e h a s h , a n d D E L E T E d e l e t e s o n e . C L E A R e m p t i e s t h e h a s h b y d e l e t i n g a l l t h e k e y a n d v a l u e p a i r s . F I R S T K E Y a n d N E X T K E Y i m p l e m e n t t h e k e y s ( ) a n d e a c h ( ) f u n c t i o n s t o i t e r a t e o v e r a l l t h e k e y s . S C A L A R i s t r i g g e r e d w h e n t h e t i e d h a s h i s e v a l u a t e d i n s c a l a r c o n t e x t , a n d i n 5 . 2 8 o n w a r d s , b y k e y s
i n b o o l e a n c o n t e x t . U N T I E i s c a l l e d w h e n u n t i e
h a p p e n s , a n d D E S T R O Y i s c a l l e d w h e n t h e t i e d v a r i a b l e i s g a r b a g e c o l l e c t e d .
I f t h i s s e e m s l i k e a l o t , t h e n f e e l f r e e t o i n h e r i t f r o m m e r e l y t h e s t a n d a r d T i e : : S t d H a s h m o d u l e f o r m o s t o f y o u r m e t h o d s , r e d e f i n i n g o n l y t h e i n t e r e s t i n g o n e s . S e e T i e : : H a s h f o r d e t a i l s .
R e m e m b e r t h a t P e r l d i s t i n g u i s h e s b e t w e e n a k e y n o t e x i s t i n g i n t h e h a s h , a n d t h e k e y e x i s t i n g i n t h e h a s h b u t h a v i n g a c o r r e s p o n d i n g v a l u e o f u n d e f
. T h e t w o p o s s i b i l i t i e s c a n b e t e s t e d w i t h t h e e x i s t s ( )
a n d d e f i n e d ( )
f u n c t i o n s .
H e r e ' s a n e x a m p l e o f a s o m e w h a t i n t e r e s t i n g t i e d h a s h c l a s s : i t g i v e s y o u a h a s h r e p r e s e n t i n g a p a r t i c u l a r u s e r ' s d o t f i l e s . Y o u i n d e x i n t o t h e h a s h w i t h t h e n a m e o f t h e f i l e ( m i n u s t h e d o t ) a n d y o u g e t b a c k t h a t d o t f i l e ' s c o n t e n t s . F o r e x a m p l e :
use DotFiles;
tie %dot, 'DotFiles';
if ( $dot{profile} =~ /MANPATH/ ||
$dot{login} =~ /MANPATH/ ||
$dot{cshrc} =~ /MANPATH/ )
{
print "you seem to set your MANPATH\n";
}
O r h e r e ' s a n o t h e r s a m p l e o f u s i n g o u r t i e d c l a s s :
tie %him, 'DotFiles', 'daemon';
foreach $f ( keys %him ) {
printf "daemon dot file %s is size %d\n",
$f, length $him{$f};
}
I n o u r t i e d h a s h D o t F i l e s e x a m p l e , w e u s e a r e g u l a r h a s h f o r t h e o b j e c t c o n t a i n i n g s e v e r a l i m p o r t a n t f i e l d s , o f w h i c h o n l y t h e {
L I S T }
f i e l d w i l l b e w h a t t h e u s e r t h i n k s o f a s t h e r e a l h a s h .
# U S E R
w h o s e d o t f i l e s t h i s o b j e c t r e p r e s e n t s
# H O M E
w h e r e t h o s e d o t f i l e s l i v e
# C L O B B E R
w h e t h e r w e s h o u l d t r y t o c h a n g e o r r e m o v e t h o s e d o t f i l e s
# L I S T
t h e h a s h o f d o t f i l e n a m e s a n d c o n t e n t m a p p i n g s
H e r e ' s t h e s t a r t o f D o t f i l e s . p m :
package DotFiles;
use Carp;
sub whowasi { (caller(1 ))[3 ] . '()' }
my $DEBUG = 0;
sub debug { $DEBUG = @_ ? shift : 1 }
F o r o u r e x a m p l e , w e w a n t t o b e a b l e t o e m i t d e b u g g i n g i n f o t o h e l p i n t r a c i n g d u r i n g d e v e l o p m e n t . W e k e e p a l s o o n e c o n v e n i e n c e f u n c t i o n a r o u n d i n t e r n a l l y t o h e l p p r i n t o u t w a r n i n g s ; w h o w a s i ( ) r e t u r n s t h e f u n c t i o n n a m e t h a t c a l l s i t .
H e r e a r e t h e m e t h o d s f o r t h e D o t F i l e s t i e d h a s h .
# T I E H A S H c l a s s n a m e , L I S T
T h i s i s t h e c o n s t r u c t o r f o r t h e c l a s s . T h a t m e a n s i t i s e x p e c t e d t o r e t u r n a b l e s s e d r e f e r e n c e t h r o u g h w h i c h t h e n e w o b j e c t ( p r o b a b l y b u t n o t n e c e s s a r i l y a n a n o n y m o u s h a s h ) w i l l b e a c c e s s e d .
H e r e ' s t h e c o n s t r u c t o r :
sub TIEHASH {
my $class = shift;
my $user = shift || $>;
my $dotdir = shift || '';
croak "usage: @{[&whowasi]} [USER [DOTDIR]]" if @_;
$user = getpwuid($user) if $user =~ /^\d+$/;
my $dir = (getpwnam($user))[7 ]
|| croak "@{[&whowasi]}: no user $user";
$dir .= "/$dotdir" if $dotdir;
my $node = {
USER => $user,
HOME => $dir,
LIST => {},
CLOBBER => 0,
};
opendir(DIR, $dir)
|| croak "@{[&whowasi]}: can't opendir $dir: $!";
foreach $dot ( grep /^\./ && -f "$dir/$_", readdir(DIR)) {
$dot =~ s/^\.//;
$node->{LIST}{$dot} = undef;
}
closedir DIR;
return bless $node, $class;
}
I t ' s p r o b a b l y w o r t h m e n t i o n i n g t h a t i f y o u ' r e g o i n g t o f i l e t e s t t h e r e t u r n v a l u e s o u t o f a r e a d d i r , y o u ' d b e t t e r p r e p e n d t h e d i r e c t o r y i n q u e s t i o n . O t h e r w i s e , b e c a u s e w e d i d n ' t c h d i r ( ) t h e r e , i t w o u l d h a v e b e e n t e s t i n g t h e w r o n g f i l e .
# F E T C H t h i s , k e y
T h i s m e t h o d w i l l b e t r i g g e r e d e v e r y t i m e a n e l e m e n t i n t h e t i e d h a s h i s a c c e s s e d ( r e a d ) . I t t a k e s o n e a r g u m e n t b e y o n d i t s s e l f r e f e r e n c e : t h e k e y w h o s e v a l u e w e ' r e t r y i n g t o f e t c h .
H e r e ' s t h e f e t c h f o r o u r D o t F i l e s e x a m p l e .
sub FETCH {
carp &whowasi if $DEBUG;
my $self = shift;
my $dot = shift;
my $dir = $self->{HOME};
my $file = "$dir/.$dot";
unless (exists $self->{LIST}->{$dot} || -f $file) {
carp "@{[&whowasi]}: no $dot file" if $DEBUG;
return undef;
}
if (defined $self->{LIST}->{$dot}) {
return $self->{LIST}->{$dot};
} else {
return $self->{LIST}->{$dot} = `cat $dir/.$dot`;
}
}
I t w a s e a s y t o w r i t e b y h a v i n g i t c a l l t h e U n i x c a t ( 1 ) c o m m a n d , b u t i t w o u l d p r o b a b l y b e m o r e p o r t a b l e t o o p e n t h e f i l e m a n u a l l y ( a n d s o m e w h a t m o r e e f f i c i e n t ) . O f c o u r s e , b e c a u s e d o t f i l e s a r e a U n i x y c o n c e p t , w e ' r e n o t t h a t c o n c e r n e d .
# S T O R E t h i s , k e y , v a l u e
T h i s m e t h o d w i l l b e t r i g g e r e d e v e r y t i m e a n e l e m e n t i n t h e t i e d h a s h i s s e t ( w r i t t e n ) . I t t a k e s t w o a r g u m e n t s b e y o n d i t s s e l f r e f e r e n c e : t h e i n d e x a t w h i c h w e ' r e t r y i n g t o s t o r e s o m e t h i n g , a n d t h e v a l u e w e ' r e t r y i n g t o p u t t h e r e .
H e r e i n o u r D o t F i l e s e x a m p l e , w e ' l l b e c a r e f u l n o t t o l e t t h e m t r y t o o v e r w r i t e t h e f i l e u n l e s s t h e y ' v e c a l l e d t h e c l o b b e r ( ) m e t h o d o n t h e o r i g i n a l o b j e c t r e f e r e n c e r e t u r n e d b y t i e ( ) .
sub STORE {
carp &whowasi if $DEBUG;
my $self = shift;
my $dot = shift;
my $value = shift;
my $file = $self->{HOME} . "/.$dot";
my $user = $self->{USER};
croak "@{[&whowasi]}: $file not clobberable"
unless $self->{CLOBBER};
open(my $f, '>', $file) || croak "can't open $file: $!";
print $f $value;
close($f);
}
I f t h e y w a n t e d t o c l o b b e r s o m e t h i n g , t h e y m i g h t s a y :
$ob = tie %daemon_dots, 'daemon';
$ob->clobber(1 );
$daemon_dots{signature} = "A true daemon\n";
A n o t h e r w a y t o l a y h a n d s o n a r e f e r e n c e t o t h e u n d e r l y i n g o b j e c t i s t o u s e t h e t i e d ( ) f u n c t i o n , s o t h e y m i g h t a l t e r n a t e l y h a v e s e t c l o b b e r u s i n g :
tie %daemon_dots, 'daemon';
tied(%daemon_dots)->clobber(1 );
T h e c l o b b e r m e t h o d i s s i m p l y :
sub clobber {
my $self = shift;
$self->{CLOBBER} = @_ ? shift : 1;
}
# D E L E T E t h i s , k e y
T h i s m e t h o d i s t r i g g e r e d w h e n w e r e m o v e a n e l e m e n t f r o m t h e h a s h , t y p i c a l l y b y u s i n g t h e d e l e t e ( ) f u n c t i o n . A g a i n , w e ' l l b e c a r e f u l t o c h e c k w h e t h e r t h e y r e a l l y w a n t t o c l o b b e r f i l e s .
sub DELETE {
carp &whowasi if $DEBUG;
my $self = shift;
my $dot = shift;
my $file = $self->{HOME} . "/.$dot";
croak "@{[&whowasi]}: won't remove file $file"
unless $self->{CLOBBER};
delete $self->{LIST}->{$dot};
my $success = unlink($file);
carp "@{[&whowasi]}: can't unlink $file: $!" unless $success;
$success;
}
T h e v a l u e r e t u r n e d b y D E L E T E b e c o m e s t h e r e t u r n v a l u e o f t h e c a l l t o d e l e t e ( ) . I f y o u w a n t t o e m u l a t e t h e n o r m a l b e h a v i o r o f d e l e t e ( ) , y o u s h o u l d r e t u r n w h a t e v e r F E T C H w o u l d h a v e r e t u r n e d f o r t h i s k e y . I n t h i s e x a m p l e , w e h a v e c h o s e n i n s t e a d t o r e t u r n a v a l u e w h i c h t e l l s t h e c a l l e r w h e t h e r t h e f i l e w a s s u c c e s s f u l l y d e l e t e d .
# C L E A R t h i s
T h i s m e t h o d i s t r i g g e r e d w h e n t h e w h o l e h a s h i s t o b e c l e a r e d , u s u a l l y b y a s s i g n i n g t h e e m p t y l i s t t o i t .
I n o u r e x a m p l e , t h a t w o u l d r e m o v e a l l t h e u s e r ' s d o t f i l e s ! I t ' s s u c h a d a n g e r o u s t h i n g t h a t t h e y ' l l h a v e t o s e t C L O B B E R t o s o m e t h i n g h i g h e r t h a n 1 t o m a k e i t h a p p e n .
sub CLEAR {
carp &whowasi if $DEBUG;
my $self = shift;
croak "@{[&whowasi]}: won't remove all dot files for $self->{USER}"
unless $self->{CLOBBER} > 1;
my $dot;
foreach $dot ( keys $self->{LIST}->%* ) {
$self->DELETE($dot);
}
}
# E X I S T S t h i s , k e y
T h i s m e t h o d i s t r i g g e r e d w h e n t h e u s e r u s e s t h e e x i s t s ( ) f u n c t i o n o n a p a r t i c u l a r h a s h . I n o u r e x a m p l e , w e ' l l l o o k a t t h e { L
I S T }
h a s h e l e m e n t f o r t h i s :
sub EXISTS {
carp &whowasi if $DEBUG;
my $self = shift;
my $dot = shift;
return exists $self->{LIST}->{$dot};
}
# F I R S T K E Y t h i s
T h i s m e t h o d w i l l b e t r i g g e r e d w h e n t h e u s e r i s g o i n g t o i t e r a t e t h r o u g h t h e h a s h , s u c h a s v i a a k e y s ( ) , v a l u e s ( ) , o r e a c h ( ) c a l l .
sub FIRSTKEY {
carp &whowasi if $DEBUG;
my $self = shift;
my $x = keys $self->{LIST}->%*; # reset each() iterator
each $self->{LIST}->%*
}
F I R S T K E Y i s a l w a y s c a l l e d i n s c a l a r c o n t e x t a n d i t s h o u l d j u s t r e t u r n t h e f i r s t k e y . v a l u e s ( ) , a n d e a c h ( ) i n l i s t c o n t e x t , w i l l c a l l F E T C H f o r t h e r e t u r n e d k e y s .
# N E X T K E Y t h i s , l a s t k e y
T h i s m e t h o d g e t s t r i g g e r e d d u r i n g a k e y s ( ) , v a l u e s ( ) , o r e a c h ( ) i t e r a t i o n . I t h a s a s e c o n d a r g u m e n t w h i c h i s t h e l a s t k e y t h a t h a d b e e n a c c e s s e d . T h i s i s u s e f u l i f y o u ' r e c a r i n g a b o u t o r d e r i n g o r c a l l i n g t h e i t e r a t o r f r o m m o r e t h a n o n e s e q u e n c e , o r n o t r e a l l y s t o r i n g t h i n g s i n a h a s h a n y w h e r e .
N E X T K E Y i s a l w a y s c a l l e d i n s c a l a r c o n t e x t a n d i t s h o u l d j u s t r e t u r n t h e n e x t k e y . v a l u e s ( ) , a n d e a c h ( ) i n l i s t c o n t e x t , w i l l c a l l F E T C H f o r t h e r e t u r n e d k e y s .
F o r o u r e x a m p l e , w e ' r e u s i n g a r e a l h a s h s o w e ' l l d o j u s t t h e s i m p l e t h i n g , b u t w e ' l l h a v e t o g o t h r o u g h t h e L I S T f i e l d i n d i r e c t l y .
sub NEXTKEY {
carp &whowasi if $DEBUG;
my $self = shift;
return each $self->{LIST}->%*
}
I f t h e o b j e c t u n d e r l y i n g y o u r t i e d h a s h i s n ' t a r e a l h a s h a n d y o u d o n ' t h a v e e a c h
a v a i l a b l e , t h e n y o u s h o u l d r e t u r n u n d e f
o r t h e e m p t y l i s t o n c e y o u ' v e r e a c h e d t h e e n d o f y o u r l i s t o f k e y s . S e e e a c h ' s o w n d o c u m e n t a t i o
n
f o r m o r e d e t a i l s .
# S C A L A R t h i s
T h i s i s c a l l e d w h e n t h e h a s h i s e v a l u a t e d i n s c a l a r c o n t e x t , a n d i n 5 . 2 8 o n w a r d s , b y k e y s
i n b o o l e a n c o n t e x t . I n o r d e r t o m i m i c t h e b e h a v i o u r o f u n t i e d h a s h e s , t h i s m e t h o d m u s t r e t u r n a v a l u e w h i c h w h e n u s e d a s b o o l e a n , i n d i c a t e s w h e t h e r t h e t i e d h a s h i s c o n s i d e r e d e m p t y . I f t h i s m e t h o d d o e s n o t e x i s t , p e r l w i l l m a k e s o m e e d u c a t e d g u e s s e s a n d r e t u r n t r u e w h e n t h e h a s h i s i n s i d e a n i t e r a t i o n . I f t h i s i s n ' t t h e c a s e , F I R S T K E Y i s c a l l e d , a n d t h e r e s u l t w i l l b e a f a l s e v a l u e i f F I R S T K E Y r e t u r n s t h e e m p t y l i s t , t r u e o t h e r w i s e .
H o w e v e r , y o u s h o u l d n o t b l i n d l y r e l y o n p e r l a l w a y s d o i n g t h e r i g h t t h i n g . P a r t i c u l a r l y , p e r l w i l l m i s t a k e n l y r e t u r n t r u e w h e n y o u c l e a r t h e h a s h b y r e p e a t e d l y c a l l i n g D E L E T E u n t i l i t i s e m p t y . Y o u a r e t h e r e f o r e a d v i s e d t o s u p p l y y o u r o w n S C A L A R m e t h o d w h e n y o u w a n t t o b e a b s o l u t e l y s u r e t h a t y o u r h a s h b e h a v e s n i c e l y i n s c a l a r c o n t e x t .
I n o u r e x a m p l e w e c a n j u s t c a l l s c a l a r
o n t h e u n d e r l y i n g h a s h r e f e r e n c e d b y $ s e l f - > { L I S T }
:
sub SCALAR {
carp &whowasi if $DEBUG;
my $self = shift;
return scalar $self->{LIST}->%*
}
N O T E : I n p e r l 5 . 2 5 t h e b e h a v i o r o f s c a l a r % h a s h o n a n u n t i e d h a s h c h a n g e d t o r e t u r n t h e c o u n t o f k e y s . P r i o r t o t h i s i t r e t u r n e d a s t r i n g c o n t a i n i n g i n f o r m a t i o n a b o u t t h e b u c k e t s e t u p o f t h e h a s h . S e e " b u c k e t _ r a t i o " i n H a s h : : U t i l f o r a b a c k w a r d s c o m p a t i b i l i t y p a t h .
# U N T I E t h i s
T h i s i s c a l l e d w h e n u n t i e
o c c u r s . S e e " T h e u n t i e
G o t c h a " b e l o w .
# D E S T R O Y t h i s
T h i s m e t h o d i s t r i g g e r e d w h e n a t i e d h a s h i s a b o u t t o g o o u t o f s c o p e . Y o u d o n ' t r e a l l y n e e d i t u n l e s s y o u ' r e t r y i n g t o a d d d e b u g g i n g o r h a v e a u x i l i a r y s t a t e t o c l e a n u p . H e r e ' s a v e r y s i m p l e f u n c t i o n :
sub DESTROY {
carp &whowasi if $DEBUG;
}
N o t e t h a t f u n c t i o n s s u c h a s k e y s ( ) a n d v a l u e s ( ) m a y r e t u r n h u g e l i s t s w h e n u s e d o n l a r g e o b j e c t s , l i k e D B M f i l e s . Y o u m a y p r e f e r t o u s e t h e e a c h ( ) f u n c t i o n t o i t e r a t e o v e r s u c h . E x a m p l e :
# print out history file offsets
use NDBM_File;
tie(%HIST, 'NDBM_File', '/usr/lib/news/history', 1, 0);
while (($key,$val) = each %HIST) {
print $key, ' = ', unpack('L',$val), "\n";
}
untie(%HIST);
# T y i n g F i l e H a n d l e s
T h i s i s p a r t i a l l y i m p l e m e n t e d n o w .
A c l a s s i m p l e m e n t i n g a t i e d f i l e h a n d l e s h o u l d d e f i n e t h e f o l l o w i n g m e t h o d s : T I E H A N D L E , a t l e a s t o n e o f P R I N T , P R I N T F , W R I T E , R E A D L I N E , G E T C , R E A D , a n d p o s s i b l y C L O S E , U N T I E a n d D E S T R O Y . T h e c l a s s c a n a l s o p r o v i d e : B I N M O D E , O P E N , E O F , F I L E N O , S E E K , T E L L - i f t h e c o r r e s p o n d i n g p e r l o p e r a t o r s a r e u s e d o n t h e h a n d l e .
W h e n S T D E R R i s t i e d , i t s P R I N T m e t h o d w i l l b e c a l l e d t o i s s u e w a r n i n g s a n d e r r o r m e s s a g e s . T h i s f e a t u r e i s t e m p o r a r i l y d i s a b l e d d u r i n g t h e c a l l , w h i c h m e a n s y o u c a n u s e w a r n ( )
i n s i d e P R I N T w i t h o u t s t a r t i n g a r e c u r s i v e l o o p . A n d j u s t l i k e _ _ W A R N _ _
a n d _ _ D I E
_ _
h a n d l e r s , S T D E R R ' s P R I N T m e t h o d m a y b e c a l l e d t o r e p o r t p a r s e r e r r o r s , s o t h e c a v e a t s m e n t i o n e d u n d e r " % S I G " i n p e r l v a r a p p l y .
A l l o f t h i s i s e s p e c i a l l y u s e f u l w h e n p e r l i s e m b e d d e d i n s o m e o t h e r p r o g r a m , w h e r e o u t p u t t o S T D O U T a n d S T D E R R m a y h a v e t o b e r e d i r e c t e d i n s o m e s p e c i a l w a y . S e e n v i a n d t h e A p a c h e m o d u l e f o r e x a m p l e s .
W h e n t y i n g a h a n d l e , t h e f i r s t a r g u m e n t t o t i e
s h o u l d b e g i n w i t h a n a s t e r i s k . S o , i f y o u a r e t y i n g S T D O U T , u s e * S T D O U T
. I f y o u h a v e a s s i g n e d i t t o a s c a l a r v a r i a b l e , s a y $ h a n d l e
, u s e * $ h a n d l e
. t i e $ h a n d l e
t i e s t h e s c a l a r v a r i a b l e $ h a n d l e
, n o t t h e h a n d l e i n s i d e i t .
I n o u r e x a m p l e w e ' r e g o i n g t o c r e a t e a s h o u t i n g h a n d l e .
package Shout;
# T I E H A N D L E c l a s s n a m e , L I S T
T h i s i s t h e c o n s t r u c t o r f o r t h e c l a s s . T h a t m e a n s i t i s e x p e c t e d t o r e t u r n a b l e s s e d r e f e r e n c e o f s o m e s o r t . T h e r e f e r e n c e c a n b e u s e d t o h o l d s o m e i n t e r n a l i n f o r m a t i o n .
sub TIEHANDLE { print "<shout>\n"; my $i; bless \$i, shift }
# W R I T E t h i s , L I S T
T h i s m e t h o d w i l l b e c a l l e d w h e n t h e h a n d l e i s w r i t t e n t o v i a t h e s y s w r i t e
f u n c t i o n .
sub WRITE {
$r = shift;
my($buf,$len,$offset) = @_;
print "WRITE called, \$buf=$buf, \$len=$len, \$offset=$offset";
}
# P R I N T t h i s , L I S T
T h i s m e t h o d w i l l b e t r i g g e r e d e v e r y t i m e t h e t i e d h a n d l e i s p r i n t e d t o w i t h t h e p r i n t ( )
or s a y ( )
f u n c t i o n s . B e y o n d i t s s e l f r e f e r e n c e i t a l s o e x p e c t s t h e l i s t t h a t w a s p a s s e d t o t h e p r i n t f u n c t i o n .
sub PRINT { $r = shift; $$r++; print join($,,map(uc($_),@_)),$\ }
s a y ( )
a c t s j u s t l i k e p r i n t ( )
e x c e p t $ \ w i l l b e l o c a l i z e d t o \ n
s o y o u n e e d d o n o t h i n g s p e c i a l t o h a n d l e s a y ( )
in P R I N T ( )
.
# P R I N T F t h i s , L I S T
T h i s m e t h o d w i l l b e t r i g g e r e d e v e r y t i m e t h e t i e d h a n d l e i s p r i n t e d t o w i t h t h e p r i n t f ( )
f u n c t i o n . B e y o n d i t s s e l f r e f e r e n c e i t a l s o e x p e c t s t h e f o r m a t a n d l i s t t h a t w a s p a s s e d t o t h e p r i n t f f u n c t i o n .
sub PRINTF {
shift;
my $fmt = shift;
print sprintf($fmt, @_);
}
# R E A D t h i s , L I S T
T h i s m e t h o d w i l l b e c a l l e d w h e n t h e h a n d l e i s r e a d f r o m v i a t h e r e a d
or s y s r e a d
f u n c t i o n s .
sub READ {
my $self = shift;
my $bufref = \$_[0];
my(undef,$len,$offset) = @_;
print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset";
# add to $$bufref, set $len to number of characters read
$len;
}
# R E A D L I N E t h i s
T h i s m e t h o d i s c a l l e d w h e n t h e h a n d l e i s r e a d v i a < H A N D L E >
or r e a
d l i n e H A N D L E
.
A s p e r r e a d l i n e
, i n s c a l a r c o n t e x t i t s h o u l d r e t u r n t h e n e x t l i n e , o r u n d e f
f o r n o m o r e d a t a . I n l i s t c o n t e x t i t s h o u l d r e t u r n a l l r e m a i n i n g l i n e s , o r a n e m p t y l i s t f o r n o m o r e d a t a . T h e s t r i n g s r e t u r n e d s h o u l d i n c l u d e t h e i n p u t r e c o r d s e p a r a t o r $ /
( s e e p e r l v a r ) , u n l e s s i t i s u n
d e f
( w h i c h m e a n s " s l u r p " m o d e ) .
sub READLINE {
my $r = shift;
if (wantarray) {
return ("all remaining\n",
"lines up\n",
"to eof\n");
} else {
return "READLINE called " . ++$$r . " times\n";
}
}
# G E T C t h i s
T h i s m e t h o d w i l l b e c a l l e d w h e n t h e g e t c
f u n c t i o n i s c a l l e d .
sub GETC { print "Don't GETC, Get Perl"; return "a"; }
# E O F t h i s
T h i s m e t h o d w i l l b e c a l l e d w h e n t h e e o f
f u n c t i o n i s c a l l e d .
S t a r t i n g w i t h P e r l 5 . 1 2 , a n a d d i t i o n a l i n t e g e r p a r a m e t e r w i l l b e p a s s e d . I t w i l l b e z e r o i f e
o f
i s c a l l e d w i t h o u t p a r a m e t e r ; 1
if e o f
i s g i v e n a f i l e h a n d l e a s a p a r a m e t e r , e . g . e o f ( FH )
; a n d 2
i n t h e v e r y s p e c i a l c a s e t h a t t h e t i e d f i l e h a n d l e i s A R G V
a n d e o f
i s c a l l e d w i t h a n e m p t y p a r a m e t e r l i s t , e . g . e o f ( )
.
sub EOF { not length $stringbuf }
# C L O S E t h i s
T h i s m e t h o d w i l l b e c a l l e d w h e n t h e h a n d l e i s c l o s e d v i a t h e c
l o s e
f u n c t i o n .
sub CLOSE { print "CLOSE called.\n" }
# U N T I E t h i s
A s w i t h t h e o t h e r t y p e s o f t i e s , t h i s m e t h o d w i l l b e c a l l e d w h e n u n t i e
h a p p e n s . I t m a y b e a p p r o p r i a t e t o " a u t o C L O S E " w h e n t h i s o c c u r s . S e e " T h e u n t i e
G o t c h a " b e l o w .
# D E S T R O Y t h i s
A s w i t h t h e o t h e r t y p e s o f t i e s , t h i s m e t h o d w i l l b e c a l l e d w h e n t h e t i e d h a n d l e i s a b o u t t o b e d e s t r o y e d . T h i s i s u s e f u l f o r d e b u g g i n g a n d p o s s i b l y c l e a n i n g u p .
sub DESTROY { print "</shout>\n" }
H e r e ' s h o w t o u s e o u r l i t t l e e x a m p l e :
tie(*FOO,'Shout');
print FOO "hello\n";
$x = 4; $y = 6;
print FOO $x, " plus ", $y, " equals ", $x + $y, "\n";
print <FOO>;
# U N T I E t h i s
Y o u c a n d e f i n e f o r a l l t i e t y p e s a n U N T I E m e t h o d t h a t w i l l b e c a l l e d a t u n t i e ( ) . S e e " T h e u n t i e
G o t c h a " b e l o w .
# T h e u n t i e
G o t c h a
I f y o u i n t e n d m a k i n g u s e o f t h e o b j e c t r e t u r n e d f r o m e i t h e r t i e ( ) o r t i e d ( ) , a n d i f t h e t i e ' s t a r g e t c l a s s d e f i n e s a d e s t r u c t o r , t h e r e i s a s u b t l e g o t c h a y o u m u s t g u a r d a g a i n s t .
A s s e t u p , c o n s i d e r t h i s ( a d m i t t e d l y r a t h e r c o n t r i v e d ) e x a m p l e o f a t i e ; a l l i t d o e s i s u s e a f i l e t o k e e p a l o g o f t h e v a l u e s a s s i g n e d t o a s c a l a r .
package Remember;
use v5.36;
use IO::File;
sub TIESCALAR {
my $class = shift;
my $filename = shift;
my $handle = IO::File->new( "> $filename" )
or die "Cannot open $filename: $!\n";
print $handle "The Start\n";
bless {FH => $handle, Value => 0}, $class;
}
sub FETCH {
my $self = shift;
return $self->{Value};
}
sub STORE {
my $self = shift;
my $value = shift;
my $handle = $self->{FH};
print $handle "$value\n";
$self->{Value} = $value;
}
sub DESTROY {
my $self = shift;
my $handle = $self->{FH};
print $handle "The End\n";
close $handle;
}
1;
H e r e i s a n e x a m p l e t h a t m a k e s u s e o f t h i s t i e :
use strict;
use Remember;
my $fred;
tie $fred, 'Remember', 'myfile.txt';
$fred = 1;
$fred = 4;
$fred = 5;
untie $fred;
system "cat myfile.txt";
T h i s i s t h e o u t p u t w h e n i t i s e x e c u t e d :
The Start
1
4
5
The End
S o f a r s o g o o d . T h o s e o f y o u w h o h a v e b e e n p a y i n g a t t e n t i o n w i l l h a v e s p o t t e d t h a t t h e t i e d o b j e c t h a s n ' t b e e n u s e d s o f a r . S o l e t s a d d a n e x t r a m e t h o d t o t h e R e m e m b e r c l a s s t o a l l o w c o m m e n t s t o b e i n c l u d e d i n t h e f i l e ; s a y , s o m e t h i n g l i k e t h i s :
sub comment {
my $self = shift;
my $text = shift;
my $handle = $self->{FH};
print $handle $text, "\n";
}
A n d h e r e i s t h e p r e v i o u s e x a m p l e m o d i f i e d t o u s e t h e c o m m e n t
m e t h o d ( w h i c h r e q u i r e s t h e t i e d o b j e c t ) :
use strict;
use Remember;
my ($fred, $x);
$x = tie $fred, 'Remember', 'myfile.txt';
$fred = 1;
$fred = 4;
comment $x "changing...";
$fred = 5;
untie $fred;
system "cat myfile.txt";
W h e n t h i s c o d e i s e x e c u t e d t h e r e i s n o o u t p u t . H e r e ' s w h y :
W h e n a v a r i a b l e i s t i e d , i t i s a s s o c i a t e d w i t h t h e o b j e c t w h i c h i s t h e r e t u r n v a l u e o f t h e T I E S C A L A R , T I E A R R A Y , o r T I E H A S H f u n c t i o n . T h i s o b j e c t n o r m a l l y h a s o n l y o n e r e f e r e n c e , n a m e l y , t h e i m p l i c i t r e f e r e n c e f r o m t h e t i e d v a r i a b l e . W h e n u n t i e ( ) i s c a l l e d , t h a t r e f e r e n c e i s d e s t r o y e d . T h e n , a s i n t h e f i r s t e x a m p l e a b o v e , t h e o b j e c t ' s d e s t r u c t o r ( D E S T R O Y ) i s c a l l e d , w h i c h i s n o r m a l f o r o b j e c t s t h a t h a v e n o m o r e v a l i d r e f e r e n c e s ; a n d t h u s t h e f i l e i s c l o s e d .
I n t h e s e c o n d e x a m p l e , h o w e v e r , w e h a v e s t o r e d a n o t h e r r e f e r e n c e t o t h e t i e d o b j e c t i n $ x . T h a t m e a n s t h a t w h e n u n t i e ( ) g e t s c a l l e d t h e r e w i l l s t i l l b e a v a l i d r e f e r e n c e t o t h e o b j e c t i n e x i s t e n c e , s o t h e d e s t r u c t o r i s n o t c a l l e d a t t h a t t i m e , a n d t h u s t h e f i l e i s n o t c l o s e d . T h e r e a s o n t h e r e i s n o o u t p u t i s b e c a u s e t h e f i l e b u f f e r s h a v e n o t b e e n f l u s h e d t o d i s k .
N o w t h a t y o u k n o w w h a t t h e p r o b l e m i s , w h a t c a n y o u d o t o a v o i d i t ? P r i o r t o t h e i n t r o d u c t i o n o f t h e o p t i o n a l U N T I E m e t h o d t h e o n l y w a y w a s t h e g o o d o l d - w
f l a g . W h i c h w i l l s p o t a n y i n s t a n c e s w h e r e y o u c a l l u n t i e ( ) a n d t h e r e a r e s t i l l v a l i d r e f e r e n c e s t o t h e t i e d o b j e c t . I f t h e s e c o n d s c r i p t a b o v e t h i s n e a r t h e t o p u s e
w a r n i n g s ' u n t i e '
o r w a s r u n w i t h t h e - w
f l a g , P e r l p r i n t s t h i s w a r n i n g m e s s a g e :
untie attempted while 1 inner references still exist
T o g e t t h e s c r i p t t o w o r k p r o p e r l y a n d s i l e n c e t h e w a r n i n g m a k e s u r e t h e r e a r e n o v a l i d r e f e r e n c e s t o t h e t i e d o b j e c t b e f o r e u n t i e ( ) i s c a l l e d :
undef $x;
untie $fred;
N o w t h a t U N T I E e x i s t s t h e c l a s s d e s i g n e r c a n d e c i d e w h i c h p a r t s o f t h e c l a s s f u n c t i o n a l i t y a r e r e a l l y a s s o c i a t e d w i t h u n t i e
a n d w h i c h w i t h t h e o b j e c t b e i n g d e s t r o y e d . W h a t m a k e s s e n s e f o r a g i v e n c l a s s d e p e n d s o n w h e t h e r t h e i n n e r r e f e r e n c e s a r e b e i n g k e p t s o t h a t n o n - t i e - r e l a t e d m e t h o d s c a n b e c a l l e d o n t h e o b j e c t . B u t i n m o s t c a s e s i t p r o b a b l y m a k e s s e n s e t o m o v e t h e f u n c t i o n a l i t y t h a t w o u l d h a v e b e e n i n D E S T R O Y t o t h e U N T I E m e t h o d .
I f t h e U N T I E m e t h o d e x i s t s t h e n t h e w a r n i n g a b o v e d o e s n o t o c c u r . I n s t e a d t h e U N T I E m e t h o d i s p a s s e d t h e c o u n t o f " e x t r a " r e f e r e n c e s a n d c a n i s s u e i t s o w n w a r n i n g i f a p p r o p r i a t e . e . g . t o r e p l i c a t e t h e n o U N T I E c a s e t h i s m e t h o d c a n b e u s e d :
sub UNTIE
{
my ($obj,$count) = @_;
carp "untie attempted while $count inner references still exist"
if $count;
}
# S E E A L S O
S e e D B _ F i l e or C o n f i g f o r s o m e i n t e r e s t i n g t i e ( ) i m p l e m e n t a t i o n s . A g o o d s t a r t i n g p o i n t f o r m a n y t i e ( ) i m p l e m e n t a t i o n s i s w i t h o n e o f t h e m o d u l e s T i e : : S c a l a r , T i e : : A r r a y , T i e : : H a s h , o r T i e : : H a n d l e .
# B U G S
T h e n o r m a l r e t u r n p r o v i d e d b y s c
a l a r ( % h a s h )
i s n o t a v a i l a b l e . W h a t t h i s m e a n s i s t h a t u s i n g % t i e d _ h a s h i n b o o l e a n c o n t e x t d o e s n ' t w o r k r i g h t ( c u r r e n t l y t h i s a l w a y s t e s t s f a l s e , r e g a r d l e s s o f w h e t h e r t h e h a s h i s e m p t y o r h a s h e l e m e n t s ) . [ T h i s p a r a g r a p h n e e d s r e v i e w i n l i g h t o f c h a n g e s i n 5 . 2 5 ]
L o c a l i z i n g t i e d a r r a y s o r h a s h e s d o e s n o t w o r k . A f t e r e x i t i n g t h e s c o p e t h e a r r a y s o r t h e h a s h e s a r e n o t r e s t o r e d .
C o u n t i n g t h e n u m b e r o f e n t r i e s i n a h a s h v i a s c a l a r ( k e y s ( % h a s h ) )
or s c a l a r ( v a l u e s ( % h a s h )
) i s i n e f f i c i e n t s i n c e i t n e e d s t o i t e r a t e t h r o u g h a l l t h e e n t r i e s w i t h F I R S T K E Y / N E X T K E Y .
T i e d h a s h / a r r a y s l i c e s c a u s e m u l t i p l e F E T C H / S T O R E p a i r s , t h e r e a r e n o t i e m e t h o d s f o r s l i c e o p e r a t i o n s .
Y o u c a n n o t e a s i l y t i e a m u l t i l e v e l d a t a s t r u c t u r e ( s u c h a s a h a s h o f h a s h e s ) t o a d b m f i l e . T h e f i r s t p r o b l e m i s t h a t a l l b u t G D B M a n d B e r k e l e y D B h a v e s i z e l i m i t a t i o n s , b u t b e y o n d t h a t , y o u a l s o h a v e p r o b l e m s w i t h h o w r e f e r e n c e s a r e t o b e r e p r e s e n t e d o n d i s k . O n e m o d u l e t h a t d o e s a t t e m p t t o a d d r e s s t h i s n e e d i s D B M : : D e e p . C h e c k y o u r n e a r e s t C P A N s i t e a s d e s c r i b e d i n p e r l m o d l i b f o r s o u r c e c o d e . N o t e t h a t d e s p i t e i t s n a m e , D B M : : D e e p d o e s n o t u s e d b m . A n o t h e r e a r l i e r a t t e m p t a t s o l v i n g t h e p r o b l e m i s M L D B M , w h i c h i s a l s o a v a i l a b l e o n t h e C P A N , b u t w h i c h h a s s o m e f a i r l y s e r i o u s l i m i t a t i o n s .
T i e d f i l e h a n d l e s a r e s t i l l i n c o m p l e t e . s y s o p e n ( ) , t r u n c a t e ( ) , f l o c k ( ) , f c n t l ( ) , s t a t ( ) a n d - X c a n ' t c u r r e n t l y b e t r a p p e d .
# A U T H O R
T o m C h r i s t i a n s e n
T I E H A N D L E b y S v e n V e r d o o l a e g e < s k i m o @ d n s . u f s i a . a c . b e > a n d D o u g M a c E a c h e r n < d o u g m @ o s f . o r g >
U N T I E b y N i c k I n g - S i m m o n s < n i c k @ i n g - s i m m o n s . n e t >
S C A L A R b y T a s s i l o v o n P a r s e v a l < t a s s i l o . v o n . p a r s e v a l @ r w t h - a a c h e n . d e >
T y i n g A r r a y s b y C a s e y W e s t < c a s e y @ g e e k n e s t . c o m >
P e r l d o c B r o w s e r i s m a i n t a i n e d b y D a n B o o k ( D B O O K ) . P l e a s e c o n t a c t h i m v i a t h e G i t H u b i s s u e t r a c k e r or e m a i l r e g a r d i n g a n y i s s u e s w i t h t h e s i t e i t s e l f , s e a r c h , o r r e n d e r i n g o f d o c u m e n t a t i o n .
T h e P e r l d o c u m e n t a t i o n i s m a i n t a i n e d b y t h e P e r l 5 P o r t e r s i n t h e d e v e l o p m e n t o f P e r l . P l e a s e c o n t a c t t h e m v i a t h e P e r l i s s u e t r a c k e r , t h e m a i l i n g l i s t , o r I R C t o r e p o r t a n y i s s u e s w i t h t h e c o n t e n t s o r f o r m a t o f t h e d o c u m e n t a t i o n .