Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Psh::Builtins::Tieopt; |
2 | ||
3 | require Psh; | |
4 | require Psh::Util; | |
5 | require Psh::Support::TiedOption; | |
6 | require Psh::Options; | |
7 | ||
8 | =item * C<tieopt NAME $VAR> | |
9 | ||
10 | =item * C<tieopt NAME @VAR> | |
11 | ||
12 | =item * C<tieopt NAME %VAR> | |
13 | ||
14 | Ties the option named NAME to the global variable $VAR, @VAR or %VAR | |
15 | ||
16 | =item * C<tieopt NAME> | |
17 | ||
18 | Ties the option named NAME to the global variable named $NAME, @NAME, or %NAME, depending on the option's type. | |
19 | ||
20 | =item * C<tieopt -u $VAR> | |
21 | ||
22 | Unties the global variable named $VAR | |
23 | Note that you can simply use perl's built-in C<untie $VAR> | |
24 | ||
25 | =cut | |
26 | ||
27 | sub bi_tieopt { | |
28 | my $line = shift; | |
29 | my @words = @{shift()}; | |
30 | ||
31 | my ($untie, $name, $var, $actual_type, $requested_type); | |
32 | ||
33 | my %var_types = ( | |
34 | '$' => 'SCALAR', | |
35 | '@' => 'ARRAY', | |
36 | '%' => 'HASH', | |
37 | ); | |
38 | ||
39 | # untie NAME | |
40 | # untie $VAR | |
41 | if ($words[0] =~ /^-u$/i) { | |
42 | $untie = 1; | |
43 | ||
44 | $var = $words[1]; | |
45 | if ($var =~ /^(\$|\@|\%)/) { | |
46 | $requested_type = $var_types{$1}; | |
47 | } | |
48 | $var =~ s/\W//g; | |
49 | $name = $var; | |
50 | ||
51 | } | |
52 | ||
53 | # tieopt NAME | |
54 | # tieopt $VAR | |
55 | elsif (@words == 1) { | |
56 | $name = $words[0]; | |
57 | ||
58 | if ($name =~ /^(\$|\@|\%)/) { | |
59 | $requested_type = $var_types{$1}; | |
60 | } | |
61 | $name =~ s/\W//g; | |
62 | ||
63 | $var = $name; | |
64 | } | |
65 | # tieopt NAME $VAR | |
66 | elsif (@words == 2) { | |
67 | ($name, $var) = @words; | |
68 | ||
69 | if ($var =~ /^(\$|\@|\%)/) { | |
70 | $requested_type = $var_types{$1}; | |
71 | } | |
72 | $name =~ s/\W//g; | |
73 | $var =~ s/\W//g; | |
74 | } | |
75 | else { | |
76 | return; | |
77 | } | |
78 | ||
79 | ||
80 | $curr_val = Psh::Options::get_option($name); | |
81 | ||
82 | $actual_type = ref $curr_val; | |
83 | ||
84 | if (defined $curr_val) { | |
85 | if (ref $curr_val) { | |
86 | if (ref $curr_val eq 'ARRAY' and @$curr_val) { | |
87 | $actual_type = 'ARRAY'; | |
88 | } | |
89 | if (ref $curr_val eq 'HASH' and keys %curr_val) { | |
90 | $actual_type = 'HASH'; | |
91 | } | |
92 | } | |
93 | else { | |
94 | if ($curr_val) { | |
95 | $actual_type = 'SCALAR'; | |
96 | } | |
97 | } | |
98 | } | |
99 | ||
100 | $requested_type ||= $actual_type || 'SCALAR'; | |
101 | ||
102 | if ($untie) { | |
103 | no strict 'refs'; | |
104 | if ($requested_type eq 'SCALAR') { | |
105 | untie ${"$Psh::PerlEval::current_package\:\:$name"}; | |
106 | } | |
107 | if ($requested_type eq 'ARRAY') { | |
108 | ||
109 | untie @{"$Psh::PerlEval::current_package\:\:$name"}; | |
110 | } | |
111 | if ($requested_type eq 'HASH') { | |
112 | untie %{"$Psh::PerlEval::current_package\:\:$name"}; | |
113 | } | |
114 | } | |
115 | else { | |
116 | if ($actual_type and $actual_type ne $requested_type) { | |
117 | if ($requested_type eq 'ARRAY') { | |
118 | Psh::Util::print_error_i18n('bi_tieopt_badtype_array', $name); | |
119 | } | |
120 | elsif ($requested_type eq 'HASH') { | |
121 | Psh::Util::print_error_i18n('bi_tieopt_badtype_hash', $name); | |
122 | } | |
123 | else { | |
124 | Psh::Util::print_error_i18n('bi_tieopt_badtype_scalar', $name); | |
125 | } | |
126 | return; | |
127 | } | |
128 | # print STDERR "tying option: $name to \${$Psh::PerlEval::current_package\:\:$var}\n" if $requested_type eq 'SCALAR'; | |
129 | # print STDERR "tying option: $name to \@{$Psh::PerlEval::current_package\:\:$var}\n" if $requested_type eq 'ARRAY'; | |
130 | # print STDERR "tying option: $name to \%{$Psh::PerlEval::current_package\:\:$var}\n" if $requested_type eq 'HASH'; | |
131 | ||
132 | { | |
133 | ||
134 | # Tie the $name to $var | |
135 | no strict 'refs'; | |
136 | if ($requested_type eq 'SCALAR') { | |
137 | Psh::Options::set_option($name, '') unless $actual_type; | |
138 | tie ${"$Psh::PerlEval::current_package\:\:$var"}, 'Psh::Support::TiedOption::Scalar', $name; | |
139 | } | |
140 | if ($requested_type eq 'ARRAY') { | |
141 | Psh::Options::set_option($name, []) unless $actual_type; | |
142 | tie @{"$Psh::PerlEval::current_package\:\:$var"}, 'Psh::Support::TiedOption::Array', $name; | |
143 | ||
144 | } | |
145 | if ($requested_type eq 'HASH') { | |
146 | Psh::Options::set_option($name, {}) unless $actual_type; | |
147 | tie %{"$Psh::PerlEval::current_package\:\:$var"}, 'Psh::Support::TiedOption::Hash', $name; | |
148 | } | |
149 | } | |
150 | } | |
151 | } | |
152 | ||
153 | 1; |