Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | |
2 | use strict; | |
3 | ||
4 | require Psh; | |
5 | require Psh::Options; | |
6 | ||
7 | package Psh::Support::TiedOption; | |
8 | package Psh::Support::TiedOption::Scalar; | |
9 | ||
10 | sub TIESCALAR { | |
11 | my ($class, $optname) = @_; | |
12 | return bless \$optname, $class; | |
13 | } | |
14 | sub FETCH { | |
15 | my $optname = shift; | |
16 | my $val = Psh::Options::get_option($$optname); | |
17 | if (ref $val) { | |
18 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_scalar', $$optname); | |
19 | return; | |
20 | } | |
21 | return $val; | |
22 | } | |
23 | sub STORE { | |
24 | my ($optname, $newval) = @_; | |
25 | my $val = Psh::Options::get_option($$optname); | |
26 | if (ref $val) { | |
27 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_scalar', $$optname); | |
28 | return; | |
29 | } | |
30 | Psh::Options::set_option($$optname, $newval); | |
31 | } | |
32 | ||
33 | package Psh::Support::TiedOption::Array; | |
34 | ||
35 | sub TIEARRAY { | |
36 | my ($class, $optname) = @_; | |
37 | return bless \$optname, $class; | |
38 | } | |
39 | sub FETCH { | |
40 | my ($optname, $index) = @_; | |
41 | my $val = Psh::Options::get_option($$optname); | |
42 | unless (ref $val eq 'ARRAY') { | |
43 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_array', $$optname); | |
44 | return; | |
45 | } | |
46 | return $val->[$index]; | |
47 | } | |
48 | sub STORE { | |
49 | my ($optname, $index, $newval) = @_; | |
50 | my $array = scalar Psh::Options::get_option($$optname); | |
51 | ||
52 | unless (ref $array eq 'ARRAY') { | |
53 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_array', $$optname); | |
54 | return; | |
55 | } | |
56 | $array->[$index] = $newval; | |
57 | Psh::Options::set_option($$optname, $array); | |
58 | } | |
59 | sub FETCHSIZE { | |
60 | my ($optname) = @_; | |
61 | my $val = Psh::Options::get_option($$optname); | |
62 | unless (ref $val eq 'ARRAY') { | |
63 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_array', $$optname); | |
64 | return; | |
65 | } | |
66 | return scalar @$val; | |
67 | } | |
68 | sub CLEAR { | |
69 | my ($optname) = @_; | |
70 | my $val = Psh::Options::get_option($$optname); | |
71 | unless (ref $val eq 'ARRAY') { | |
72 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_array', $$optname); | |
73 | return; | |
74 | } | |
75 | Psh::Options::set_option($$optname, []); | |
76 | } | |
77 | ||
78 | sub EXTEND { | |
79 | } | |
80 | ||
81 | ||
82 | package Psh::Support::TiedOption::Hash; | |
83 | ||
84 | sub TIEHASH { | |
85 | my ($class, $optname) = @_; | |
86 | return bless \$optname, $class; | |
87 | } | |
88 | sub FETCH { | |
89 | my ($optname, $key) = @_; | |
90 | my $val = Psh::Options::get_option($$optname); | |
91 | unless (ref $val eq 'HASH') { | |
92 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname); | |
93 | return; | |
94 | } | |
95 | return $val->{$key}; | |
96 | } | |
97 | sub STORE { | |
98 | my ($optname, $key, $newval) = @_; | |
99 | my $hash = scalar Psh::Options::get_option($$optname); | |
100 | unless (ref $hash eq 'HASH') { | |
101 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname); | |
102 | return; | |
103 | } | |
104 | $hash->{$key} = $newval; | |
105 | Psh::Options::set_option($$optname, $hash); | |
106 | } | |
107 | sub EXISTS { | |
108 | my ($optname, $key) = @_; | |
109 | my $val = Psh::Options::get_option($$optname); | |
110 | unless (ref $val eq 'HASH') { | |
111 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname); | |
112 | return; | |
113 | } | |
114 | return exists $val->{$key}; | |
115 | } | |
116 | sub DELETE { | |
117 | my ($optname, $key) = @_; | |
118 | my $val = Psh::Options::get_option($$optname); | |
119 | unless (ref $val eq 'HASH') { | |
120 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname); | |
121 | return; | |
122 | } | |
123 | return delete $val->{$key}; | |
124 | } | |
125 | sub CLEAR { | |
126 | my ($optname) = @_; | |
127 | my $val = Psh::Options::get_option($$optname); | |
128 | unless (ref $val eq 'HASH') { | |
129 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname); | |
130 | return; | |
131 | } | |
132 | Psh::Options::set_option($$optname, {}); | |
133 | } | |
134 | sub FIRSTKEY { | |
135 | my ($optname) = @_; | |
136 | my $val = Psh::Options::get_option($$optname); | |
137 | unless (ref $val eq 'HASH') { | |
138 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname); | |
139 | return; | |
140 | } | |
141 | # Reset keys iterator | |
142 | my $reset_keys = keys %$val; | |
143 | return each %$val; | |
144 | } | |
145 | sub NEXTKEY { | |
146 | my ($optname) = @_; | |
147 | my $val = Psh::Options::get_option($$optname); | |
148 | unless (ref $val eq 'HASH') { | |
149 | Psh::Util::print_error_i18n('bi_tieopt_fetch_badtype_hash', $$optname); | |
150 | return; | |
151 | } | |
152 | return each %$val; | |
153 | } | |
154 | ||
155 | 1; | |
156 |