git.sur5r.net Git - bacula/rescue/blob - rescue/linux/cdrom/yaird-0.0.5/perl/Obj.pm

   1 #!perl -w
   2 #
   3 # Obj -- basic object stuff
   4 #   Copyright (C) 2005  Erik van Konijnenburg
   5 #
   6 #   This program is free software; you can redistribute it and/or modify
   7 #   it under the terms of the GNU General Public License as published by
   8 #   the Free Software Foundation; either version 2 of the License, or
   9 #   (at your option) any later version.
  10 #
  11 #   This program is distributed in the hope that it will be useful,
  12 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #   GNU General Public License for more details.
  15 #
  16 #   You should have received a copy of the GNU General Public License
  17 #   along with this program; if not, write to the Free Software
  18 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19 #
  20 # The new() function takes a hash as argument, used to do object
  21 # initialisation.  Initialisation is delegated to fill() in derived
  22 # classes.  Fill() is expected to use takeArgs() to claim those
  23 # initialisation args it's interested in; other args are left for
  24 # fill() functions further down the inheritance chain.  Arguments
  25 # may have undef as value.
  26 #
  27
  28 use strict;
  29 use warnings;
  30 use Base;
  31 package Obj;
  32
  33 sub new {
  34         my $class = shift;
  35         my $self = {};
  36         $self->{'_args'} = { @_ };
  37         bless ($self, $class);
  38         $self->fill();
  39         my $bad = join (', ', keys %{$self->{'_args'}});
  40         if ($bad ne '') {
  41                 Base::bug "Unknown constructor args: $bad";
  42         }
  43         return $self;
  44 }
  45
  46 sub fill {
  47         my $self = shift;
  48         # Derived classes can claim arguments like so:
  49         # self->SUPER::fill();
  50         # $self->takeArg ('a');
  51 }
  52
  53 sub takeArgs {
  54         my ($self, @fields) = @_;
  55         for my $field (@fields) {
  56                 Base::assert (exists ($self->{'_args'}{$field}));
  57                 $self->{$field} = delete $self->{'_args'}{$field};
  58         }
  59 }
  60
  61 1;