comparison lib/ObjectProperty.pm @ 0:4816e4a8ae95 draft default tip

Uploaded
author deepakjadmin
date Wed, 20 Jan 2016 09:23:18 -0500
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:4816e4a8ae95
1 package ObjectProperty;
2 #
3 # $RCSfile: ObjectProperty.pm,v $
4 # $Date: 2015/02/28 20:47:18 $
5 # $Revision: 1.25 $
6 #
7 # Author: Manish Sud <msud@san.rr.com>
8 #
9 # Copyright (C) 2015 Manish Sud. All rights reserved.
10 #
11 # This file is part of MayaChemTools.
12 #
13 # MayaChemTools is free software; you can redistribute it and/or modify it under
14 # the terms of the GNU Lesser General Public License as published by the Free
15 # Software Foundation; either version 3 of the License, or (at your option) any
16 # later version.
17 #
18 # MayaChemTools is distributed in the hope that it will be useful, but without
19 # any warranty; without even the implied warranty of merchantability of fitness
20 # for a particular purpose. See the GNU Lesser General Public License for more
21 # details.
22 #
23 # You should have received a copy of the GNU Lesser General Public License
24 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or
25 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,
26 # Boston, MA, 02111-1307, USA.
27 #
28
29 use strict;
30 use Carp;
31
32 use vars qw($AUTOLOAD);
33
34 # Set property for an object...
35 sub SetProperty {
36 my($This, $Name, $Value) = @_;
37
38 if (!(defined($Name) && defined($Value))) {
39 return undef;
40 }
41 return $This->_SetProperty($Name, $Value);
42 }
43
44 # Set properties for an object...
45 sub SetProperties {
46 my($This, %NamesAndValues) = @_;
47 my($Name, $Value);
48
49 while (($Name, $Value) = each %NamesAndValues) {
50 $This->_SetProperty($Name, $Value);
51 }
52
53 return $This;
54 }
55
56 # Set object property...
57 sub _SetProperty {
58 my($This, $Name, $Value) = @_;
59
60 $This->{$Name} = $Value;
61 }
62
63 # Get property for an object...
64 sub GetProperty {
65 my($This, $Name) = @_;
66
67 if (!defined $Name) {
68 return undef;
69 }
70 return $This->_GetProperty($Name);
71 }
72
73 # Get object property...
74 sub _GetProperty {
75 my($This, $Name) = @_;
76
77 if (exists $This->{$Name}) {
78 return $This->{$Name};
79 }
80 else {
81 return undef;
82 }
83 }
84
85 # Does this property exist?
86 sub HasProperty {
87 my($This, $Name) = @_;
88
89 if (!defined $Name) {
90 return 0;
91 }
92 return (exists $This->{$Name}) ? 1 : 0;
93 }
94
95 # Delete object property...
96 sub DeleteProperty {
97 my($This, $Name) = @_;
98
99 if (!defined $Name) {
100 return undef;
101 }
102 return $This->_DeleteProperty($Name);
103 }
104
105 # Delete object property...
106 sub _DeleteProperty {
107 my($This, $Name) = @_;
108
109 if (exists $This->{$Name}) {
110 delete $This->{$Name};
111 }
112 return $This;
113 }
114
115 # Implements Set<PropertyName> and Get<PropertyName> methods...
116 sub AUTOLOAD {
117 my($This, $PropertyValue) = @_;
118 my($PackageName, $MethodName, $PropertyName, $ThisType);
119
120 # Do a greedy match to make sure package name and method names are
121 # picked up correctly from invocation names containing multiple occurences
122 # of ::. For example: FileIO::SDFileIO::GetFileHandle and so on.
123 #
124 ($PackageName, $MethodName) = $AUTOLOAD =~ /^(.*)::(.*)$/;
125
126 if ($MethodName =~ /^(BEGIN|DESTROY)$/) {
127 return;
128 }
129
130 $ThisType = ref($This) or croak "Error: Invocation of function ${PackageName}::${MethodName} invocation is not supported: It must be invoked using an object reference...";
131
132 if (!($MethodName =~ /^Get/ || $MethodName =~ /^Set/ || $MethodName =~ /^Delete/)) {
133 croak "Error: Can't locate object method \"$MethodName\" via package \"$ThisType\": This method is not automatically implemented by AUTOLOAD: Only Get<PropertyName>, Set<PropertyName> and Delete<PropertyName> functions are implemented via AUTOLOAD...";
134 }
135 if ($MethodName =~ /^Delete/) {
136 ($PropertyName) = $MethodName =~ /^Delete(.*?)$/;
137 }
138 else {
139 ($PropertyName) = $MethodName =~ /^[SG]et(.*?)$/;
140 }
141 if ($MethodName =~ /^Set/ && !defined($PropertyValue)) {
142 carp "Warning: ${PackageName}::${MethodName}: Didn't set value for property $PropertyName: Property value for must be specified...\n";
143 return undef;
144 }
145
146 if ($MethodName =~ /^Get/) {
147 return $This->_GetProperty($PropertyName);
148 }
149 elsif ($MethodName =~ /^Set/) {
150 return $This->_SetProperty($PropertyName, $PropertyValue);
151 }
152 elsif ($MethodName =~ /^Delete/) {
153 return $This->_DeleteProperty($PropertyName);
154 }
155
156 }
157
158 1;
159
160 __END__
161
162 =head1 NAME
163
164 ObjectProperty
165
166 =head1 SYNOPSIS
167
168 use ObjectProperty;
169
170 =head1 DESCRIPTION
171
172 B<ObjectProperty> is an abstract base class which implements methods not explicitly defined
173 in classed derived from this class using Perl's AUTOLOAD functionality. These methods are generated
174 on-the-fly for a specified object property:
175
176 Set<PropertyName>(<PropertyValue>);
177 $PropertyValue = Get<PropertyName>();
178 Delete<PropertyName>();
179
180 This class uses its parent class hash to set, get, and delete propery names and values.
181
182 ObjectProperty module provides the following methods to be used in context of its parent class:
183
184 DeleteProperty, GetProperty, HasProperty, SetProperties, SetProperty
185
186 =head2 METHODS
187
188 =over 4
189
190 =item B<DeleteProperty>
191
192 DeleteProperty($Name);
193
194 Deletes specified property I<Name>
195
196 =item B<GetProperty>
197
198 GetProperty($Name);
199
200 Returns value associated with specified property I<Name>.
201
202 =item B<HasProperty>
203
204 HasProperty($Name);
205
206 Returns 1 or 0 based on whether specified property I<Name> associated with an object.
207
208 =item B<SetProperties>
209
210 SetProperties(%NamesAndValues);
211
212 Using specified property name and value hash I<NamesAndValues>, associates each
213 property I<Name> and I<Values> to an object.
214
215 =item B<SetProperty>
216
217 SetProperty($Name, $Value);
218
219 Associate property I<Name> and I<Value> to an object.
220
221 =back
222
223 =head1 AUTHOR
224
225 Manish Sud <msud@san.rr.com>
226
227 =head1 COPYRIGHT
228
229 Copyright (C) 2015 Manish Sud. All rights reserved.
230
231 This file is part of MayaChemTools.
232
233 MayaChemTools is free software; you can redistribute it and/or modify it under
234 the terms of the GNU Lesser General Public License as published by the Free
235 Software Foundation; either version 3 of the License, or (at your option)
236 any later version.
237
238 =cut