line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Class::PublicPrivate;
|
2
|
1
|
|
|
1
|
|
2369
|
use strict;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
159
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
# version
|
5
|
|
|
|
|
|
|
our $VERSION = '0.81';
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 NAME
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
Class::PublicPrivate - Class with public keys with any name and a separate set
|
10
|
|
|
|
|
|
|
of private keys
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
PublicPrivate is intended for use as a base class for other classes. Users of
|
15
|
|
|
|
|
|
|
class based on PublicPrivate can assign any keys to the object hash without
|
16
|
|
|
|
|
|
|
interfering with keys used internally. The private data can be accessed by
|
17
|
|
|
|
|
|
|
retrieving the private hash with the C method. For example, the
|
18
|
|
|
|
|
|
|
following code outputs two different values, one for the public value of
|
19
|
|
|
|
|
|
|
C and another for the private value of C.
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
package ExtendedClass;
|
22
|
|
|
|
|
|
|
use base 'Class::PublicPrivate';
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub new{
|
25
|
|
|
|
|
|
|
my $class = shift;
|
26
|
|
|
|
|
|
|
my $self = $class->SUPER::new();
|
27
|
|
|
|
|
|
|
my $private = $self->private;
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# initialize one of the private properties
|
30
|
|
|
|
|
|
|
$private->{'start'}=time();
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
return $self;
|
33
|
|
|
|
|
|
|
}
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
package main;
|
36
|
|
|
|
|
|
|
my ($var);
|
37
|
|
|
|
|
|
|
$var = ExtendedClass->new();
|
38
|
|
|
|
|
|
|
$var->{'start'} = 1;
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
print $var->{'start'}, "\n";
|
41
|
|
|
|
|
|
|
print $var->private()->{'start'}, "\n";
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 INSTALLATION
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Class::PublicPrivate can be installed with the usual routine:
|
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
perl Makefile.PL
|
48
|
|
|
|
|
|
|
make
|
49
|
|
|
|
|
|
|
make test
|
50
|
|
|
|
|
|
|
make install
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
You can also just copy PublicPrivate.pm into the Class/ directory of one of
|
53
|
|
|
|
|
|
|
your library trees.
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 METHODS
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=head2 YourClass->new(classname ,[initikey1=>initvalue [, ...]])
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Returns an instantiation of YourClass, where YourClass is a class that extends
|
61
|
|
|
|
|
|
|
Class::PublicPrivate. Additional key=>value pairs are stored in the private
|
62
|
|
|
|
|
|
|
hash. Programs that use your class can store any date directly in it w/o
|
63
|
|
|
|
|
|
|
affecting the object's private data.
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 $ob->private()
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Returns a reference to the hash of private data.
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 TERMS AND CONDITIONS
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
Copyright (c) 2000 by Miko O'Sullivan. All rights reserved. This program
|
72
|
|
|
|
|
|
|
is free software; you can redistribute it and/or modify it under the same
|
73
|
|
|
|
|
|
|
terms as Perl itself. This software comes with B of any kind.
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head1 AUTHOR
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Miko O'Sullivan
|
78
|
|
|
|
|
|
|
F
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=cut
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
#---------------------------------------------------------------------------------------------------------
|
84
|
|
|
|
|
|
|
# new
|
85
|
|
|
|
|
|
|
#
|
86
|
|
|
|
|
|
|
sub new {
|
87
|
1
|
|
|
1
|
1
|
21
|
my $class = shift;
|
88
|
1
|
|
|
|
|
2
|
my (%nv, $self);
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# reference nv in hash
|
91
|
1
|
|
|
|
|
6
|
tie %nv, 'Class::PublicPrivate::Tie', @_;
|
92
|
1
|
|
|
|
|
2
|
$self = bless(\%nv, $class);
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# return
|
95
|
1
|
|
|
|
|
3
|
return $self;
|
96
|
|
|
|
|
|
|
}
|
97
|
|
|
|
|
|
|
#
|
98
|
|
|
|
|
|
|
# new
|
99
|
|
|
|
|
|
|
#---------------------------------------------------------------------------------------------------------
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
#---------------------------------------------------------------------------------------------------------
|
103
|
|
|
|
|
|
|
# private
|
104
|
|
|
|
|
|
|
# returns the private hash
|
105
|
|
|
|
|
|
|
#
|
106
|
|
|
|
|
|
|
sub private {
|
107
|
2
|
|
|
2
|
1
|
147
|
return (tied(%{$_[0]}))->{'private'};
|
|
2
|
|
|
|
|
7
|
|
108
|
|
|
|
|
|
|
}
|
109
|
|
|
|
|
|
|
#
|
110
|
|
|
|
|
|
|
# private
|
111
|
|
|
|
|
|
|
#---------------------------------------------------------------------------------------------------------
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
######################################################################
|
116
|
|
|
|
|
|
|
# DsHash package
|
117
|
|
|
|
|
|
|
#
|
118
|
|
|
|
|
|
|
package Class::PublicPrivate::Tie;
|
119
|
1
|
|
|
1
|
|
5
|
use strict;
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
321
|
|
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub TIEHASH {
|
122
|
1
|
|
|
1
|
|
2
|
my ($class, %opts) = @_;
|
123
|
1
|
|
|
|
|
3
|
my $self = bless({}, $class);
|
124
|
|
|
|
|
|
|
|
125
|
1
|
|
50
|
|
|
27
|
$self->{'private'} = $opts{'private'} || {};
|
126
|
1
|
|
50
|
|
|
7
|
$self->{'public'} = $opts{'public'} || {};
|
127
|
|
|
|
|
|
|
|
128
|
1
|
|
|
|
|
4
|
return $self;
|
129
|
|
|
|
|
|
|
}
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
sub STORE {
|
132
|
1
|
|
|
1
|
|
36
|
$_[0]->{'public'}->{$_[1]} = $_[2];
|
133
|
|
|
|
|
|
|
}
|
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub FETCH {
|
136
|
0
|
|
|
0
|
|
0
|
return $_[0]->{'public'}->{$_[1]};
|
137
|
|
|
|
|
|
|
}
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub DELETE {
|
140
|
0
|
|
|
0
|
|
0
|
delete $_[0]->{'public'}->{$_[1]};
|
141
|
|
|
|
|
|
|
}
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub CLEAR {
|
144
|
0
|
|
|
0
|
|
0
|
$_[0]->{'public'} = {};
|
145
|
|
|
|
|
|
|
}
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub EXISTS {
|
148
|
0
|
|
|
0
|
|
0
|
exists $_[0]->{'public'}->{$_[1]};
|
149
|
|
|
|
|
|
|
}
|
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub FIRSTKEY {
|
152
|
1
|
|
|
1
|
|
7
|
my $self = shift;
|
153
|
1
|
|
|
|
|
2
|
my $a = keys(%{$self->{'public'}});
|
|
1
|
|
|
|
|
2
|
|
154
|
1
|
|
|
|
|
4
|
return $self->NEXTKEY;
|
155
|
|
|
|
|
|
|
}
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub NEXTKEY {
|
158
|
2
|
|
|
2
|
|
2
|
my $self = shift;
|
159
|
2
|
|
|
|
|
3
|
my $v = (each %{$self->{'public'}})[0];
|
|
2
|
|
|
|
|
5
|
|
160
|
2
|
|
|
|
|
6
|
return $v;
|
161
|
|
|
|
|
|
|
}
|
162
|
|
|
|
|
|
|
#
|
163
|
|
|
|
|
|
|
# DsHash package
|
164
|
|
|
|
|
|
|
######################################################################
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# return
|
169
|
|
|
|
|
|
|
1;
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head1 VERSIONS
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=over
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=item Version 0.80, June 29, 2002
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
First public release
|
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=item Version 0.81 May 18, 2014
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Minor tightening up of code. Fixed problems in packaging for CPAN.
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=back
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=cut |