source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm @ 5445

Last change on this file since 5445 was 5445, checked in by davestorkey, 5 years ago

Clear SVN keywords from 2015/dev_r5021_UKMO1_CICE_coupling branch.

File size: 2.8 KB
RevLine 
[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
14package Fcm::Base;
15
16# Standard pragma
17use strict;
18use warnings;
19
20use Fcm::Config;
21
22my @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
34sub 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
57for 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
86for 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
103sub cfglabel {
104  my $self = shift;
105  return $self->setting ('CFG_LABEL', @_);
106}
107
108# ------------------------------------------------------------------------------
109
1101;
111
112__END__
Note: See TracBrowser for help on using the repository browser.