| 0 | 1 <html> | 
|  | 2 <head> | 
|  | 3 <title>MayaChemTools:Code:ObjectProperty.pm</title> | 
|  | 4 <meta http-equiv="content-type" content="text/html;charset=utf-8"> | 
|  | 5 <link rel="stylesheet" type="text/css" href="../../../css/MayaChemToolsCode.css"> | 
|  | 6 </head> | 
|  | 7 <body leftmargin="20" rightmargin="20" topmargin="10" bottommargin="10"> | 
|  | 8 <br/> | 
|  | 9 <center> | 
|  | 10 <a href="http://www.mayachemtools.org" title="MayaChemTools Home"><img src="../../../images/MayaChemToolsLogo.gif" border="0" alt="MayaChemTools"></a> | 
|  | 11 </center> | 
|  | 12 <br/> | 
|  | 13 <pre> | 
|  | 14 <a name="package-ObjectProperty-"></a>   1 <span class="k">package </span><span class="i">ObjectProperty</span><span class="sc">;</span> | 
|  | 15    2 <span class="c">#</span> | 
|  | 16    3 <span class="c"># $RCSfile: ObjectProperty.pm,v $</span> | 
|  | 17    4 <span class="c"># $Date: 2015/02/28 20:47:18 $</span> | 
|  | 18    5 <span class="c"># $Revision: 1.25 $</span> | 
|  | 19    6 <span class="c">#</span> | 
|  | 20    7 <span class="c"># Author: Manish Sud <msud@san.rr.com></span> | 
|  | 21    8 <span class="c">#</span> | 
|  | 22    9 <span class="c"># Copyright (C) 2015 Manish Sud. All rights reserved.</span> | 
|  | 23   10 <span class="c">#</span> | 
|  | 24   11 <span class="c"># This file is part of MayaChemTools.</span> | 
|  | 25   12 <span class="c">#</span> | 
|  | 26   13 <span class="c"># MayaChemTools is free software; you can redistribute it and/or modify it under</span> | 
|  | 27   14 <span class="c"># the terms of the GNU Lesser General Public License as published by the Free</span> | 
|  | 28   15 <span class="c"># Software Foundation; either version 3 of the License, or (at your option) any</span> | 
|  | 29   16 <span class="c"># later version.</span> | 
|  | 30   17 <span class="c">#</span> | 
|  | 31   18 <span class="c"># MayaChemTools is distributed in the hope that it will be useful, but without</span> | 
|  | 32   19 <span class="c"># any warranty; without even the implied warranty of merchantability of fitness</span> | 
|  | 33   20 <span class="c"># for a particular purpose.  See the GNU Lesser General Public License for more</span> | 
|  | 34   21 <span class="c"># details.</span> | 
|  | 35   22 <span class="c">#</span> | 
|  | 36   23 <span class="c"># You should have received a copy of the GNU Lesser General Public License</span> | 
|  | 37   24 <span class="c"># along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or</span> | 
|  | 38   25 <span class="c"># write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,</span> | 
|  | 39   26 <span class="c"># Boston, MA, 02111-1307, USA.</span> | 
|  | 40   27 <span class="c">#</span> | 
|  | 41   28 | 
|  | 42   29 <span class="k">use</span> <span class="w">strict</span><span class="sc">;</span> | 
|  | 43   30 <span class="k">use</span> <span class="w">Carp</span><span class="sc">;</span> | 
|  | 44   31 | 
|  | 45   32 <span class="k">use</span> <span class="w">vars</span> <span class="q">qw($AUTOLOAD)</span><span class="sc">;</span> | 
|  | 46   33 | 
|  | 47   34 <span class="c"># Set property for an object...</span> | 
|  | 48 <a name="SetProperty-"></a>  35 <span class="k">sub </span><span class="m">SetProperty</span> <span class="s">{</span> | 
|  | 49   36   <span class="k">my</span><span class="s">(</span><span class="i">$This</span><span class="cm">,</span> <span class="i">$Name</span><span class="cm">,</span> <span class="i">$Value</span><span class="s">)</span> = <span class="i">@_</span><span class="sc">;</span> | 
|  | 50   37 | 
|  | 51   38   <span class="k">if</span> <span class="s">(</span>!<span class="s">(</span><span class="k">defined</span><span class="s">(</span><span class="i">$Name</span><span class="s">)</span> && <span class="k">defined</span><span class="s">(</span><span class="i">$Value</span><span class="s">)</span><span class="s">)</span><span class="s">)</span> <span class="s">{</span> | 
|  | 52   39     <span class="k">return</span> <span class="k">undef</span><span class="sc">;</span> | 
|  | 53   40   <span class="s">}</span> | 
|  | 54   41   <span class="k">return</span> <span class="i">$This</span><span class="i">->_SetProperty</span><span class="s">(</span><span class="i">$Name</span><span class="cm">,</span> <span class="i">$Value</span><span class="s">)</span><span class="sc">;</span> | 
|  | 55   42 <span class="s">}</span> | 
|  | 56   43 | 
|  | 57   44 <span class="c"># Set properties for an object...</span> | 
|  | 58 <a name="SetProperties-"></a>  45 <span class="k">sub </span><span class="m">SetProperties</span> <span class="s">{</span> | 
|  | 59   46   <span class="k">my</span><span class="s">(</span><span class="i">$This</span><span class="cm">,</span> <span class="i">%NamesAndValues</span><span class="s">)</span> = <span class="i">@_</span><span class="sc">;</span> | 
|  | 60   47   <span class="k">my</span><span class="s">(</span><span class="i">$Name</span><span class="cm">,</span> <span class="i">$Value</span><span class="s">)</span><span class="sc">;</span> | 
|  | 61   48 | 
|  | 62   49   <span class="k">while</span> <span class="s">(</span><span class="s">(</span><span class="i">$Name</span><span class="cm">,</span> <span class="i">$Value</span><span class="s">)</span> = <span class="k">each</span>  <span class="i">%NamesAndValues</span><span class="s">)</span> <span class="s">{</span> | 
|  | 63   50     <span class="i">$This</span><span class="i">->_SetProperty</span><span class="s">(</span><span class="i">$Name</span><span class="cm">,</span> <span class="i">$Value</span><span class="s">)</span><span class="sc">;</span> | 
|  | 64   51   <span class="s">}</span> | 
|  | 65   52 | 
|  | 66   53   <span class="k">return</span> <span class="i">$This</span><span class="sc">;</span> | 
|  | 67   54 <span class="s">}</span> | 
|  | 68   55 | 
|  | 69   56 <span class="c"># Set object property...</span> | 
|  | 70 <a name="_SetProperty-"></a>  57 <span class="k">sub </span><span class="m">_SetProperty</span> <span class="s">{</span> | 
|  | 71   58   <span class="k">my</span><span class="s">(</span><span class="i">$This</span><span class="cm">,</span> <span class="i">$Name</span><span class="cm">,</span> <span class="i">$Value</span><span class="s">)</span> = <span class="i">@_</span><span class="sc">;</span> | 
|  | 72   59 | 
|  | 73   60   <span class="i">$This</span>->{<span class="i">$Name</span>} = <span class="i">$Value</span><span class="sc">;</span> | 
|  | 74   61 <span class="s">}</span> | 
|  | 75   62 | 
|  | 76   63 <span class="c"># Get property for an object...</span> | 
|  | 77 <a name="GetProperty-"></a>  64 <span class="k">sub </span><span class="m">GetProperty</span> <span class="s">{</span> | 
|  | 78   65   <span class="k">my</span><span class="s">(</span><span class="i">$This</span><span class="cm">,</span> <span class="i">$Name</span><span class="s">)</span> = <span class="i">@_</span><span class="sc">;</span> | 
|  | 79   66 | 
|  | 80   67   <span class="k">if</span> <span class="s">(</span>!<span class="k">defined</span> <span class="i">$Name</span><span class="s">)</span> <span class="s">{</span> | 
|  | 81   68     <span class="k">return</span> <span class="k">undef</span><span class="sc">;</span> | 
|  | 82   69   <span class="s">}</span> | 
|  | 83   70   <span class="k">return</span> <span class="i">$This</span><span class="i">->_GetProperty</span><span class="s">(</span><span class="i">$Name</span><span class="s">)</span><span class="sc">;</span> | 
|  | 84   71 <span class="s">}</span> | 
|  | 85   72 | 
|  | 86   73 <span class="c"># Get object property...</span> | 
|  | 87 <a name="_GetProperty-"></a>  74 <span class="k">sub </span><span class="m">_GetProperty</span> <span class="s">{</span> | 
|  | 88   75   <span class="k">my</span><span class="s">(</span><span class="i">$This</span><span class="cm">,</span> <span class="i">$Name</span><span class="s">)</span> = <span class="i">@_</span><span class="sc">;</span> | 
|  | 89   76 | 
|  | 90   77   <span class="k">if</span> <span class="s">(</span><span class="k">exists</span> <span class="i">$This</span>->{<span class="i">$Name</span>}<span class="s">)</span> <span class="s">{</span> | 
|  | 91   78     <span class="k">return</span> <span class="i">$This</span>->{<span class="i">$Name</span>}<span class="sc">;</span> | 
|  | 92   79   <span class="s">}</span> | 
|  | 93   80   <span class="k">else</span> <span class="s">{</span> | 
|  | 94   81     <span class="k">return</span> <span class="k">undef</span><span class="sc">;</span> | 
|  | 95   82   <span class="s">}</span> | 
|  | 96   83 <span class="s">}</span> | 
|  | 97   84 | 
|  | 98   85 <span class="c"># Does this property exist?</span> | 
|  | 99 <a name="HasProperty-"></a>  86 <span class="k">sub </span><span class="m">HasProperty</span> <span class="s">{</span> | 
|  | 100   87   <span class="k">my</span><span class="s">(</span><span class="i">$This</span><span class="cm">,</span> <span class="i">$Name</span><span class="s">)</span> = <span class="i">@_</span><span class="sc">;</span> | 
|  | 101   88 | 
|  | 102   89   <span class="k">if</span> <span class="s">(</span>!<span class="k">defined</span> <span class="i">$Name</span><span class="s">)</span> <span class="s">{</span> | 
|  | 103   90     <span class="k">return</span> <span class="n">0</span><span class="sc">;</span> | 
|  | 104   91   <span class="s">}</span> | 
|  | 105   92   <span class="k">return</span> <span class="s">(</span><span class="k">exists</span> <span class="i">$This</span>->{<span class="i">$Name</span>}<span class="s">)</span> ? <span class="n">1</span> <span class="co">:</span> <span class="n">0</span><span class="sc">;</span> | 
|  | 106   93 <span class="s">}</span> | 
|  | 107   94 | 
|  | 108   95 <span class="c"># Delete object property...</span> | 
|  | 109 <a name="DeleteProperty-"></a>  96 <span class="k">sub </span><span class="m">DeleteProperty</span> <span class="s">{</span> | 
|  | 110   97   <span class="k">my</span><span class="s">(</span><span class="i">$This</span><span class="cm">,</span> <span class="i">$Name</span><span class="s">)</span> = <span class="i">@_</span><span class="sc">;</span> | 
|  | 111   98 | 
|  | 112   99   <span class="k">if</span> <span class="s">(</span>!<span class="k">defined</span> <span class="i">$Name</span><span class="s">)</span> <span class="s">{</span> | 
|  | 113  100     <span class="k">return</span> <span class="k">undef</span><span class="sc">;</span> | 
|  | 114  101   <span class="s">}</span> | 
|  | 115  102   <span class="k">return</span> <span class="i">$This</span><span class="i">->_DeleteProperty</span><span class="s">(</span><span class="i">$Name</span><span class="s">)</span><span class="sc">;</span> | 
|  | 116  103 <span class="s">}</span> | 
|  | 117  104 | 
|  | 118  105 <span class="c"># Delete object property...</span> | 
|  | 119 <a name="_DeleteProperty-"></a> 106 <span class="k">sub </span><span class="m">_DeleteProperty</span> <span class="s">{</span> | 
|  | 120  107   <span class="k">my</span><span class="s">(</span><span class="i">$This</span><span class="cm">,</span> <span class="i">$Name</span><span class="s">)</span> = <span class="i">@_</span><span class="sc">;</span> | 
|  | 121  108 | 
|  | 122  109   <span class="k">if</span> <span class="s">(</span><span class="k">exists</span> <span class="i">$This</span>->{<span class="i">$Name</span>}<span class="s">)</span> <span class="s">{</span> | 
|  | 123  110     <span class="k">delete</span> <span class="i">$This</span>->{<span class="i">$Name</span>}<span class="sc">;</span> | 
|  | 124  111   <span class="s">}</span> | 
|  | 125  112   <span class="k">return</span> <span class="i">$This</span><span class="sc">;</span> | 
|  | 126  113 <span class="s">}</span> | 
|  | 127  114 | 
|  | 128  115 <span class="c"># Implements Set<PropertyName> and Get<PropertyName> methods...</span> | 
|  | 129 <a name="AUTOLOAD-"></a> 116 <span class="k">sub </span><span class="m">AUTOLOAD</span> <span class="s">{</span> | 
|  | 130  117   <span class="k">my</span><span class="s">(</span><span class="i">$This</span><span class="cm">,</span> <span class="i">$PropertyValue</span><span class="s">)</span> = <span class="i">@_</span><span class="sc">;</span> | 
|  | 131  118   <span class="k">my</span><span class="s">(</span><span class="i">$PackageName</span><span class="cm">,</span> <span class="i">$MethodName</span><span class="cm">,</span> <span class="i">$PropertyName</span><span class="cm">,</span> <span class="i">$ThisType</span><span class="s">)</span><span class="sc">;</span> | 
|  | 132  119 | 
|  | 133  120   <span class="c"># Do a greedy match to make sure package name and method names are</span> | 
|  | 134  121   <span class="c"># picked up correctly from invocation names containing multiple occurences</span> | 
|  | 135  122   <span class="c"># of ::. For example: FileIO::SDFileIO::GetFileHandle and so on.</span> | 
|  | 136  123   <span class="c">#</span> | 
|  | 137  124   <span class="s">(</span><span class="i">$PackageName</span><span class="cm">,</span> <span class="i">$MethodName</span><span class="s">)</span> = <span class="i">$AUTOLOAD</span> =~ <span class="q">/^(.*)::(.*)$/</span><span class="sc">;</span> | 
|  | 138  125 | 
|  | 139  126   <span class="k">if</span> <span class="s">(</span><span class="i">$MethodName</span> =~ <span class="q">/^(BEGIN|DESTROY)$/</span><span class="s">)</span> <span class="s">{</span> | 
|  | 140  127     <span class="k">return</span><span class="sc">;</span> | 
|  | 141  128   <span class="s">}</span> | 
|  | 142  129 | 
|  | 143  130   <span class="i">$ThisType</span> = <span class="k">ref</span><span class="s">(</span><span class="i">$This</span><span class="s">)</span> <span class="k">or</span> <span class="w">croak</span> <span class="q">"Error: Invocation of function ${PackageName}::${MethodName} invocation is not supported: It must be invoked using an object reference..."</span><span class="sc">;</span> | 
|  | 144  131 | 
|  | 145  132   <span class="k">if</span> <span class="s">(</span>!<span class="s">(</span><span class="i">$MethodName</span> =~ <span class="q">/^Get/</span> || <span class="i">$MethodName</span> =~ <span class="q">/^Set/</span> || <span class="i">$MethodName</span> =~ <span class="q">/^Delete/</span><span class="s">)</span><span class="s">)</span> <span class="s">{</span> | 
|  | 146  133     <span class="w">croak</span> <span class="q">"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..."</span><span class="sc">;</span> | 
|  | 147  134   <span class="s">}</span> | 
|  | 148  135   <span class="k">if</span> <span class="s">(</span><span class="i">$MethodName</span> =~ <span class="q">/^Delete/</span><span class="s">)</span> <span class="s">{</span> | 
|  | 149  136     <span class="s">(</span><span class="i">$PropertyName</span><span class="s">)</span> = <span class="i">$MethodName</span> =~ <span class="q">/^Delete(.*?)$/</span><span class="sc">;</span> | 
|  | 150  137   <span class="s">}</span> | 
|  | 151  138   <span class="k">else</span> <span class="s">{</span> | 
|  | 152  139     <span class="s">(</span><span class="i">$PropertyName</span><span class="s">)</span> = <span class="i">$MethodName</span> =~ <span class="q">/^[SG]et(.*?)$/</span><span class="sc">;</span> | 
|  | 153  140   <span class="s">}</span> | 
|  | 154  141   <span class="k">if</span> <span class="s">(</span><span class="i">$MethodName</span> =~ <span class="q">/^Set/</span> && !<span class="k">defined</span><span class="s">(</span><span class="i">$PropertyValue</span><span class="s">)</span><span class="s">)</span> <span class="s">{</span> | 
|  | 155  142     <span class="w">carp</span> <span class="q">"Warning:  ${PackageName}::${MethodName}: Didn't set value for property $PropertyName: Property value for must be specified...\n"</span><span class="sc">;</span> | 
|  | 156  143     <span class="k">return</span> <span class="k">undef</span><span class="sc">;</span> | 
|  | 157  144   <span class="s">}</span> | 
|  | 158  145 | 
|  | 159  146   <span class="k">if</span> <span class="s">(</span><span class="i">$MethodName</span> =~ <span class="q">/^Get/</span><span class="s">)</span> <span class="s">{</span> | 
|  | 160  147     <span class="k">return</span> <span class="i">$This</span><span class="i">->_GetProperty</span><span class="s">(</span><span class="i">$PropertyName</span><span class="s">)</span><span class="sc">;</span> | 
|  | 161  148   <span class="s">}</span> | 
|  | 162  149   <span class="k">elsif</span> <span class="s">(</span><span class="i">$MethodName</span> =~ <span class="q">/^Set/</span><span class="s">)</span> <span class="s">{</span> | 
|  | 163  150     <span class="k">return</span> <span class="i">$This</span><span class="i">->_SetProperty</span><span class="s">(</span><span class="i">$PropertyName</span><span class="cm">,</span> <span class="i">$PropertyValue</span><span class="s">)</span><span class="sc">;</span> | 
|  | 164  151   <span class="s">}</span> | 
|  | 165  152   <span class="k">elsif</span> <span class="s">(</span><span class="i">$MethodName</span> =~ <span class="q">/^Delete/</span><span class="s">)</span> <span class="s">{</span> | 
|  | 166  153     <span class="k">return</span> <span class="i">$This</span><span class="i">->_DeleteProperty</span><span class="s">(</span><span class="i">$PropertyName</span><span class="s">)</span><span class="sc">;</span> | 
|  | 167  154   <span class="s">}</span> | 
|  | 168  155 | 
|  | 169  156 <span class="s">}</span> | 
|  | 170  157 | 
|  | 171 <a name="EOF-"></a></pre> | 
|  | 172 <p> </p> | 
|  | 173 <br /> | 
|  | 174 <center> | 
|  | 175 <img src="../../../images/h2o2.png"> | 
|  | 176 </center> | 
|  | 177 </body> | 
|  | 178 </html> |