[1980] | 1 | # ------------------------------------------------------------------------------ |
---|
| 2 | # NAME |
---|
| 3 | # Fcm::Base |
---|
| 4 | # |
---|
| 5 | # DESCRIPTION |
---|
| 6 | # This is base class for all FCM OO packages. |
---|
| 7 | # |
---|
| 8 | # COPYRIGHT |
---|
| 9 | # (C) Crown copyright Met Office. All rights reserved. |
---|
| 10 | # For further details please refer to the file COPYRIGHT.txt |
---|
| 11 | # which you should have received as part of this distribution. |
---|
| 12 | # ------------------------------------------------------------------------------ |
---|
| 13 | |
---|
| 14 | package Fcm::Base; |
---|
| 15 | |
---|
| 16 | # Standard pragma |
---|
| 17 | use strict; |
---|
| 18 | use warnings; |
---|
| 19 | |
---|
| 20 | use Fcm::Config; |
---|
| 21 | |
---|
| 22 | my @scalar_properties = ( |
---|
| 23 | 'config', # instance of Fcm::Config, configuration setting |
---|
| 24 | ); |
---|
| 25 | |
---|
| 26 | # ------------------------------------------------------------------------------ |
---|
| 27 | # SYNOPSIS |
---|
| 28 | # $obj = Fcm::Base->new; |
---|
| 29 | # |
---|
| 30 | # DESCRIPTION |
---|
| 31 | # This method constructs a new instance of the Fcm::Base class. |
---|
| 32 | # ------------------------------------------------------------------------------ |
---|
| 33 | |
---|
| 34 | sub new { |
---|
| 35 | my $this = shift; |
---|
| 36 | my %args = @_; |
---|
| 37 | my $class = ref $this || $this; |
---|
| 38 | |
---|
| 39 | my $self = {}; |
---|
| 40 | for (@scalar_properties) { |
---|
| 41 | $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef; |
---|
| 42 | } |
---|
| 43 | |
---|
| 44 | bless $self, $class; |
---|
| 45 | return $self; |
---|
| 46 | } |
---|
| 47 | |
---|
| 48 | # ------------------------------------------------------------------------------ |
---|
| 49 | # SYNOPSIS |
---|
| 50 | # $value = $obj->X; |
---|
| 51 | # $obj->X ($value); |
---|
| 52 | # |
---|
| 53 | # DESCRIPTION |
---|
| 54 | # Details of these properties are explained in @scalar_properties. |
---|
| 55 | # ------------------------------------------------------------------------------ |
---|
| 56 | |
---|
| 57 | for my $name (@scalar_properties) { |
---|
| 58 | no strict 'refs'; |
---|
| 59 | |
---|
| 60 | *$name = sub { |
---|
| 61 | my $self = shift; |
---|
| 62 | |
---|
| 63 | # Argument specified, set property to specified argument |
---|
| 64 | if (@_) { |
---|
| 65 | $self->{$name} = $_[0]; |
---|
| 66 | } |
---|
| 67 | |
---|
| 68 | # Default value for property |
---|
| 69 | if (not defined $self->{$name}) { |
---|
| 70 | if ($name eq 'config') { |
---|
| 71 | # Configuration setting of the main program |
---|
| 72 | $self->{$name} = Fcm::Config->instance(); |
---|
| 73 | } |
---|
| 74 | } |
---|
| 75 | |
---|
| 76 | return $self->{$name}; |
---|
| 77 | } |
---|
| 78 | } |
---|
| 79 | |
---|
| 80 | # ------------------------------------------------------------------------------ |
---|
| 81 | # SYNOPSIS |
---|
| 82 | # $value = $self->setting (@args); # $self->config->setting |
---|
| 83 | # $value = $self->verbose (@args); # $self->config->verbose |
---|
| 84 | # ------------------------------------------------------------------------------ |
---|
| 85 | |
---|
| 86 | for my $name (qw/setting verbose/) { |
---|
| 87 | no strict 'refs'; |
---|
| 88 | |
---|
| 89 | *$name = sub { |
---|
| 90 | my $self = shift; |
---|
| 91 | return $self->config->$name (@_); |
---|
| 92 | } |
---|
| 93 | } |
---|
| 94 | |
---|
| 95 | # ------------------------------------------------------------------------------ |
---|
| 96 | # SYNOPSIS |
---|
| 97 | # $value = $self->cfglabel (@args); |
---|
| 98 | # |
---|
| 99 | # DESCRIPTION |
---|
| 100 | # This is an alias to $self->config->setting ('CFG_LABEL', @args); |
---|
| 101 | # ------------------------------------------------------------------------------ |
---|
| 102 | |
---|
| 103 | sub cfglabel { |
---|
| 104 | my $self = shift; |
---|
| 105 | return $self->setting ('CFG_LABEL', @_); |
---|
| 106 | } |
---|
| 107 | |
---|
| 108 | # ------------------------------------------------------------------------------ |
---|
| 109 | |
---|
| 110 | 1; |
---|
| 111 | |
---|
| 112 | __END__ |
---|