]>
Commit | Line | Data |
---|---|---|
589b789c TC |
1 | package BSE::Cfg; |
2 | use strict; | |
0d454b28 | 3 | use base "DevHelp::Cfg"; |
e1e2a2b5 | 4 | use Carp qw(confess); |
589b789c | 5 | use constant MAIN_CFG => 'bse.cfg'; |
589b789c | 6 | |
8bde8c4b | 7 | our $VERSION = "1.005"; |
cb7fd78d | 8 | |
589b789c TC |
9 | my %cache; |
10 | ||
e1e2a2b5 | 11 | my $single; |
589b789c TC |
12 | |
13 | =head1 NAME | |
14 | ||
15 | BSE::Cfg - configuration file for BSE | |
16 | ||
17 | =head1 SYNOPSIS | |
18 | ||
19 | my $cfg = BSE::Cfg->new(); | |
20 | my $entry1 = $cfg->entry($section, $key); # undef on failure | |
21 | my $entry2 = $cfg->entryErr($section, $key); # abort on failure | |
22 | my $entry3 = $cfg->entryVar($section, $key); # replace variables in value | |
23 | ||
24 | =head1 DESCRIPTION | |
25 | ||
26 | Provides a simple configuration file object for BSE. | |
27 | ||
28 | Currently just provides access to a single config file, but could | |
29 | later be modified to provide access to one based on the current site, | |
30 | for use in a mod_perl version of BSE. | |
31 | ||
32 | =head1 METHODS | |
33 | ||
34 | =over | |
35 | ||
36 | =item BSE::Cfg->new | |
37 | ||
e1e2a2b5 TC |
38 | Create a new configuration file object. |
39 | ||
40 | Parameters: | |
41 | ||
42 | =over | |
43 | ||
44 | =item * | |
45 | ||
46 | path - the path to start searching for the config file in, typically | |
47 | the BSE cgi-bin. | |
48 | ||
49 | =back | |
589b789c TC |
50 | |
51 | =cut | |
52 | ||
53 | sub new { | |
54 | my ($class, %opts) = @_; | |
55 | ||
0d454b28 | 56 | $single = $class->SUPER::new(filename => MAIN_CFG, %opts); |
e1e2a2b5 TC |
57 | |
58 | return $single; | |
59 | } | |
60 | ||
61 | =item single | |
62 | ||
63 | Return the BSE configuration object. | |
64 | ||
65 | This is used to avoid always passing around a config object. | |
66 | ||
67 | =cut | |
68 | ||
69 | sub single { | |
70 | my ($class) = @_; | |
71 | ||
72 | $single or confess "BSE's configuration hasn't been initialized yet"; | |
73 | ||
74 | return $single; | |
589b789c TC |
75 | } |
76 | ||
0d454b28 | 77 | =item utf8 |
531fb3bc | 78 | |
0d454b28 | 79 | Return a true value if BSE is working in UTF-8 internal mode. |
589b789c TC |
80 | |
81 | =cut | |
82 | ||
0d454b28 TC |
83 | sub utf8 { |
84 | return $single->entry("basic", "utf8", 0); | |
589b789c TC |
85 | } |
86 | ||
0d454b28 | 87 | =item charset |
589b789c | 88 | |
0d454b28 | 89 | Return the BSE character set. |
589b789c TC |
90 | |
91 | =cut | |
92 | ||
0d454b28 TC |
93 | sub charset { |
94 | return $single->entry('html', 'charset', 'iso-8859-1'); | |
589b789c TC |
95 | } |
96 | ||
13a986ee TC |
97 | =item user_url($script, $target) |
98 | ||
99 | =cut | |
100 | ||
101 | sub user_url { | |
102 | my ($cfg, $script, $target, @options) = @_; | |
103 | ||
ede1cb40 TC |
104 | my $secure = $script =~ /^(shop|user)$/; |
105 | $secure = $cfg->entry("secure user url", $script, $secure); | |
8ebed4c6 | 106 | my $base; |
13a986ee TC |
107 | my $template; |
108 | if ($target) { | |
109 | if ($script eq 'nuser') { | |
110 | $template = "/cgi-bin/nuser.pl/user/TARGET"; | |
111 | } | |
112 | else { | |
8ebed4c6 | 113 | $template = "/cgi-bin/$script.pl?a_TARGET=1"; |
13a986ee TC |
114 | } |
115 | $template = $cfg->entry('targets', $script, $template); | |
116 | $template =~ s/TARGET/$target/; | |
117 | } | |
118 | else { | |
119 | if ($script eq 'nuser') { | |
120 | $template = "/cgi-bin/nuser.pl/user"; | |
121 | } | |
122 | else { | |
8ebed4c6 | 123 | $template = "/cgi-bin/$script.pl"; |
13a986ee TC |
124 | } |
125 | $template = $cfg->entry('targets', $script.'_n', $template); | |
126 | } | |
127 | if (@options) { | |
13a986ee TC |
128 | my @entries; |
129 | while (my ($key, $value) = splice(@options, 0, 2)) { | |
130 | require BSE::Util::HTML; | |
8ebed4c6 TC |
131 | if ($key eq '-base') { |
132 | $base = $value; | |
133 | } | |
134 | else { | |
135 | push @entries, "$key=" . BSE::Util::HTML::escape_uri($value); | |
136 | } | |
137 | } | |
138 | if (@entries) { | |
139 | $template .= $template =~ /\?/ ? '&' : '?'; | |
140 | $template .= join '&', @entries; | |
13a986ee | 141 | } |
13a986ee TC |
142 | } |
143 | ||
8ebed4c6 TC |
144 | $base ||= $secure ? $cfg->entryVar('site', 'secureurl') : ''; |
145 | ||
146 | return $base . $template; | |
13a986ee TC |
147 | } |
148 | ||
a5093f33 TC |
149 | sub admin_url { |
150 | my ($self, $action, $params, $name) = @_; | |
151 | ||
73070dbf TC |
152 | return $self->admin_url2($action, undef, $params, $name); |
153 | } | |
154 | ||
155 | sub admin_url2 { | |
156 | my ($self, $action, $target, $params, $name) = @_; | |
157 | ||
a5093f33 | 158 | require BSE::CfgInfo; |
73070dbf | 159 | my $add_target; |
a5093f33 | 160 | my $url = BSE::CfgInfo::admin_base_url($self); |
73070dbf TC |
161 | if ($self->entry("admin url", $action)) { |
162 | $url .= $self->entry("admin url", $action); | |
163 | $url .= "/" . $target if $target; | |
164 | } | |
165 | elsif ($self->entry("admin controllers", $action)) { | |
166 | $url .= $self->entry("site", "adminscript", "/cgi-bin/admin/bseadmin.pl"); | |
167 | $url .= "/" . $action; | |
168 | $url .= "/" . $target if $target; | |
169 | } | |
170 | elsif ($self->entry("nadmin controllers", $action)) { | |
a5093f33 | 171 | $url .= "/cgi-bin/admin/nadmin.pl/$action"; |
8bde8c4b | 172 | $url .= "/$target" if $target; |
a5093f33 TC |
173 | } |
174 | else { | |
175 | $url .= "/cgi-bin/admin/$action.pl"; | |
73070dbf TC |
176 | $add_target++ if $target; |
177 | } | |
178 | if ($add_target) { | |
179 | $params ||= {}; | |
180 | $params = { %$params, "a_$target" => 1 }; | |
a5093f33 TC |
181 | } |
182 | if ($params && keys %$params) { | |
183 | require BSE::Util::HTML; | |
184 | $url .= "?" . join("&", map { "$_=".BSE::Util::HTML::escape_uri($params->{$_}) } keys %$params); | |
185 | } | |
186 | $url .= "#$name" if $name; | |
187 | ||
188 | return $url; | |
189 | } | |
190 | ||
5abe2da5 TC |
191 | =item content_base_path() |
192 | ||
193 | Site document root. Previously $Constants::CONTENTBASE. | |
194 | ||
195 | =cut | |
196 | ||
197 | sub content_base_path { | |
198 | my ($self) = @_; | |
199 | ||
200 | ref $self | |
201 | or $self = $self->single; | |
202 | ||
203 | my $path = $self->entryIfVar("paths", "public_html"); | |
204 | unless ($path) { | |
205 | # backward compatibility | |
206 | require Constants; | |
207 | $path = $Constants::CONTENTBASE; | |
208 | } | |
209 | ||
210 | return $path; | |
211 | } | |
a5093f33 | 212 | |
589b789c TC |
213 | 1; |
214 | ||
215 | =head1 AUTHOR | |
216 | ||
217 | Tony Cook <tony@develop-help.com> | |
218 | ||
219 | =cut |