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