blob: 043487b96bdd2e34f43fc774a4b3f5b74ce9de8b (
plain)
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
|
# Xerl (c) 2005-2011, 2013 Dipl.-Inform. (FH) Paul C. Buetow
#
# E-Mail: xerl@dev.buetow.org WWW: http://xerl.buetow.org
#
# This is free software, you may use it and distribute it under the same
# terms as Perl itself.
package UNIVERSAL;
use strict;
use warnings;
use 5.14.0;
use Data::Dumper;
sub new ($;) {
my $self = shift;
bless {@_} => $self;
}
sub setval($$$) {
my UNIVERSAL $self = $_[0];
$self->{ $_[1] } = $_[2];
return undef;
}
sub getval($$) {
my UNIVERSAL $self = $_[0];
return defined $self->{ $_[1] } ? $self->{ $_[1] } : '';
}
sub exists($$) {
my UNIVERSAL $self = $_[0];
return exists $self->{ $_[1] } ? 1 : 0;
}
sub AUTOLOAD {
my UNIVERSAL $self = $_[0];
my $auto = our $AUTOLOAD;
return $self if $auto =~ /DESTROY/;
if ( $auto =~ /.*::set_(.+)$/ ) {
$self->{$1} = $_[1];
}
elsif ( $auto =~ /.*::get_(.+)_ref$/ ) {
return defined $self->{$1} ? \$self->{$1} : [''];
}
elsif ( $auto =~ /.*::get_(.+)$/ ) {
return defined $self->{$1} ? $self->{$1} : '';
}
elsif ( $auto =~ /.*::undef_(.+)$/ ) {
return '' unless defined $self->{$1};
my $retval = $self->{$1};
undef $self->{$1};
return $retval;
}
elsif ( $auto =~ /.*::append_(.+)$/ ) {
if ( defined $self->{$1} ) {
$self->{$1} .= $_[1];
}
else {
$self->{$1} = $_[1];
}
}
elsif ( $auto =~ /.*::push_(.+)$/ ) {
if ( exists $self->{$1} ) {
push @{ $self->{$1} }, $_[1];
}
else {
$self->{$1} = [ $_[1] ];
}
}
elsif ( $auto =~ /.*::first_(.+)$/ ) {
return exists $self->{$1} ? ${ $self->{$1} }[0] : '';
}
elsif ( $auto =~ /.*::(.+)_exists$/ ) {
return exists $self->{$1} ? 1 : 0;
}
elsif ( $auto =~ /.*::(.+)_length$/ ) {
return ( ref $self->{$1} eq 'ARRAY' ) ? scalar @{ $self->{$1} } : 0;
}
elsif ( $auto =~ /.*::(.+)_isset$/ ) {
return exists $self->{$1} ? $self->{ $_[0] } : 0;
}
elsif ( $auto =~ /.*::dumper$/ ) {
say Dumper @_;
return undef;
}
else {
say "$auto is not a method of $self or UNIVERSAL";
}
return $self;
}
1;
|
