Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Psh::Options; |
2 | ||
3 | require Psh; | |
4 | require Psh::OS; | |
5 | ||
6 | # externally stored options | |
7 | my %env_options= qw( cdpath 1 fignore 1 histsize 1 ignoreeof 1 | |
8 | ps1 1 ps2 1 path 1); | |
9 | ||
10 | # internally stored options and their defaults | |
11 | my %options=( | |
12 | 'array_exports' => { | |
13 | 'path' => $Psh::OS::PATH_SEPARATOR, | |
14 | 'classpath' => $Psh::OS::PATH_SEPARATOR, | |
15 | 'ld_library_path' => $Psh::OS::PATH_SEPARATOR, | |
16 | 'fignore' => $Psh::OS::PATH_SEPARATOR, | |
17 | 'cdpath' => $Psh::OS::PATH_SEPARATOR, | |
18 | 'ls_colors' => ':', | |
19 | }, | |
20 | 'expansion' => 1, | |
21 | 'globbing' => 1, | |
22 | 'window_title' => '\w', | |
23 | 'save_history' => 1, | |
24 | ); | |
25 | ||
26 | # setup defaults for ENV variables | |
27 | if (!exists $ENV{HISTSIZE}) { | |
28 | $ENV{HISTSIZE}=50; | |
29 | } | |
30 | ||
31 | sub set_option { | |
32 | my $option= lc(shift()); | |
33 | my @value= @_; | |
34 | return unless $option; | |
35 | return unless @value; | |
36 | my $val; | |
37 | if ($env_options{$option}) { | |
38 | if (@value>1 or (ref $value[0] and ref $value[0] eq 'ARRAY')) { | |
39 | if (ref $value[0]) { | |
40 | @value= @{$value[0]}; | |
41 | } | |
42 | if ($options{array_exports} and $options{array_exports}{$option}) { | |
43 | $val= join($options{array_exports}{$option},@value); | |
44 | } else { | |
45 | $val= $value[0]; | |
46 | } | |
47 | } else { | |
48 | $val= $value[0]; | |
49 | } | |
50 | $ENV{uc($option)}= $val; | |
51 | } else { | |
52 | if (@value>1) { | |
53 | $val= \@value; | |
54 | } else { | |
55 | $val= $value[0]; | |
56 | } | |
57 | $options{$option}= $val; | |
58 | } | |
59 | } | |
60 | ||
61 | sub get_option { | |
62 | my $option= lc(shift()); | |
63 | my $val; | |
64 | if ($env_options{$option}) { | |
65 | $val= $ENV{uc($option)}; | |
66 | if ($options{array_exports} and $options{array_exports}{$option}) { | |
67 | $val= [split($options{array_exports}{$option}, $val)]; | |
68 | } | |
69 | } else { | |
70 | $val=$options{$option}; | |
71 | } | |
72 | if (defined $val) { | |
73 | if (wantarray()) { | |
74 | if (ref $val and ref $val eq 'ARRAY') { | |
75 | return @{$val}; | |
76 | } elsif ( ref $val and ref $val eq 'HASH') { | |
77 | return %{$val}; | |
78 | } | |
79 | return $val; | |
80 | } else { | |
81 | return $val; | |
82 | } | |
83 | } | |
84 | return undef; | |
85 | } | |
86 | ||
87 | sub get_printable_option { | |
88 | my $option= shift; | |
89 | my $noquote= shift; | |
90 | my $tmpval= get_option($option); | |
91 | my $val= ''; | |
92 | if (ref $tmpval) { | |
93 | if (ref $tmpval eq 'HASH') { | |
94 | $val='{'; | |
95 | while (my ($k,$v)= each %$tmpval) { | |
96 | next unless defined $k; | |
97 | if (defined $v) { | |
98 | $val.=" \'".$k."\' => \'".$v."\', "; | |
99 | } else { | |
100 | $val.=" \'".$k."\' => undef, "; | |
101 | } | |
102 | } | |
103 | $val= substr($val,0,-2).' }'; | |
104 | } elsif (ref $tmpval eq 'ARRAY') { | |
105 | $val='['; | |
106 | foreach (@$tmpval) { | |
107 | if (defined $_) { | |
108 | $val.=" \'".$_."\', "; | |
109 | } else { | |
110 | $val.=" undef, "; | |
111 | } | |
112 | } | |
113 | $val= substr($val,0,-2).' ]'; | |
114 | } elsif (ref $tmpval eq 'CODE') { | |
115 | $val='CODE'; | |
116 | } | |
117 | } else { | |
118 | if (defined $tmpval) { | |
119 | if ($noquote) { | |
120 | $val= $tmpval; | |
121 | } else { | |
122 | $val= qq['$tmpval']; | |
123 | } | |
124 | } else { | |
125 | $val= 'undef'; | |
126 | } | |
127 | } | |
128 | return $val; | |
129 | } | |
130 | ||
131 | sub has_option { | |
132 | my $option= lc(shift()); | |
133 | return 1 if exists $options{$option} or ($env_options{$option} and | |
134 | exists $ENV{uc($option)}); | |
135 | return 0; | |
136 | } | |
137 | ||
138 | sub del_option { | |
139 | my $option= lc(shift()); | |
140 | if ($env_options{$option}) { | |
141 | delete $ENV{uc($option)}; | |
142 | } else { | |
143 | delete $options{$option}; | |
144 | } | |
145 | } | |
146 | ||
147 | sub list_options { | |
148 | my @opts= keys %options; | |
149 | foreach (keys %env_options) { | |
150 | push @opts, lc($_) if exists $ENV{uc($_)}; | |
151 | } | |
152 | return @opts; | |
153 | } | |
154 | ||
155 | 1; |