1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
package XTM::generic;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
require AutoLoader;
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw( AUTOLOAD );
$VERSION = '0.02';
use XTM::Log;
use XTM::Namespaces;
=pod
=head1 NAME
XTM::generic - XTM generic accessor
=head1 SYNOPSIS
# very much an internal package...
=head1 DESCRIPTION
Generic provider for accessor functions.
Instead of hard-coding simple accessor functions into trivial packages, these
packages can inherit the methods from this package.
=head1 INTERFACE
=head2 Constructor
The constructor just returns a blessed object reference to the class in question. All
parameters - given in a hash - will be components of the resulting object.
=cut
sub new {
my $class = shift;
my %pars = @_;
## XTM::Log::log ($class, 5, "new '$class'");
return bless { %pars }, $class;
}
=pod
=head2 Methods
AUTOLOAD will capture most of the access.
If the method name begins with 'add_'. If it ends with '_s' then the provided
values will be added to a list component. Otherwise it is regarded as a single value.
If the method does not begin with 'add_' then a simple read access is assumed. Again,
if the name ends with '_s' then a list will be returned.
The component name will be derived from the
rest of the method name, if that is non-empty (like in 'add_rumsti_s'). If the
name is empty ('add__s') then the component name will be derived from the parameters
class name ('XYZ::rumsti' will result in a component name 'rumsti').
=cut
use vars qw($AUTOLOAD);
sub AUTOLOAD {
my ($method) = $AUTOLOAD =~ m/([^:]+)$/;
return if $method eq 'DESTROY';
my $self = shift;
## XTM::Log::log (ref($self), 4, "AUTOLOAD for '$method', params: ".@_);
if ($method =~ /^add_(.*)_s$/) { # list add
my $component = $1;
if ($component) {
push @{$self->{$component."s"}}, @_;
} else {
## XTM::Log::log (ref($self), 4, " list with individual");
foreach my $c (@_) {
(undef, $component) = split /::/, ref($c);
push @{$self->{$component."s"}}, $c;
## use Data::Dumper;
## XTM::Log::log (ref($self), 5, " pushed $component". Dumper $self);
}
}
} elsif ($method =~ /^add_(.*)$/) { # scalar set
my $component = $1;
unless ($component) {
(undef, $component) = split /::/, ref($_[0]);
}
$self->{$component} = shift;
} elsif ($method =~ /^(.*)_s$/) { # list retrieve
## XTM::Log::log (ref($self), 5, " $1 list retrieve");
## use Data::Dumper;
## print STDERR Dumper $self->{$1."s"};
if (defined $self->{$1."s"} && ref ($self->{$1."s"}) eq 'ARRAY') {
return defined wantarray ? @{$self->{$1."s"}} : scalar @{$self->{$1."s"}};
} else {
return ();
}
# return (defined $self->{$1."s"} && ref ($self->{$1."s"}) eq 'ARRAY') ? @{$self->{$1."s"}}: ();
} else {
return $self->{$method} || undef;
}
}
=pod
The method I<undefine> gets rid of a particular component.
=cut
sub undefine {
my $self = shift;
foreach my $c (@_) {
delete $self->{$c};
}
}
=pod
=cut
sub xml {
die "XTM::generic: unimplemented feature 'XML serialisation of ".ref(shift)."'";
}
=pod
=head1 SEE ALSO
L<XTM>
=head1 AUTHOR INFORMATION
Copyright 2001, Robert Barta <rho@telecoma.net>, All rights reserved.
This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
=cut
1;
__END__
|
