Teach send_mail() about MV_EMAIL_CHARSET
[interchange.git] / lib / Vend / Config.pm
1 # Vend::Config - Configure Interchange
2 #
3 # Copyright (C) 2002-2017 Interchange Development Group
4 # Copyright (C) 1996-2002 Red Hat, Inc.
5 #
6 # This program was originally based on Vend 0.2 and 0.3
7 # Copyright 1995 by Andrew M. Wilcox <amw@wilcoxsolutions.com>
8 #
9 # This program is free software; you can redistribute it and/or modify
10 # it under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 2 of the License, or
12 # (at your option) any later version.
13 #
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 # GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public
20 # License along with this program; if not, write to the Free
21 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
22 # MA  02110-1301  USA.
23
24 package Vend::Config;
25 require Exporter;
26
27 @ISA = qw(Exporter);
28
29 @EXPORT         = qw( config global_config config_named_catalog );
30
31 @EXPORT_OK      = qw( get_catalog_default get_global_default parse_time parse_database);
32
33 use strict;
34 no warnings qw(uninitialized numeric);
35 use vars qw(
36                         $VERSION $C
37                         @Locale_directives_ary @Locale_directives_scalar
38                         @Locale_directives_code %tagCanon
39                         %ContainerSave %ContainerTrigger %ContainerSpecial %ContainerType
40                         %Default
41                         %Dispatch_code %Dispatch_priority
42                         %Cleanup_code %Cleanup_priority
43                         @Locale_directives_currency @Locale_keys_currency
44                         $GlobalRead  $SystemCodeDone $SystemGroupsDone $CodeDest
45                         $SystemReposDone $ReposDest @include
46                         );
47 use Config;
48 use Vend::Safe;
49 use Fcntl;
50 use Vend::Parse;
51 use Vend::Util;
52 use Vend::File;
53 use Vend::Data;
54 use Vend::Cron;
55 use Vend::CharSet ();
56
57 $VERSION = '2.250';
58
59 my %CDname;
60 my %CPname;
61 %ContainerType = (
62         yesno => sub {
63                 my ($var, $value, $end) = @_;
64                 $var = $CDname{lc $var};
65                 if($end) {
66                         my $val = delete $ContainerSave{$var};
67                         no strict 'refs';
68                         if($C) {
69                                 $C->{$var} = $val;
70                         }
71                         else {
72                                 ${"Global::$var"} = $val;
73                                 
74                         }
75                 }
76                 else {
77                         no strict 'refs';
78                         $ContainerSave{$var} = $C ? $C->{$var} : ${"Global::$var"};
79                         $ContainerSave{$var} ||= 'No';
80                 }
81         },
82 );
83
84 my %DirectiveAlias = qw(
85         URL            VendURL
86         DataDir        ProductDir
87         DefaultTables  ProductFiles
88         Profiles       OrderProfile
89 );
90
91 for( qw(search refresh cancel return secure unsecure submit control checkout) ) {
92         $Global::LegalAction{$_} = 1;
93 }
94
95 @Locale_directives_currency = (
96 qw/
97                 CommonAdjust
98                 PriceCommas
99                 PriceDivide
100                 PriceField
101                 PriceDefault
102                 SalesTax
103                 Levies
104                 TaxShipping
105                 TaxInclusive
106 /       );
107
108 @Locale_keys_currency = (
109 qw/
110         currency_symbol
111         frac_digits
112         int_curr_symbol
113         int_currency_symbol
114         int_frac_digits
115         mon_decimal_point
116         mon_grouping
117         price_picture
118         mon_thousands_sep
119         n_cs_precedes
120         negative_sign
121         p_cs_precedes
122         p_sep_by_space
123         positive_sign
124
125 /   );
126
127 @Locale_directives_scalar = (
128 qw/
129                 AutoEnd
130                 Autoload
131                 CategoryField
132                 CommonAdjust
133                 DescriptionField
134                 HTMLsuffix
135                 ImageDir
136                 ImageDirSecure
137                 PageDir
138                 Preload
139                 PriceCommas
140                 PriceDefault
141                 PriceDivide
142                 PriceField
143                 SalesTax
144                 SpecialPageDir
145                 TaxShipping
146                 TaxInclusive
147 /   );
148
149 @Locale_directives_ary = (
150 qw/
151         AutoModifier
152         Levies
153         ProductFiles
154         UseModifier
155 /   );
156
157 # These are extra routines that are run if certain directives are
158 # updated
159 # Form:
160 #
161 # [ 'Directive', \&routine, [ @args ] ],
162
163 # @args are optional.
164
165 @Locale_directives_code = (
166         [ 'ProductFiles', \&Vend::Data::update_productbase ],
167 );
168
169 my %HashDefaultBlank = (qw(
170                                         SOAP                    1
171                                         Mail                    1
172                                         Accounting              1
173                                         Levy                    1
174                                         QueryCache              1
175                                 ));
176
177 my %DumpSource = (qw(
178                                         SpecialPage                     1
179                                         GlobalSub                       1
180                                 ));
181
182 my %DontDump = (qw(
183                                         GlobalSub                       1
184                                         SpecialPage                     1
185                                 ));
186
187 my %UseExtended = (qw(
188                                         Catalog                         1
189                                         SubCatalog                      1
190                                         Variable                        1
191                                 ));
192
193 my %InitializeEmpty = (qw(
194                                         FileControl                     1
195                                 ));
196
197 my %AllowScalarAction = (qw(
198                                         FileControl                     1
199                                         SOAP_Control            1
200                                 ));
201
202 my @External_directives = qw(
203         CatalogName 
204         ScratchDefault 
205         ValuesDefault 
206         ScratchDir 
207         SessionDB 
208         SessionDatabase 
209         SessionExpire 
210         VendRoot 
211         VendURL
212         SecureURL
213         Variable->SQLDSN
214         Variable->SQLPASS
215         Variable->SQLUSER
216 );
217
218 my %extmap = qw/
219         ia      ItemAction
220         fa      FormAction
221         am      ActionMap
222         oc      OrderCheck
223         ut      UserTag
224         fi      Filter
225         so      SearchOp
226         fw      Widget
227         lc      LocaleChange
228         tag     UserTag
229         ct      CoreTag
230         jsc     JavaScriptCheck
231 /;
232
233 for( values %extmap ) {
234         $extmap{lc $_} = $_;
235 }
236
237 %tagCanon = ( qw(
238
239         group                   Group
240         actionmap               ActionMap
241         arraycode               ArrayCode
242         hashcode                HashCode
243         coretag                 CoreTag
244         searchop                SearchOp
245         localechange    LocaleChange
246         filter                  Filter
247         formaction              FormAction
248         ordercheck              OrderCheck
249         usertag                 UserTag
250         systemtag               SystemTag
251         widget                  Widget
252
253         alias                   Alias
254         addattr                 addAttr
255         attralias               attrAlias
256         attrdefault             attrDefault
257         cannest                 canNest
258         description     Description
259         override                Override
260         underride               Underride
261         visibility      Visibility
262         help                    Help
263         documentation   Documentation
264         extrameta               ExtraMeta
265         gobble                  Gobble
266         hasendtag               hasEndTag
267         implicit                Implicit
268         interpolate             Interpolate
269         invalidatecache InvalidateCache
270         isendanchor             isEndAnchor
271         multiple                Multiple
272         norearrange             noRearrange
273         order                   Order
274         posnumber               PosNumber
275         posroutine              PosRoutine
276         maproutine              MapRoutine
277         noreparse               NoReparse
278         javascriptcheck JavaScriptCheck
279         required                Required
280         routine                 Routine
281         version                 Version
282 ));
283
284 my %tagSkip = ( qw! Documentation 1 Version 1 !);
285
286 my %tagAry      = ( qw! Order 1 Required 1 ! );
287 my %tagHash     = ( qw!
288                                 attrAlias   1
289                                 Implicit    1
290                                 attrDefault     1
291                                 ! );
292 my %tagBool = ( qw!
293                                 ActionMap   1
294                                 addAttr     1
295                                 canNest     1
296                                 Filter      1
297                                 FormAction  1
298                                 hasEndTag   1
299                                 Interpolate 1
300                                 isEndAnchor 1
301                                 isOperator  1
302                                 Multiple    1
303                                 ItemAction  1
304                                 noRearrange 1
305                                 NoReparse   1
306                                 OrderCheck  1
307                                 UserTag     1
308                                 ! );
309
310 my %current_dest;
311 my %valid_dest = qw/
312                                         actionmap        ActionMap
313                                         coretag          UserTag
314                                         filter           Filter
315                                         formaction       FormAction
316                                         itemaction       ItemAction
317                                         ordercheck       OrderCheck
318                                         localechange     LocaleChange
319                                         usertag          UserTag
320                                         hashcode         HashCode
321                                         arraycode        ArrayCode
322                                         searchop                 SearchOp
323                                         widget           Widget
324                                         javascriptcheck  JavaScriptCheck
325                                 /;
326
327
328 my $StdTags;
329
330 use vars qw/ $configfile /;
331
332 ### This is unset when interchange script is run, so that the default
333 ### when used by an external program is not to compile subroutines
334 $Vend::ExternalProgram = 1;
335
336 # Report a fatal error in the configuration file.
337 sub config_error {
338         my $msg = shift;
339         if(@_) {
340                 $msg = errmsg($msg, @_);
341         }
342
343         local($^W);
344         if ($configfile) {
345                 $msg = errmsg("%s\nIn line %s of the configuration file '%s':\n%s\n",
346                         $msg,
347                         $.,
348                         $configfile,
349                         $Vend::config_line,
350                 );
351         }
352         
353         if ($Vend::ExternalProgram) {
354                 warn "$msg\n" unless $Vend::Quiet;
355         }
356         else {
357                 die "$msg\n";
358         }
359 }
360
361 sub config_warn {
362         my $msg = shift;
363         if(@_) {
364                 $msg = errmsg($msg, @_);
365         }
366
367         local($^W);
368         my $extra = '';
369         if($configfile and $Vend::config_line) {
370                 $extra = errmsg(
371                                 "\nIn line %s of the configuration file '%s':\n%s\n",
372                                                 $msg,
373                                                 $.,
374                                                 $configfile,
375                                                 $Vend::config_line,
376         );
377         }
378
379         ::logGlobal({level => 'notice'}, "$msg$extra");
380 }
381
382 sub setcat {
383         $C = $_[0] || $Vend::Cfg;
384 }
385
386 sub global_directives {
387
388         my $directives = [
389 #   Order is not really important, catalogs are best first
390
391 #   Directive name      Parsing function    Default value
392
393         ['RunDir',                       'root_dir',             $Global::RunDir || 'etc'],
394         ['DebugFile',            'root_dir',             ''],
395         ['CatalogUser',          'hash',                         ''],
396         ['ConfigDir',             undef,                 'etc/lib'],
397         ['FeatureDir',           'root_dir',         'features'],
398         ['ConfigDatabase',       'config_db',        ''],
399         ['ConfigAllBefore',      'root_dir_array',       'catalog_before.cfg'],
400         ['ConfigAllAfter',       'root_dir_array',       'catalog_after.cfg'],
401         ['Message',          'message',           ''],
402         ['Capability',           'capability',           ''],
403         ['Require',                      'require',                      ''],
404         ['Suggest',                      'suggest',                      ''],
405         ['VarName',          'varname',           ''],
406         ['Windows',          undef,               $Global::Windows || ''],
407         ['LockType',         undef,               $Global::Windows ? 'none' : ''],
408         ['DumpStructure',        'yesno',            'No'],
409         ['DumpAllCfg',       'yesno',                'No'],
410         ['DisplayErrors',    'yesno',            'No'],
411         ['DeleteDirective', sub {
412                                                         my $c = $Global::DeleteDirective || {};
413                                                         shift;
414                                                         my @sets = map { lc $_ } split /[,\s]+/, shift;
415                                                         @{$c}{@sets} = map { 1 } @sets;
416                                                         return $c;
417                                                  },            ''],
418         ['Inet_Mode',         'yesno',            (
419                                                                                                 defined $Global::Inet_Mode
420                                                                                                 ||
421                                                                                                 defined $Global::Unix_Mode
422                                                                                                 )
423                                                                                                 ? ($Global::Inet_Mode || 0) : 'No'],
424         ['Unix_Mode',         'yesno',            (
425                                                                                                 defined $Global::Inet_Mode
426                                                                                                 ||
427                                                                                                 defined $Global::Unix_Mode
428                                                                                                 )
429                                                                                                 ? ($Global::Unix_Mode || 0) : 'Yes'],
430         ['TcpMap',           'hash',             ''],
431         ['CodeRepository',   'root_dir',         ''],
432         ['AccumulateCode',   'yesno',            'No'],
433         ['Environment',      'array',            ''],
434         ['TcpHost',           undef,             'localhost 127.0.0.1'],
435         ['AcceptRedirect',       'yesno',                        'No'],
436         ['SendMailProgram',  'executable',               [
437                                                                                                 $Global::SendMailLocation,
438                                                                                            '/usr/sbin/sendmail',
439                                                                                            '/usr/lib/sendmail',
440                                                                                            'Net::SMTP',
441                                                                                           ]
442                                                                                   ],
443         ['EncryptProgram',  'executable',                [ 'gpg', 'pgpe', 'none', ] ],
444         ['PIDfile',              'root_dir',         "etc/$Global::ExeName.pid"],
445         ['SocketFile',           'root_dir_array',   ''],
446         ['SocketPerms',      'integer',          0600],
447         ['SocketReadTimeout','integer',          1],
448         ['SOAP',             'yesno',            'No'],
449         ['SOAP_Socket',       'array',            ''],
450         ['SOAP_Perms',        'integer',          0600],
451         ['MaxRequestsPerChild','integer',           50],
452         ['ChildLife',         'time',             0],
453         ['StartServers',      'integer',          0],
454         ['PreFork',                   'yesno',            0],
455         ['PreForkSingleFork', 'yesno',            0],
456         ['SOAP_MaxRequests', 'integer',           50],
457         ['SOAP_StartServers', 'integer',          1],
458         ['SOAP_Control',     'action',           ''],
459         ['Jobs',                         'hash',                 'MaxLifetime 600 MaxServers 1 UseGlobal 0'],
460         ['IPCsocket',            'root_dir',         'etc/socket.ipc'],
461         ['HouseKeeping',     'time',          60],
462         ['HouseKeepingCron', 'cron',          ''],
463         ['Mall',                  'yesno',           'No'],
464         ['TagGroup',             'tag_group',            $StdTags],
465         ['ConfigParseComments',          'warn',                 ''],
466         ['TagInclude',           'tag_include',          'ALL'],
467         ['ActionMap',            'action',                       ''],
468         ['FileControl',          'action',                       ''],
469         ['FormAction',           'action',                       ''],
470         ['MaxServers',       'integer',          10],
471         ['GlobalSub',            'subroutine',       ''],
472         ['Database',             'database',         ''],
473         ['FullUrl',                      'yesno',            'No'],
474         ['FullUrlIgnorePort', 'yesno',           'No'],
475         ['Locale',                       'locale',            ''],
476         ['HitCount',             'yesno',            'No'],
477         ['IpHead',                       'yesno',            'No'],
478         ['IpQuad',                       'integer',          '1'],
479         ['TagDir',               'root_dir_array',       'code'],
480         ['TemplateDir',      'root_dir_array',   ''],
481         ['DebugTemplate',    undef,              ''],
482         ['DomainTail',           'yesno',            'Yes'],
483         ['CountrySubdomains','hash',             ''],
484         ['TrustProxy',           'list_wildcard_full', ''],
485         ['AcrossLocks',          'yesno',            'No'],
486     ['DNSBL',            'array',            ''],
487         ['NotRobotUA',           'list_wildcard',      ''],
488         ['RobotUA',                      'list_wildcard',      ''],
489         ['RobotIP',                      'list_wildcard_full', ''],
490         ['RobotHost',            'list_wildcard_full', ''],
491         ['HostnameLookups',      'yesno',            'No'],
492         ['TolerateGet',          'yesno',            'No'],
493         ['PIDcheck',             'time',          '0'],
494         ['LockoutCommand',    undef,             ''],
495         ['SafeUntrap',       'array',            'ftfile sort'],
496         ['SafeTrap',         'array',            ':base_io'],
497         ['NoAbsolute',           'yesno',                        'No'],
498         ['AllowGlobal',          'boolean',                      ''],
499         ['PerlNoStrict',         'boolean',                      ''],
500         ['PerlAlwaysGlobal', 'boolean',                  ''],
501         ['AddDirective',         'directive',            ''],
502         ['UserTag',                      'tag',                          ''],
503         ['CodeDef',                      'mapped_code',          ''],
504         ['HotDBI',                       'boolean',                      ''],
505         ['HammerLock',           'time',         30],
506         ['DataTrace',            'integer',              0],
507         ['ShowTimes',            'yesno',                0],
508         ['ErrorFile',            'root_dir',         undef],
509         ['SysLog',                       'hash',             undef],
510         ['Logging',                      'integer',              0],
511         ['CheckHTML',             undef,             ''],
512         ['UrlSepChar',           'url_sep_char',     '&'],
513         ['Variable',             'variable',             ''],
514         ['Profiles',             'profile',              ''],
515         ['Catalog',                      'catalog',              ''],
516         ['SubCatalog',           'catalog',              ''],
517         ['AutoVariable',         'autovar',              'UrlJoiner'],
518         ['EnableJSONPost',       'yesno',                        'No'],
519         ['UnpackJSON',           'yesno',                        'Yes'],
520         ['XHTML',                        'yesno',                'No'],
521         ['UTF8',                         'yesno',                $ENV{MINIVEND_DISABLE_UTF8} ? 'No' : 'Yes'],
522         ['External',             'yesno',                'No'],
523         ['ExternalFile',         'root_dir',         "$Global::RunDir/external.structure"],
524         ['ExternalExport',       undef,                          'Global::Catalog=Catalog'],
525         ['DowncaseVarname',   undef,           ''],
526
527         ];
528         return $directives;
529 }
530
531
532 sub catalog_directives {
533
534         my $directives = [
535 #   Order is somewhat important, the first 6 especially
536
537 #   Directive name      Parsing function    Default value
538
539         ['ErrorFile',        'relative_dir',     'error.log'],
540         ['ActionMap',            'action',                       ''],
541         ['FileControl',          'action',                       ''],
542         ['FormAction',           'action',                       ''],
543         ['ItemAction',           'action',                       ''],
544         ['PageDir',          'relative_dir',     'pages'],
545         ['SpecialPageDir',   undef,                      'special_pages'],
546         ['ProductDir',       'relative_dir',     'products'],
547         ['OfflineDir',       'relative_dir',     'offline'],
548         ['ConfDir',          'relative_dir',     'etc'],
549         ['RunDir',           'relative_dir',     ''],
550         ['ConfigDir',        'relative_dir',     'config'],
551         ['TemplateDir',      'dir_array',                ''],
552         ['ConfigDatabase',       'config_db',        ''],
553         ['Require',                      'require',                      ''],
554         ['Suggest',                      'suggest',                      ''],
555         ['Message',          'message',           ''],
556         ['Variable',             'variable',             ''],
557         ['VarName',          'varname',           ''],
558         ['Limit',                        'hash',    'option_list 5000 chained_cost_levels 32 robot_expire 1'],
559         ['ScratchDefault',       'hash',                 ''],
560         ['Profile',                      'locale',               ''],
561         ['ValuesDefault',        'hash',                 ''],
562         ['ProductFiles',         'array_complete',  'products'],
563         ['PageTables',           'array_complete',  ''],
564         ['PageTableMap',         'hash',                        qq{
565                                                                                                 expiration_date expiration_date
566                                                                                                 show_date       show_date
567                                                                                                 page_text       page_text
568                                                                                                 base_page       base_page
569                                                                                                 code            code
570                                                                                         }],
571         ['DisplayErrors',    'yesno',            'No'],
572         ['ParseVariables',       'yesno',            'No'],
573         ['SpecialPage',          'special', 'order ord/basket results results search results flypage flypage'],
574         ['DirectoryIndex',       undef,                          ''],
575         ['Sub',                          'subroutine',       ''],
576         ['VendURL',          'url',              undef],
577         ['SecureURL',        'url',              undef],
578         ['PostURL',          'url',              ''],
579         ['SecurePostURL',    'url',              ''],
580         ['ProcessPage',      undef,              'process'],
581         ['History',          'integer',          0],
582         ['OrderReport',      undef,                      'etc/report'],
583         ['ScratchDir',       'relative_dir',     'tmp'],
584         ['PermanentDir',     'relative_dir',     'perm'],
585         ['SessionDB',            undef,                  ''],
586         ['SessionType',          undef,                  'File'],
587         ['SessionDatabase',  'relative_dir',     'session'],
588         ['ConfigParseComments',          'warn',                 ''],
589         ['SessionLockFile',  undef,                      'etc/session.lock'],
590         ['MoreDB',                       'yesno',                'No'],
591         ['DatabaseDefault',  'hash',             ''],
592         ['DatabaseAuto',         'dbauto',               ''],
593         ['DatabaseAutoIgnore',   'regex',                ''],
594         ['Database',             'database',             ''],
595         ['Preload',          'routine_array',    ''],
596         ['Autoload',             'routine_array',        ''],
597         ['AutoEnd',                      'routine_array',        ''],
598         ['Replace',                      'replace',              ''],
599         ['Member',                       'variable',             ''],
600         ['Feature',          'feature',          ''],
601         ['WritePermission',  'permission',       'user'],
602         ['ReadPermission',   'permission',       'user'],
603         ['SessionExpire',    'time',             '1 hour'],
604         ['SaveExpire',       'time',             '30 days'],
605         ['MailOrderTo',      undef,              ''],
606         ['SendMailProgram',  'executable',              $Global::SendMailProgram],
607         ['PGP',              undef,                      ''],
608 # GLIMPSE
609         ['Glimpse',          'executable',       ''],
610 # END GLIMPSE
611         ['Locale',           'locale',           ''],
612         ['Route',            'locale',           ''],
613         ['LocaleDatabase',   'configdb',         ''],
614         ['ExecutionLocale',   undef,             'C'],
615         ['DefaultLocale',     undef,             ''],
616         ['RouteDatabase',     'configdb',        ''],
617         ['DirectiveDatabase', 'dbconfig',        ''],
618         ['VariableDatabase',  'dbconfig',        ''],
619         ['DirConfig',         'dirconfig',        ''],
620         ['FileDatabase',         undef,                          ''],
621         ['NoSearch',         'wildcard',         'userdb'],
622         ['AllowRemoteSearch',    'array_complete',     'products variants options'],
623         ['OrderCounter',         undef,              ''],
624         ['MimeType',         'hash',             ''],
625         ['AliasTable',           undef,              ''],
626         ['ImageAlias',           'hash',             ''],
627         ['TableRestrict',        'hash',             ''],
628         ['Filter',                       'hash',             ''],
629         ['ImageDirSecure',   undef,                  ''],
630         ['ImageDirInternal', undef,                  ''],
631         ['ImageDir',             undef,              ''],
632         ['DeliverImage',     'yesno',                    'no'],
633         ['SpecialSub',       'hash',                     ''],
634         ['SetGroup',             'valid_group',      ''],
635         ['UseModifier',          'array',            ''],
636         ['AutoModifier',         'array',            ''],
637         ['MaxQuantityField', undef,                  ''],
638         ['MinQuantityField', undef,                  ''],
639         ['LogFile',               undef,             'etc/log'],
640         ['Pragma',                       'boolean_value',    ''],
641         ['NoExport',             'boolean',                      ''],
642         ['NoExportExternal', 'yesno',                    'no'],
643         ['NoImport',             'boolean',              ''],
644         ['NoImportExternal', 'yesno',            'no'],
645         ['CommonAdjust',         undef,                  ''],
646         ['PriceDivide',          undef,                  1],
647         ['PriceCommas',          'yesno',            'Yes'],
648         ['OptionsEnable',        undef,              ''],
649         ['OptionsAttribute', undef,                  ''],
650         ['Options',                      'locale',           ''],
651         ['AlwaysSecure',         'boolean',          ''],
652         ['AlwaysSecureGlob', 'list_wildcard_full', ''],
653         ['Password',         undef,              ''],
654         ['AdminSub',             'boolean',                      ''],
655         ['ExtraSecure',          'yesno',            'No'],
656         ['FallbackIP',           'yesno',            'No'],
657         ['WideOpen',             'yesno',            'No'],
658         ['Promiscuous',          'yesno',            'No'],
659         ['Cookies',                      'yesno',            'Yes'],
660         ['CookieName',           undef,              ''],
661         ['CookiePattern',        'regex',            '[-\w:.]+'],
662         ['CookieLogin',      'yesno',            'No'],
663         ['CookieDomain',     undef,              ''],
664         ['InternalCookie',   'yesno',            'No'], ## Allows CookieName to be change yet still handle IP address in cookie
665         ['MasterHost',           undef,              ''],
666         ['UserTag',                      'tag',                  ''],
667         ['CodeDef',                      'mapped_code',          ''],
668         ['RemoteUser',           undef,              ''],
669         ['TaxShipping',          undef,              ''],
670         ['TaxInclusive',     'yesno',                    'No'],
671         ['FractionalItems',  'yesno',                    'No'],
672         ['SeparateItems',    'yesno',                    'No'],
673         ['PageSelectField',  undef,                  ''],
674         ['NonTaxableField',  undef,                  ''],
675         ['CreditCardAuto',       'yesno',            'No'],
676         ['FormIgnore',       'boolean',              ''],
677         ['EncryptProgram',       undef,              $Global::EncryptProgram || ''],
678         ['EncryptKey',           undef,              ''],
679         ['AsciiTrack',           undef,              ''],
680         ['TrackFile',            undef,              ''],
681         ['TrackPageParam',       'hash',             ''],
682         ['TrackDateFormat',      undef,              ''],
683         ['SalesTax',             undef,              ''],
684         ['SalesTaxFunction', undef,                  ''],
685         ['CounterDir',           'relative_dir',     ''],
686         ['SOAP',                         'yesno',                        'No'],
687         ['SOAP_Enable',          'hash',                         ''],
688         ['SOAP_Action',          'action',                       ''],                              
689         ['SOAP_Control',     'action',             ''],           
690         ['UserDB',                       'locale',               ''], 
691         ['UserControl',          'yesno',                'No'], 
692         ['UserDatabase',         undef,                  ''],
693         ['RobotLimit',           'integer',                   0],
694         ['OrderLineLimit',       'integer',                   0],
695         ['RedirectCache',        undef,                          ''],
696         ['HTMLsuffix',       undef,                  '.html'],
697         ['CustomShipping',       undef,              ''],
698         ['DefaultShipping',      undef,              'default'],
699         ['UpsZoneFile',          undef,              ''],
700         ['OrderProfile',         'profile',              ''],
701         ['SearchProfile',        'profile',              ''],
702         ['OnFly',                        undef,              ''],
703         ['CategoryField',    undef,              'category'],
704         ['DescriptionField', undef,              'description'],
705         ['PriceDefault',         undef,              'price'],
706         ['PriceField',           undef,              'price'],
707         ['DiscountSpacesOn', 'yesno',            'no'],
708         ['DiscountSpaceVar', 'array',            'mv_discount_space'],
709         ['Jobs',                         'hash',                 ''],
710         ['Shipping',         'locale',           ''],
711         ['Accounting',           'locale',               ''],
712         ['Levies',                       'array',                ''],
713         ['Levy',                         'locale',               ''],
714         ['AutoVariable',         'autovar',              ''],
715         ['ErrorDestination', 'hash',             ''],
716         ['XHTML',                        'yesno',                $Global::XHTML],
717         ['External',             'yesno',                'No'],
718         ['ExternalExport',       undef,                  join " ", @External_directives],
719         ['CartTrigger',          'routine_array',        ''],
720         ['CartTriggerQuantity', 'yesno',                 'no'],
721     ['UserTrack',        'yesno',            'no'],
722         ['DebugHost',        'ip_address_regexp',       ''],
723         ['BounceReferrals',  'yesno',            'no'],
724         ['BounceReferralsRobot', 'yesno',        'no'],
725         ['BounceRobotSessionURL',                'yesno', 'no'],
726         ['OrderCleanup',     'routine_array',    ''],
727         ['QueryCache',        'hash',                   ''],
728         ['SessionCookieSecure', 'yesno',         'no'],
729         ['SessionHashLength', 'integer',         1],
730         ['SessionHashLevels', 'integer',         2],
731         ['SourcePriority', 'array_complete', 'mv_pc mv_source'],
732         ['SourceCookie', sub { &parse_ordered_attributes(@_, [qw(name expire domain path secure)]) }, '' ],
733         ['SuppressCachedCookies', 'yesno',       'no'],
734         ['OutputCookieHook', undef,              ''],
735
736         ];
737
738         push @$directives, @$Global::AddDirective
739                 if $Global::AddDirective;
740         return $directives;
741 }
742
743 sub get_parse_routine {
744         my $parse = shift
745                 or return undef;
746         my $routine;
747         my $rname = $parse;
748         if(ref $parse eq 'CODE') {
749                 $routine = $parse;
750         }
751         elsif( $parse =~ /^\w+$/) {
752                 no strict 'refs';
753                 $routine = \&{'parse_' . $parse};
754                 $rname = "parse_$rname";
755         }
756         else {
757                 no strict 'refs';
758                 $routine = \&{"$parse"};
759         }
760
761         if(ref($routine) ne 'CODE') {
762                 config_error('Unknown parse routine %s', $rname);
763         }
764
765         return $routine;
766         
767 }
768
769 sub global_chunk {
770         my ($fn) = @_;
771
772         my $save_c = $C;
773         undef $C;
774
775         local $/;
776         $/ = "\n";
777
778
779         open GCHUNK, "< $fn"
780                 or config_error("read global chunk %s: %s", $fn, $!);
781
782 #::logDebug("GCHUNK length: " . -s $fn);
783         while(<GCHUNK>) {
784                 my $line = $_;
785                 my($lvar, $value) = read_config_value($_, \*GCHUNK);
786                 next unless $lvar;
787                 eval {
788                         $GlobalRead->($lvar, $value);
789                 };
790                 if ($@) {
791                         next if $@ =~ /Duplicate\s+usertag/i;
792                         ::logDebug("error running global $lvar: $@");
793                 }
794         }
795     close GCHUNK;
796
797         Vend::Dispatch::update_global_actions();
798         finalize_mapped_code();
799
800         $C = $save_c;
801         return 1;
802 }
803
804 sub code_from_file {
805         my ($area, $name, $nohup) = @_;
806         my $c;
807         my $fn;
808 #::logDebug("code_from_file $area, $name");
809         return unless $c = $Global::TagLocation->{$area};
810 #::logDebug("We have a repos for $area");
811         return unless $fn = $c->{$name};
812 #::logDebug("code_from_file found file=$fn");
813
814 #::logDebug("master reading in new area=$area name=$name fn=$fn") if $nohup;
815
816         local $/;
817         $/ = "\n";
818
819         undef $C;
820
821         my $tdir = $Global::TagDir->[0];
822         my $accdir = "$tdir/Accumulated";
823
824         my $newfn = $fn;
825         $newfn =~ s{^$Global::CodeRepository/*}{};
826
827         my $lfile = "$accdir/$newfn";
828         my $ldir = $lfile;
829         $ldir =~ s{/[^/]+$}{};
830         unless(-d $ldir) {
831                 die "Supposed directory $ldir is a file" if -e $ldir;
832                 File::Path::mkpath($ldir)
833                         or die "Cannot create directory $ldir: $!";
834         }
835
836         my $printnew;
837         if(-f $lfile) {
838                 ## This has already been submitted for master integration, no
839                 ## need to do it
840                 $nohup = 1;
841         }
842         else {
843                 open NEWTAG, ">> $lfile"
844                         or die "Cannot write new tag file $lfile: $!";
845                 if (lockfile(\*NEWTAG, 1, 0)) {
846                         ## We got a lock, we are the only one
847                         File::Copy::copy($fn, $lfile);
848                         unlockfile(\*NEWTAG);
849                         close NEWTAG;
850                 }
851                 else {
852                         ## No lock, some other process doing same thing
853                 }
854         }
855
856         open SYSTAG, "< $fn"
857                 or config_error("read system tag file %s: %s", $fn, $!);
858
859         while(<SYSTAG>) {
860                 my $line = $_;
861                 my($lvar, $value) = read_config_value($_, \*SYSTAG);
862                 next unless $lvar;
863                 eval {
864                         $GlobalRead->($lvar, $value);
865                 };
866                 next if $@ =~ /Duplicate\s+usertag/i;
867         }
868     close SYSTAG;
869     close NEWTAG;
870
871         finalize_mapped_code($area);
872
873         my $precursor = '';
874         my $routine;
875         my $init;
876         if($area eq 'UserTag') {
877                 $init = $Global::UserTag->{Bootstrap}{$name};
878                 $routine = $Global::UserTag->{Routine}{$name};
879 #::logDebug("NO ROUTINE FOR area=$area name=$name") unless $routine;
880         }
881         else {
882                 $precursor = 'CodeDef ';
883                 $init = $Global::CodeDef->{$area}{Bootstrap}{$name};
884                 $routine = $Global::CodeDef->{$area}{Routine}{$name};
885                 if(! $routine) {
886                         no strict 'refs';
887                         $routine = $Global::CodeDef->{$area}{MapRoutine}{$name}
888                                 and $routine = \&{"$routine"};
889                 }
890 #::logDebug("area=$area name=$name now=" . ::uneval($Global::CodeDef->{$area}));
891         }
892
893         if($init and ref($routine) eq 'CODE') {
894                 ## Attempt to initialize
895                 $init = get_option_hash($init);
896                 $routine->($init);
897         }
898
899
900         ## Tell the master server we have a new tag
901         unless($nohup) {
902 #::logDebug("notifying master of new area=$area name=$name fn=$fn");
903                 ## Bring this tag in global
904                 open(RESTART, ">>$Global::RunDir/restart")
905                                 or die "open $Global::RunDir/restart: $!\n";
906                 lockfile(\*RESTART, 1, 1)
907                                 or die "lock $Global::RunDir/restart: $!\n";
908                 print RESTART "$precursor$area $name\n";
909                 unlockfile(\*RESTART)
910                                 or die "unlock $Global::RunDir/restart: $!\n";
911                 close RESTART;
912                 kill 'HUP', $Vend::MasterProcess;
913         }
914
915 #::logDebug("routine=$routine for area=$area name=$name");
916 #::logDebug("REF IS=" . ::uneval($Global::UserTag)) if $nohup;
917         return $routine;
918 }
919
920 sub set_directive {
921         my ($directive, $value, $global) = @_;
922         my $directives;
923
924         if($global)     { $directives = global_directives(); }
925         else            { $directives = catalog_directives(); }
926
927         my ($d, $dir, $parse);
928         no strict 'refs';
929         foreach $d (@$directives) {
930                 next unless (lc $directive) eq (lc $d->[0]);
931                 $parse = get_parse_routine($d->[1]);
932                 $dir = $d->[0];
933                 $value = $parse->($dir, $value)
934                         if $parse;
935                 last;
936         }
937         return [$dir, $value] if defined $dir;
938         return undef;
939 }
940
941 sub get_catalog_default {
942         my ($directive) = @_;
943         my $directives = catalog_directives();
944         my $value;
945         for(@$directives) {
946                 next unless (lc $directive) eq (lc $_->[0]);
947                 $value = $_->[2];
948         }
949         return undef unless defined $value;
950         return $value;
951 }
952
953 sub get_global_default {
954         my ($directive) = @_;
955         my $directives = global_directives();
956         my $value;
957         for(@$directives) {
958                 next unless (lc $directive) eq (lc $_->[0]);
959                 $value = $_->[2];
960         }
961         return undef unless defined $value;
962         return $value;
963 }
964
965 sub evaluate_ifdef {
966         my ($ifdef, $reverse, $global) = @_;
967 #::logDebug("ifdef '$ifdef'");
968         my $status;
969         $ifdef =~ /^\s*(\@?)(\w+)\s*(.*)/;
970         $global = $1 || $global || undef;
971         my $var  = $2;
972         my $cond = $3;
973         my $var_ref = ! $global ? $C->{Variable} : $Global::Variable;
974 #::logDebug("Variable value '$var_ref->{$var}'");
975         if (! $cond) {
976                 $status = ! (not $var_ref->{$var});
977         }
978         elsif ($cond) {
979                 my $val = $var_ref->{$var} || '';
980                 my $safe = new Vend::Safe;
981                 my $code = "q{$val}" . " " . $cond;
982                 $status = $safe->reval($code);
983                 if($@) {
984                         config_warn(
985                                 errmsg("Syntax error in ifdef evaluation at line %s of %s",
986                                                 $.,
987                                                 $configfile,
988                                         ),
989                         );
990                         $status = '';
991                 }
992         }
993 #::logDebug("ifdef status '$status', reverse=" . !(not $reverse));
994         return $reverse ? ! $status : $status;
995 }
996
997 # This is what happens when ParseVariables is true
998 sub substitute_variable {
999         my($val) = @_;
1000         1 while $val =~ s/__([A-Z][A-Z_0-9]*?[A-Z0-9])__/$C->{Variable}->{$1}/g;
1001         # Only parse once for globals so they can contain other
1002         # global and catalog variables
1003         $val =~ s/\@\@([A-Z][A-Z_0-9]+[A-Z0-9])\@\@/$Global::Variable->{$1}/g;
1004         return $val;
1005 }
1006
1007 # Parse the configuration file for directives.  Each directive sets
1008 # the corresponding variable in the Vend::Cfg:: package.  E.g.
1009 # "DisplayErrors No" in the config file sets Vend::Cfg->{DisplayErrors} to 0.
1010 # Directives which have no defined default value ("undef") must be specified
1011 # in the config file.
1012
1013 my($directives, $directive, %parse);
1014
1015 sub config {
1016         my($catalog, $dir, $confdir, $subconfig, $existing, $passed_file) = @_;
1017         my($d, $parse, $var, $value, $lvar);
1018
1019         $Vend::Cat = $catalog;
1020
1021         if(ref $existing eq 'HASH') {
1022 #::logDebug("existing=$existing");
1023                 $C = $existing;
1024         }
1025         else {
1026                 undef $existing;
1027                 $C = {};
1028                 $C->{CatalogName} = $catalog;
1029                 $C->{VendRoot} = $dir;
1030
1031                 unless (defined $subconfig) {
1032                         $C->{ErrorFile} = 'error.log';
1033                         $C->{ConfigFile} = 'catalog.cfg';
1034                 }
1035                 else {
1036                         $C->{ConfigFile} = "$catalog.cfg";
1037                         $C->{BaseCatalog} = $subconfig;
1038                 }
1039         }
1040
1041         unless($directives) {
1042                 $directives = catalog_directives();
1043                 foreach $d (@$directives) {
1044                         my $ucdir = $d->[0];
1045                         $directive = lc $d->[0];
1046                         next if $Global::DeleteDirective->{$directive};
1047                         $CDname{$directive} = $ucdir;
1048                         $CPname{$directive} = $d->[1];
1049                         $parse{$directive} = get_parse_routine($d->[1]);
1050                 }
1051         }
1052
1053         for(keys %DirectiveAlias) {
1054                 my $k = lc $_;
1055                 my $v = $DirectiveAlias{$_};
1056                 my $lv = lc $v;
1057                 $CDname{$k} = $CDname{$lv};
1058                 $CPname{$k} = $CPname{$lv};
1059                 $parse{$k} = $parse{$lv};
1060         }
1061
1062         no strict 'refs';
1063
1064         if(! $subconfig and ! $existing ) {
1065                 foreach $d (@$directives) {
1066                         my $ucdir = $d->[0];
1067                         $directive = lc $d->[0];
1068                         next if $Global::DeleteDirective->{$directive};
1069                         $parse = $parse{$directive};
1070
1071                         $value = ( 
1072                                                 ! defined $MV::Default{$catalog} or
1073                                                 ! defined $MV::Default{$catalog}{$ucdir}
1074                                          )
1075                                          ? $d->[2]
1076                                          : $MV::Default{$catalog}{$ucdir};
1077
1078                         if (defined $parse and defined $value) {
1079 #::logDebug("parsing default directive=$directive ucdir=$ucdir parse=$parse value=$value CDname=$CDname{$directive}");
1080                                 $value = $parse->($ucdir, $value);
1081                         }
1082                         $C->{$CDname{$directive}} = $value;
1083                 }
1084         }
1085
1086         @include = ($passed_file || $C->{ConfigFile});
1087         my %include_hash = ($include[0] => 1);
1088         my $done_one;
1089         my ($db, $dname, $nm);
1090         my ($before, $after);
1091         my $recno = 'C0001';
1092
1093         my @hidden_config;
1094         if(! $existing and ! $subconfig) {
1095                 @hidden_config = grep -f $_, 
1096                                                                  "$C->{CatalogName}.site",
1097                                                                  "$Global::ConfDir/$C->{CatalogName}.before",
1098                                                                  @{$Global::ConfigAllBefore},
1099                                                          ;
1100
1101                 # Backwards because of unshift;
1102                 for (@hidden_config) {
1103                         unshift @include, $_;
1104                         $include_hash{$_} = 1;
1105                 }
1106
1107                 @hidden_config = grep -f $_, 
1108                                                                  "$Global::ConfDir/$C->{CatalogName}.after",
1109                                                                  @{$Global::ConfigAllAfter},
1110                                                          ;
1111
1112                 for (@hidden_config) {
1113                         push @include, $_;
1114                         $include_hash{$_} = 1;
1115                 }
1116         }
1117
1118         # %MV::Default holds command-line mods to config, which we write
1119         # to a file for easier processing 
1120         if(! $existing and defined $MV::Default{$catalog}) {
1121                 my $fn = "$Global::RunDir/$catalog.cmdline";
1122                 open(CMDLINE, ">$fn")
1123                         or die "Can't create cmdline configfile $fn: $!\n";
1124                 for(@{$MV::DefaultAry{$catalog}}) {
1125                         my ($d, $v) = split /\s+/, $_, 2;
1126                         if($v =~ /\n/) {
1127                                 $v = "<<EndOfMvD\n$v\nEndOfMvD\n";
1128                         }
1129                         else {
1130                                 $v .= "\n";
1131                         }
1132                         printf CMDLINE '%-19s %s', $d, $v;
1133                 }
1134                 close CMDLINE;
1135                 push @include, $fn;
1136                 $include_hash{$_} = 1;
1137         }
1138
1139         my $allcfg;
1140         if($Global::DumpAllCfg) {
1141                 open ALLCFG, ">$Global::RunDir/allconfigs.cfg"
1142                         and $allcfg = 1;
1143         }
1144         # Create closure that reads and sets config values
1145         my $read = sub {
1146                 my ($lvar, $value, $tie, $var) = @_;
1147
1148                 # parse variables in the value if necessary
1149                 if($C->{ParseVariables} and $value =~ /(?:__|\@\@)/) {
1150                         save_variable($CDname{$lvar}, $value);
1151                         $value = substitute_variable($value);
1152                 }
1153
1154                 # call the parsing function for this directive
1155                 $parse = $parse{$lvar};
1156                 $value = $parse->($CDname{$lvar}, $value) if defined $parse and ! $tie;
1157
1158                 # and set the $C->directive variable
1159                 if($tie) {
1160                         watch ( $CDname{$lvar}, $value );
1161                 }
1162                 else {
1163                         $C->{$CDname{$lvar}} = $value;
1164                 }
1165         };
1166
1167 #print "include starts with @include\n";
1168 CONFIGLOOP:
1169         while ($configfile = shift @include) {
1170                 my $tellmark;
1171                 if(ref $configfile) {
1172                         ($configfile, $tellmark)  = @$configfile;
1173 #print "recalling $configfile (pos $tellmark)\n";
1174                 }
1175
1176         # See if anything is defined in options to do before the
1177         # main configuration file.  If there is a file, then we
1178         # will do it (after pushing the main one on @include).
1179         
1180         -f $configfile && open(CONFIG, "< $configfile")
1181                 or do {
1182                         my $msg = "Could not open configuration file '" . $configfile .
1183                                         "' for catalog '" . $catalog . "':\n$!";
1184                         if(defined $done_one) {
1185                                 warn "$msg\n";
1186                                 open (CONFIG, '');
1187                         }
1188                         else {
1189                                 die "$msg\n";
1190                         }
1191                 };
1192         print ALLCFG "# READING FROM $configfile\n" if $allcfg;
1193         seek(CONFIG, $tellmark, 0) if $tellmark;
1194 #print "seeking to $tellmark in $configfile, include is @include\n";
1195         my ($ifdef, $begin_ifdef);
1196         while(<CONFIG>) {
1197                 if($allcfg) {
1198                         print ALLCFG $_
1199                                 unless /^\s*include\s+/i;
1200                 }
1201                 chomp;                  # zap trailing newline,
1202                 if(/^\s*endif\s*$/i) {
1203 #print "found $_\n";
1204                         undef $ifdef;
1205                         undef $begin_ifdef;
1206                         next;
1207                 }
1208                 if(/^\s*if(n?)def\s+(.*)/i) {
1209                         if(defined $ifdef) {
1210                                 config_error("Can't overlap ifdef at line %s of %s", $., $configfile);
1211                         }
1212                         $ifdef = evaluate_ifdef($2,$1);
1213                         $begin_ifdef = $.;
1214 #print "found $_\n";
1215                         next;
1216                 }
1217                 if(defined $ifdef) {
1218                         next unless $ifdef;
1219                 }
1220                 if(/^\s*include\s+(.+)/i) {
1221 #print "found $_\n";
1222                         my $spec = $1;
1223                         $spec = substitute_variable($spec) if $C->{ParseVariables};
1224                         if ($include_hash{$spec}) {
1225                                 config_error("Possible infinite loop through inclusion of $spec at line %s of %s, skipping", $., $configfile);
1226                                 next;
1227                         }
1228                         $include_hash{$spec} = 1;
1229                         my $ref = [ $configfile, tell(CONFIG)];
1230 #print "saving config $configfile (pos $ref->[1])\n";
1231                         #unshift @include, [ $configfile, tell(CONFIG) ];
1232                         unshift @include, $ref;
1233                         close CONFIG;
1234                         unshift @include, grep -f $_, glob($spec);
1235                         next CONFIGLOOP;
1236                 }
1237
1238                 my ($lvar, $value, $var, $tie) =
1239                         read_config_value($_, \*CONFIG, $allcfg);
1240
1241                 next unless $lvar;
1242
1243                 # Use our closure defined above
1244                 $read->($lvar, $value, $tie);
1245
1246                 # If we have passed off configuration to a database we stop here...
1247                 last if $C->{ConfigDatabase}->{ACTIVE};
1248
1249                 # See if we want to load the config database
1250                 if(! $db and $C->{ConfigDatabase}->{LOAD}) {
1251                         $db = $C->{ConfigDatabase}->{OBJECT}
1252                                 or config_error(
1253                                         "ConfigDatabase $C->{ConfigDatabase}->{'name'} not active.");
1254                         $dname = $C->{ConfigDatabase}{name};
1255                 }
1256
1257                 # Actually load ConfigDatabase if present
1258                 if($db) {
1259                         $nm = $CDname{$lvar};
1260                         my ($extended, $status);
1261                         undef $extended;
1262
1263                         # set directive name
1264                         $status = Vend::Data::set_field($db, $recno, 'directive', $nm);
1265                         defined $status
1266                                 or config_error(
1267                                         "ConfigDatabase failed for %s, field '%s'",
1268                                         $dname,
1269                                         'directive',
1270                                         );
1271
1272                         # use extended value field if necessary or directed
1273                         if (length($value) > 250 or $UseExtended{$nm}) {
1274                                 $extended = $value;
1275                                 $extended =~ s/(\S+)\s*//;
1276                                 $value = $1 || '';
1277                                 $status = Vend::Data::set_field($db, $recno, 'extended', $extended);
1278                                 defined $status
1279                                         or config_error(
1280                                                 "ConfigDatabase failed for %s, field '%s'",
1281                                                 $dname,
1282                                                 'extended',
1283                                                 );
1284                         }
1285
1286                         # set value -- just a name if extended was used
1287                         $status = Vend::Data::set_field($db, $recno, 'value', $value);
1288                         defined $status
1289                                 or config_error(
1290                                                 "ConfigDatabase failed for %s, field '%s'",
1291                                                 $dname,
1292                                                 'value',
1293                                         );
1294
1295                         $recno++;
1296                 }
1297                 
1298         }
1299         $done_one = 1;
1300         close CONFIG;
1301         delete $include_hash{$configfile};
1302
1303         # See if we have an active configuration database
1304         if($C->{ConfigDatabase}->{ACTIVE}) {
1305                 my ($key,$value,$dir,@val);
1306                 my $name = $C->{ConfigDatabase}->{name};
1307                 $db = $C->{ConfigDatabase}{OBJECT} or 
1308                         config_error("ConfigDatabase called ACTIVE with no database object.\n");
1309                 my $items = $db->array_query("select * from $name order by code");
1310                 my $one;
1311                 foreach $one ( @$items ) {
1312                         ($key, $dir, @val) = @$one;
1313                         $value = join " ", @val;
1314                         $value =~ s/\s/\n/ if $value =~ /\n/;
1315                         $value =~ s/^\s+//;
1316                         $value =~ s/\s+$//;
1317                         $lvar = lc $dir;
1318                         $read->($lvar, $value);
1319                 }
1320         }
1321
1322         if(defined $ifdef) {
1323                 config_error("Failed to close #ifdef on line %s.", $begin_ifdef);
1324         }
1325
1326 } # end CONFIGLOOP
1327
1328         # We need to make this directory if it isn't already there....
1329         if(! $existing and $C->{ScratchDir} and ! -e $C->{ScratchDir}) {
1330                 mkdir $C->{ScratchDir}, 0700
1331                         or die "Can't make temporary directory $C->{ScratchDir}: $!\n";
1332         }
1333
1334         return $C if $existing;
1335
1336         # check for unspecified directives that don't have default values
1337
1338         # but set some first if appropriate
1339         set_defaults() unless $C->{BaseCatalog};
1340
1341         REQUIRED: {
1342                 last REQUIRED if defined $subconfig;
1343                 last REQUIRED if defined $Vend::ExternalProgram;
1344                 foreach $var (keys %CDname) {
1345                         if (! defined $C->{$CDname{$var}}) {
1346                                 my $msg = errmsg(
1347                                         "Please specify the %s directive in the configuration file '%s'",
1348                                         $CDname{$var},
1349                                         ($passed_file || $C->{ConfigFile}),
1350                                 );
1351
1352                                 die "$msg\n";
1353                         }
1354                 }
1355         }
1356
1357         # Set up hash of keys to hide for BounceReferrals and BounceReferralsRobot
1358         $C->{BounceReferrals_hide} = { map { ($_, 1) } grep { !(/^cookie-/ or /^session(?:$|-)/) } @{$C->{SourcePriority}} };
1359         my @exclude = qw( mv_form_charset mv_session_id mv_tmp_session );
1360         @{$C->{BounceReferrals_hide}}{@exclude} = (1) x @exclude;
1361
1362         finalize_mapped_code();
1363
1364         set_readonly_config();
1365         # Ugly legacy stuff so API won't break
1366         $C->{Special} = $C->{SpecialPage} if defined $C->{SpecialPage};
1367         my $return = $C;
1368         undef $C;
1369         return $return;
1370 }
1371
1372 sub read_container {
1373         my($start, $handle, $marker, $parse, $allcfg) = @_;
1374         my $lvar = lc $marker;
1375         my $var = $CDname{$lvar};
1376
1377 #::logDebug("Read container start=$start marker=$marker lvar=$lvar var=$var parse=$parse");
1378         $parse ||= {};
1379 #::logDebug("Read container parse value=$CPname{$lvar}");
1380         my $sub = $ContainerSpecial{$var}
1381                           || $ContainerSpecial{$lvar}
1382                           || $ContainerType{$CPname{$lvar}};
1383
1384         if($sub) {
1385 #::logDebug("Trigger special container");
1386                 $start =~ s/\n$//;
1387                 $sub->($var, $start);
1388                 $ContainerTrigger{$lvar} ||= $sub;
1389                 return $start;
1390         }
1391         
1392         my $foundeot = 0;
1393         my $startline = $.;
1394         my $value = '';
1395         if(length $start) {
1396                 $value .= "$start\n";
1397         }
1398         while (<$handle>) {
1399                 print ALLCFG $_ if $allcfg;
1400                 if ($_ =~ m{^\s*</$marker>\s*$}i) {
1401                         $foundeot = 1;
1402                         last;
1403                 }
1404                 $value .= $_;
1405         }
1406         return undef unless $foundeot;
1407         #untaint
1408         $value =~ /((?s:.)*)/;
1409         $value = $1;
1410         return $value;
1411 }
1412
1413 sub read_here {
1414         my($handle, $marker, $allcfg) = @_;
1415         my $foundeot = 0;
1416         my $startline = $.;
1417         my $value = '';
1418         while (<$handle>) {
1419                 print ALLCFG $_ if $allcfg;
1420                 if ($_ =~ m{^$marker$}) {
1421                         $foundeot = 1;
1422                         last;
1423                 }
1424                 $value .= $_;
1425         }
1426         return undef unless $foundeot;
1427         #untaint
1428         $value =~ /((?s:.)*)/;
1429         $value = $1;
1430         return $value;
1431 }
1432
1433 sub config_named_catalog {
1434         my ($cat_name, $source, $db_only, $dbconfig) = @_;
1435         my ($g, $c);
1436
1437         $g = $Global::Catalog{$cat_name};
1438         unless (defined $g) {
1439                 logGlobal( "Can't find catalog '%s'" , $cat_name );
1440                 return undef;
1441         }
1442
1443         $Vend::Log_suppress = 1;
1444
1445         unless ($db_only or $Vend::Quiet) {
1446                 logGlobal( "Config '%s' %s%s", $g->{'name'}, $source );
1447         }
1448         undef $Vend::Log_suppress;
1449
1450     chdir $g->{'dir'}
1451             or die "Couldn't change to $g->{'dir'}: $!\n";
1452
1453         if($db_only) {
1454                 logGlobal(
1455                         "Config table '%s' (file %s) for catalog %s from %s",
1456                         $db_only,
1457                         $dbconfig,
1458                         $g->{'name'},
1459                         $source,
1460                         );
1461                 my $cfg = $Global::Selector{$g->{script}}
1462                         or die errmsg("'%s' not a catalog (%s).", $g->{name}, $g->{script});
1463                 undef $cfg->{Database}{$db_only};
1464                 $Vend::Cfg = config(
1465                                 $g->{name},
1466                                 $g->{dir},
1467                                 undef,
1468                                 undef,
1469                                 $cfg,
1470                                 $dbconfig,
1471                                 )
1472                         or die errmsg("error configuring catalog %s table %s: %s",
1473                                                         $g->{name},
1474                                                         $db_only,
1475                                                         $@,
1476                                         );
1477                 open_database();
1478                 close_database();
1479                 return $Vend::Cfg;
1480         }
1481
1482     eval {
1483         $c = config($g->{'name'},
1484                                         $g->{'dir'},
1485                                         undef,
1486                                         $g->{'base'} || undef,
1487 # OPTION_EXTENSION
1488 #                                       $Vend::CommandLine->{$g->{'name'}} || undef
1489 # END OPTION_EXTENSION
1490                                         );
1491     };
1492
1493     if($@) {
1494                 my $msg = $@;
1495         logGlobal( "%s config error: %s" , $g->{'name'}, $msg );
1496         return undef;
1497     }
1498
1499         if (defined $g->{base}) {
1500                 open_database(1);
1501                 dump_structure($c, "$c->{RunDir}/$g->{name}") if $Global::DumpStructure;
1502                 return $c;
1503         }
1504
1505         eval {
1506                 $Vend::Cfg = $c;        
1507                 $::Variable = $Vend::Cfg->{Variable};
1508                 $::Pragma   = $Vend::Cfg->{Pragma};
1509                 Vend::Data::read_salestax();
1510                 Vend::Data::read_shipping();
1511                 open_database(1);
1512                 my $db;
1513                 close_database();
1514         };
1515
1516         undef $Vend::Cfg;
1517     if($@) {
1518                 my $msg = $@;
1519                 $msg =~ s/\s+$//;
1520         logGlobal( "%s config error: %s" , $g->{'name'}, $msg );
1521         return undef;
1522     }
1523
1524         dump_structure($c, "$c->{RunDir}/$g->{name}") if $Global::DumpStructure;
1525
1526     my $status_dir = ($c->{Source}{RunDir} ? $c->{RunDir} : $c->{ConfDir});
1527
1528         delete $c->{Source};
1529
1530         my $stime = scalar localtime();
1531         writefile(">$Global::RunDir/status.$g->{name}", "$stime\n$g->{dir}\n");
1532         writefile(">$status_dir/status.$g->{name}", "$stime\n");
1533
1534         return $c;
1535
1536 }
1537
1538
1539 use File::Find;
1540
1541 sub get_system_groups {
1542
1543         my @files;
1544         my $wanted = sub {
1545                 return if (m{^\.} || ! -f $_);
1546                 $File::Find::name =~ m{/([^/]+)/([^/.]+)\.(\w+)$}
1547                         or return;
1548                 my $group = $1;
1549                 my $tname = $2;
1550                 my $ext = $extmap{lc $3} or return;
1551                 $ext =~ /Tag$/ or return;
1552                 push @files, [ $group, $tname ];
1553         };
1554         File::Find::find({ wanted => $wanted, follow => 1 }, @$Global::TagDir);
1555
1556         $Global::TagGroup ||= {};
1557         for(@files) {
1558                 my $g = $Global::TagGroup->{":$_->[0]"} ||= [];
1559                 push @$g, $_->[1];
1560         }
1561         return;
1562 }
1563
1564 sub get_repos_code {
1565
1566 #::logDebug("get_repos_code called");
1567         return unless $Global::CodeRepository;
1568
1569         return if $Vend::ControllingInterchange;
1570         
1571         my @files;
1572         my $wanted = sub {
1573                 return if (m{^\.} || ! -f $_);
1574                 return unless m{^[^.]+\.(\w+)$};
1575                 my $ext = $extmap{lc $1} or return;
1576                 push @files, [ $File::Find::name, $ext];
1577         };
1578         File::Find::find({ wanted => $wanted, follow => 1 }, $Global::CodeRepository);
1579
1580         my $c = $Global::TagLocation = {};
1581
1582         # %valid_dest is scoped as my variable above
1583
1584         for(@files) {
1585                 my $foundfile   = $_->[0];
1586                 my $dest                = $_->[1];
1587                 open SYSTAG, "< $foundfile"
1588                         or next;
1589                 while(<SYSTAG>) {
1590                         my($lvar, $value) = read_config_value($_, \*SYSTAG);
1591                         my $name;
1592                         my $dest;
1593                         if($lvar eq 'codedef') {
1594                                 $value =~ s/^(\S+)\s+(\S+).*//s;
1595                                 $dest = $valid_dest{lc $2};
1596                                 $name = $1;
1597                         }
1598                         elsif($dest = $valid_dest{$lvar}) {
1599                                 $value =~ m/^(\S+)\s+/
1600                                 and $name = $1;
1601                         }
1602
1603                         next unless $dest and $name;
1604
1605                         $name = lc $name;
1606                         $name =~ s/-/_/g;
1607                         $c->{$dest} ||= {};
1608                         $c->{$dest}{$name} ||= $foundfile;
1609                 }
1610                 close SYSTAG;
1611         }
1612
1613 #::logDebug("repos is:\n" . ::uneval($Global::TagLocation));
1614
1615 }
1616
1617 sub get_system_code {
1618
1619         return if $CodeDest;
1620         return if $Vend::ControllingInterchange;
1621         
1622         # defined means don't go here anymore
1623         $SystemCodeDone = '';
1624         my @files;
1625         my $wanted = sub {
1626                 return if (m{^\.} || ! -f $_);
1627                 return unless m{^[^.]+\.(\w+)$};
1628                 my $ext = $extmap{lc $1} or return;
1629                 push @files, [ $File::Find::name, $ext];
1630         };
1631         File::Find::find({ wanted => $wanted, follow => 1 }, @$Global::TagDir);
1632
1633         local($configfile);
1634         for(@files) {
1635                 $CodeDest = $_->[1];
1636
1637                 $configfile = $_->[0];
1638                 open SYSTAG, "< $configfile"
1639                         or config_error("read system tag file %s: %s", $configfile, $!);
1640                 while(<SYSTAG>) {
1641                         my($lvar, $value) = read_config_value($_, \*SYSTAG);
1642                         next unless $lvar;
1643                         $GlobalRead->($lvar, $value);
1644                 }
1645                 close SYSTAG;
1646         }
1647
1648         undef $CodeDest;
1649         # 1 means read system tag directories
1650         $SystemCodeDone = 1;
1651 }
1652
1653 sub read_config_value {
1654         local($_) = shift;
1655         return undef unless $_;
1656         my ($fh, $allcfg) = @_;
1657
1658         my $lvar;
1659         my $tie;
1660
1661         chomp;                  # zap trailing newline,
1662         s/^\s*#.*//;            # comments,
1663                                 # mh 2/10/96 changed comment behavior
1664                                 # to avoid zapping RGB values
1665                                 #
1666         s/\s+$//;               #  trailing spaces
1667         return undef unless $_;
1668
1669         local($Vend::config_line);
1670         $Vend::config_line = $_;
1671         my $container_here;
1672         my $container_trigger;
1673         my $var;
1674         my $value;
1675
1676         if(s{^[ \t]*<(/?)(\w+)\s*(.*)\s*>\s*$}{$2$3}) {
1677                 $container_trigger = $1;
1678                 $var = $container_here = $2;
1679                 $value = $3;
1680         }
1681         else {
1682                 # lines read from the config file become untainted
1683                 m/^[ \t]*(\w+)\s+(.*)/ or config_error("Syntax error from $_");
1684                 $var = $1;
1685                 $value = $2;
1686         }
1687         ($lvar = $var) =~ tr/A-Z/a-z/;
1688
1689         config_error("Unknown directive '%s'", $lvar), next
1690                 unless defined $CDname{$lvar};
1691
1692         my($codere) = '[-\w_#/.]+';
1693
1694         if ($container_trigger) {                  # Apache container value
1695                 if(my $sub = $ContainerTrigger{$lvar}) {
1696                         $sub->($var, $value, 1);
1697                         return;
1698                 }
1699         }
1700
1701         if ($container_here) {                  # Apache container value
1702                 my $begin  = $value;
1703                 $begin .= "\n" if length $begin;
1704                 my $mark = "</$container_here>";
1705                 my $startline = $.;
1706                 $value = read_container($begin, $fh, $container_here, \%parse);
1707                 unless (defined $value) {
1708                         config_error (sprintf('%d: %s', $startline,
1709                                 qq#no end contaner ("</$container_here>") found#));
1710                 }
1711         }
1712         elsif ($value =~ /^(.*)<<(\w+)\s*/) {                  # "here" value
1713                 my $begin  = $1 || '';
1714                 $begin .= "\n" if $begin;
1715                 my $mark = $2;
1716                 my $startline = $.;
1717                 $value = $begin . read_here($fh, $mark);
1718                 unless (defined $value) {
1719                         config_error (sprintf('%d: %s', $startline,
1720                                 qq#no end marker ("$mark") found#));
1721                 }
1722         }
1723         elsif ($value =~ /^(.*)<&(\w+)\s*/) {                # "here sub" value
1724                 my $begin  = $1 || '';
1725                 $begin .= "\n" if $begin;
1726                 my $mark  = $2;
1727                 my $startline = $.;
1728                 $value = $begin . read_here($fh, $mark, $allcfg);
1729                 unless (defined $value) {
1730                         config_error (sprintf('%d: %s', $startline,
1731                                 qq#no end marker ("$mark") found#));
1732                 }
1733                 eval {
1734                         require Tie::Watch;
1735                 };
1736                 unless ($@) {
1737                         $tie = 1;
1738                 }
1739                 else {
1740                         config_warn(
1741                                 "No Tie::Watch module installed at %s, setting %s to default.",
1742                                 $startline,
1743                                 $var,
1744                         );
1745                         $value = '';
1746                 }
1747         }
1748         elsif ($value =~ /^(\S+)?(\s*)?<\s*($codere)$/o) {   # read from file
1749                 my $confdir = $C ? $C->{ConfigDir} : $Global::ConfigDir;
1750                 $value = $1 || '';
1751                 my $file = $3;
1752                 $value .= "\n" if $value;
1753                 unless ($confdir) {
1754                         config_error(
1755                                 "%s: Can't read from file until ConfigDir defined",
1756                                 $CDname{$lvar},
1757                         );
1758                 }
1759                 $file = $CDname{$lvar} unless $file;
1760                 
1761                 # If the file isn't already specified with an absolute path, try the 
1762                 # Config directory, then the current directory.  When neither file
1763                 # exists, use the Config directory and continue.
1764                 if ($file !~ m!^/!) {
1765                         my $test_with_confdir = escape_chars("$confdir/$file");
1766                         if (-f $test_with_confdir) {
1767                                 $file = $test_with_confdir;
1768                         }
1769                         else {
1770                                 my $test_without_confdir = escape_chars($file);
1771                                 if (-f $test_without_confdir) {
1772                                         $file = $test_without_confdir;
1773                                 }
1774                                 else {
1775                                         $file = $test_with_confdir;
1776                                 }
1777                         }
1778                 }
1779                  
1780                 my $tmpval = readfile($file);
1781                 unless( defined $tmpval ) {
1782                         config_warn(
1783                                         "%s: read from non-existent file %s, skipping.",
1784                                         $CDname{$lvar},
1785                                         $file,
1786                         );
1787                         return undef;
1788                 }
1789                 chomp($tmpval) unless $tmpval =~ m!.\n.!;
1790                 $value .= $tmpval;
1791         }
1792         return($lvar, $value, $var, $tie);
1793 }
1794
1795 # Parse the global configuration file for directives.  Each directive sets
1796 # the corresponding variable in the Global:: package.  E.g.
1797 # "DisplayErrors No" in the config file sets Global::DisplayErrors to 0.
1798 # Directives which have no default value ("undef") must be specified
1799 # in the config file.
1800 sub global_config {
1801         my(%parse, $var, $value, $lvar, $parse);
1802         my($directive, $seen_catalog);
1803         no strict 'refs';
1804
1805         %CDname = ();
1806         %CPname = ();
1807
1808         my $directives = global_directives();
1809
1810         $Global::Structure = {} unless $Global::Structure;
1811
1812         # Prevent parsers from thinking it is a catalog
1813         undef $C;
1814
1815         foreach my $d (@$directives) {
1816                 $directive = lc $d->[0];
1817                 $CDname{$directive} = $d->[0];
1818                 $CPname{$directive} = $d->[1];
1819                 $parse = get_parse_routine($d->[1]);
1820                 $parse{$directive} = $parse;
1821                 undef $value;
1822                 $value = ( 
1823                                         ! defined $MV::Default{mv_global} or
1824                                         ! defined $MV::Default{mv_global}{$d->[0]}
1825                                  )
1826                                  ? $d->[2]
1827                                  : $MV::Default{mv_global}{$d->[0]};
1828
1829                 if (defined $DumpSource{$CDname{$directive}}) {
1830                         $Global::Structure->{ $CDname{$directive} } = $value;
1831                 }
1832
1833                 if (defined $parse and defined $value) {
1834                         $value = $parse->($d->[0], $value);
1835                 }
1836
1837                 if(defined $value) {
1838                         ${'Global::' . $CDname{$directive}} = $value;
1839
1840                         $Global::Structure->{ $CDname{$directive} } = $value
1841                                 unless defined $DontDump{ $CDname{$directive} };
1842                 }
1843
1844         }
1845
1846         my (@include) = $Global::ConfigFile; 
1847
1848         # Create closure for reading of value
1849
1850         my $read = sub {
1851                 my ($lvar, $value, $tie) = @_;
1852
1853 #::logDebug("Doing a GlobalRead for $lvar") unless $Global::Foreground;
1854                 unless (defined $CDname{$lvar}) {
1855                         config_error("Unknown directive '%s'", $var);
1856                         return;
1857                 }
1858
1859 #::logDebug("Continuing a GlobalRead for $lvar") unless $Global::Foreground;
1860                 if (defined $DumpSource{$CDname{$directive}}) {
1861                         $Global::Structure->{ $CDname{$directive} } = $value;
1862                 }
1863
1864                 # call the parsing function for this directive
1865                 $parse = $parse{$lvar};
1866 #::logDebug("parse routine is $parse for $CDname{$lvar}") unless $Global::Foreground;
1867                 $value = $parse->($CDname{$lvar}, $value) if defined $parse;
1868
1869                 # and set the Global::directive variable
1870                 ${'Global::' . $CDname{$lvar}} = $value;
1871 #::logDebug("It is now=" . ::uneval($value)) unless $Global::Foreground;
1872                 $Global::Structure->{ $CDname{$lvar} } = $value
1873                         unless defined $DontDump{ $CDname{$lvar} };
1874         };
1875
1876         $GlobalRead = $read;
1877         my $done_one;
1878 GLOBLOOP:
1879         while ($configfile = shift @include) {
1880                 my $tellmark;
1881                 if(ref $configfile) {
1882                         ($configfile, $tellmark)  = @$configfile;
1883 #print "recalling $configfile (pos $tellmark)\n";
1884                 }
1885
1886         -f $configfile && open(GLOBAL, "< $configfile")
1887                 or do {
1888                         my $msg = errmsg(
1889                                                 "Could not open global configuration file '%s': %s",
1890                                                 $configfile,
1891                                                 $!,
1892                                                 );
1893                         if(defined $done_one) {
1894                                 warn "$msg\n";
1895                                 open (GLOBAL, '');
1896                         }
1897                         else {
1898                                 die "$msg\n";
1899                         }
1900                 };
1901         seek(GLOBAL, $tellmark, 0) if $tellmark;
1902 #print "seeking to $tellmark in $configfile, include is @include\n";
1903         my ($ifdef, $begin_ifdef);
1904         while(<GLOBAL>) {
1905                 if(/^\s*endif\s*$/i) {
1906 #print "found $_";
1907                         undef $ifdef;
1908                         undef $begin_ifdef;
1909                         next;
1910                 }
1911                 if(/^\s*if(n?)def\s+(.*)/i) {
1912 #print "found $_";
1913                         if(defined $ifdef) {
1914                                 config_error(
1915                                         "Can't overlap ifdef at line %s of %s",
1916                                         $.,
1917                                         $configfile,
1918                                 );
1919                         }
1920                         $ifdef = evaluate_ifdef($2,$1,1);
1921                         $begin_ifdef = $.;
1922                         next;
1923                 }
1924                 if(defined $ifdef) {
1925                         next unless $ifdef;
1926                 }
1927                 if(/^\s*include\s+(.+)/) {
1928 #print "found $_";
1929                         my $spec = $1;
1930                         my $ref = [ $configfile, tell(GLOBAL)];
1931 #print "saving config $configfile (pos $ref->[1])\n";
1932                         unshift @include, $ref;
1933                         close GLOBAL;
1934                         chomp;
1935                         unshift @include, grep -f $_, glob($spec);
1936                         next GLOBLOOP;
1937                 }
1938
1939                 my ($lvar, $value, $tie) = read_config_value($_, \*GLOBAL);
1940                 next unless $lvar;
1941                 $read->($lvar, $value, $tie);
1942
1943         }
1944         close GLOBAL;
1945         $done_one = 1;
1946 } # end GLOBLOOP;
1947
1948         # In case no user-supplied config has been given...returns
1949         # with no effect if that has been done already.
1950         get_system_code() unless defined $SystemCodeDone;
1951
1952         # Directive post-processing
1953         global_directive_postprocess();
1954
1955         # Do some cleanup
1956         set_global_defaults();
1957
1958         # check for unspecified directives that don't have default values
1959         foreach $var (keys %CDname) {
1960                 last if defined $Vend::ExternalProgram;
1961                 if (!defined ${'Global::' . $CDname{$var}}) {
1962                         die "Please specify the $CDname{$var} directive in the\n" .
1963                         "configuration file '$Global::ConfigFile'\n";
1964                 }
1965         }
1966
1967         # Inits Global UserTag entries
1968         ADDTAGS: {
1969                 Vend::Parse::global_init;
1970         }
1971
1972         ## Pulls in the places where code can be found when AccumulatingTags
1973         get_repos_code() if $Global::AccumulateCode;
1974
1975         finalize_mapped_code();
1976
1977         dump_structure($Global::Structure, "$Global::RunDir/$Global::ExeName")
1978                 if $Global::DumpStructure and ! $Vend::ExternalProgram;
1979
1980         delete $Global::Structure->{Source};
1981
1982         %CDname = ();
1983         return 1;
1984 }
1985
1986 # Use Tie::Watch to attach subroutines to config variables
1987 sub watch {
1988         my($name, $value) = @_;
1989         $C->{Tie_Watch} = [] unless $C->{Tie_Watch};
1990         push @{$C->{Tie_Watch}}, $name;
1991
1992         my ($ref, $orig);
1993 #::logDebug("Contents of $name: " . uneval_it($C->{$name}));
1994         if(CORE::ref($C->{$name}) =~ /ARRAY/) {
1995 #::logDebug("watch ref=array");
1996                 $ref = $C->{$name};
1997                 $orig = [ @{ $C->{$name} } ];
1998         }
1999         elsif(CORE::ref($C->{$name}) =~ /HASH/) {
2000 #::logDebug("watch ref=hash");
2001                 $ref = $C->{$name};
2002                 $orig = { %{ $C->{$name} } };
2003         }
2004         else {
2005 #::logDebug("watch ref=scalar");
2006                 $ref = \$C->{$name};
2007                 $orig = $C->{$name};
2008         }
2009 #::logDebug("watch ref=$ref orig=$orig name=$name value=$value");
2010         $C->{WatchIt} = { _mvsafe => $C->{ActionMap}{_mvsafe} } if ! $C->{WatchIt};
2011         parse_action('WatchIt', "$name $value");
2012         my $coderef = $C->{WatchIt}{$name}
2013                 or return undef;
2014         my $recode = sub {
2015                                         package Vend::Interpolate;
2016                                         init_calc();
2017                                         my $key = $_[0]->Args(-fetch)->[0];
2018                                         return $coderef->(@_, $key);
2019                                 };
2020         package Vend::Interpolate;
2021         $Vend::Config::C->{WatchIt}{$name} = Tie::Watch->new(
2022                                         -variable => $ref,
2023                                         -fetch => [$recode,$orig],
2024                                         );
2025 }
2026
2027 sub get_wildcard_list {
2028         my($var, $value, $base) = @_;
2029
2030         $value =~ s/\s*#.*?$//mg;
2031         $value =~ s/^\s+//;
2032         $value =~ s/\s+$//;
2033         return '' if ! $value;
2034
2035         if($value !~ /\|/) {
2036                 $value =~ s/([\\\+\|\[\]\(\){}])/\\$1/g;
2037                 $value =~ s/\./\\./g;
2038                 $value =~ s/\*/.*/g;
2039                 $value =~ s/\?/./g;
2040                 my @items = grep /\S/, split /\s*,\s*/, $value;
2041                 for (@items) {
2042                         s/\s+/\\s+/g;
2043                         my $extra = $_;
2044                         if ($base && $extra =~ s/^\.\*\\\.//){
2045                                 push(@items,$extra) if $extra;
2046                         }
2047                 }
2048                 $value = join '|', @items;
2049         }
2050         return parse_regex($var, $value);
2051 }
2052
2053 sub external_global {
2054         my ($value) = @_;
2055
2056         my $main = {};
2057
2058         my @sets = grep /\w/, split /[\s,]+/, $value;
2059 #::logDebug( "Parsing sets=" . join(",", @sets) . "\n" );
2060
2061         no strict 'refs';
2062
2063         for my $set (@sets) {
2064 #::logDebug( "Parsing $set\n" );
2065                 my @keys = split /->/, $set;
2066                 my ($k, $v) = split /=/, $keys[0];
2067                 my $major;
2068                 my $var;
2069                 if($k =~ m/^(\w+)::(\w+)$/) {
2070                         $major = $1;
2071                         $var = $2;
2072                 }
2073                 $major ||= 'Global';
2074                 $v ||= $var;
2075                 my $walk = ${"${major}::$var"};
2076                 my $ref = $main->{$v} = $walk;
2077                 for(my $i = 1; $i < @keys; $i++) {
2078                         my $current = $keys[$i];
2079 #::logDebug( "Walking $current\n" );
2080                         if($i == $#keys) {
2081                                 if( CORE::ref($ref) eq 'ARRAY' ) {
2082                                         $current =~ s/\D+//g;
2083                                         $current =~ /^\d+$/
2084                                                 or config_error("External: Bad array index $current from $set");
2085                                         $ref->[$current] = $walk->[$current];
2086 #::logDebug( "setting $current to ARRAY\n" );
2087                                 }
2088                                 elsif( CORE::ref($ref) eq 'HASH' ) {
2089                                         $ref->{$current} = $walk->{$current};
2090 #::logDebug( "setting $current to HASH\n" );
2091                                 }
2092                                 else {
2093                                         config_error("External: bad data structure for $set");
2094                                 }
2095                         }
2096                         else {
2097                                 $walk = $walk->{$current};
2098 #::logDebug( "Walking $current\n" );
2099                                 if( CORE::ref($walk) eq 'HASH' ) {
2100                                         $ref->{$current} = {};
2101                                         $ref = $ref->{$current};
2102                                 }
2103                                 else {
2104                                         config_error("External: bad data structure for $set");
2105                                 }
2106                         }
2107                 }
2108         }
2109         return $main;
2110 }
2111
2112 # Set the External environment, dumps, etc.
2113 sub external_cat {
2114         my ($value) = @_;
2115
2116         my $c = $C
2117                 or config_error( "Not in catalog configuration context." );
2118
2119         my $main = {};
2120         my @sets = grep /\w/, split /[\s,]+/, $value;
2121         for my $set (@sets) {
2122                 my @keys = split /->/, $set;
2123                 my $ref  = $main;
2124                 my $walk = $c;
2125                 for(my $i = 0; $i < @keys; $i++) {
2126                         my $current = $keys[$i];
2127                         if($i == $#keys) {
2128                                 if( CORE::ref($ref) eq 'ARRAY' ) {
2129                                         $current =~ s/\D+//g;
2130                                         $current =~ /^\d+$/
2131                                                 or config_error("External: Bad array index $current from $set");
2132                                         $ref->[$current] = $walk->[$current];
2133                                 }
2134                                 elsif( CORE::ref($ref) eq 'HASH' ) {
2135                                         $ref->{$current} = $walk->{$current};
2136                                 }
2137                                 else {
2138                                         config_error("External: bad data structure for $set");
2139                                 }
2140                         }
2141                         else {
2142                                 $walk = $walk->{$current};
2143                                 if( CORE::ref($walk) eq 'HASH' ) {
2144                                         $ref->{$current} ||= {};
2145                                         $ref = $ref->{$current};
2146                                 }
2147                                 else {
2148                                         config_error("External: bad data structure for $set");
2149                                 }
2150                         }
2151                 }
2152         }
2153
2154         return $main;
2155 }
2156
2157 # Set up an ActionMap or FormAction or FileAction
2158 sub parse_action {
2159         my ($var, $value, $mapped) = @_;
2160         if (! $value) {
2161                 return $InitializeEmpty{$var} ? '' : {};
2162         }
2163
2164         return if $Vend::ExternalProgram;
2165
2166         my $c;
2167         if($mapped) {
2168                 $c = $mapped;
2169         }
2170         elsif(defined $C) {
2171                 $c = $C->{$var} ||= {};
2172         }
2173         else {
2174                 no strict 'refs';
2175                 $c = ${"Global::$var"} ||= {};
2176         }
2177
2178         if (defined $C and ! $c->{_mvsafe}) {
2179                 my $calc = Vend::Interpolate::reset_calc();
2180                 $c->{_mvsafe} = $calc;
2181         }
2182         my ($name, $sub) = split /\s+/, $value, 2;
2183
2184         $name =~ s/-/_/g;
2185         
2186         ## Determine if we are in a catalog config, and if 
2187         ## perl should be global and/or strict
2188         my $nostrict;
2189         my $perlglobal = 1;
2190
2191         if($C) {
2192                 $nostrict = $Global::PerlNoStrict->{$C->{CatalogName}};
2193                 $perlglobal = $Global::AllowGlobal->{$C->{CatalogName}};
2194         }
2195
2196         # Untaint and strip this pup
2197         $sub =~ s/^\s*((?s:.)*\S)\s*//;
2198         $sub = $1;
2199
2200         # clear errors for code paths below that don't call eval or reval
2201         undef $@;
2202         if($sub !~ /\s/) {
2203                 no strict 'refs';
2204                 if($sub =~ /::/ and ! $C) {
2205                         $c->{$name} = \&{"$sub"};
2206                 }
2207                 else {
2208                         if($C and $C->{Sub}) {
2209                                 $c->{$name} = $C->{Sub}{$sub};
2210                         }
2211
2212                         if(! $c->{$name} and $Global::GlobalSub) {
2213                                 $c->{$name} = $Global::GlobalSub->{$sub};
2214                         }
2215                 }
2216                 if(! $c->{$name} and $AllowScalarAction{$var}) {
2217                         $c->{$name} = $sub;
2218                 }
2219                 elsif(! $c->{$name}) {
2220                         $@ = errmsg("Mapped %s action routine '%s' is non-existent.", $var, $sub);
2221                 }
2222         }
2223         elsif ( ! $mapped and $sub !~ /^sub\b/) {
2224                 if($AllowScalarAction{$var}) {
2225                         $c->{$name} = $sub;
2226                 }
2227                 else {
2228                         my $code = <<EOF;
2229 sub {
2230                                 return Vend::Interpolate::interpolate_html(<<EndOfThisHaiRYTHING);
2231 $sub
2232 EndOfThisHaiRYTHING
2233 }
2234 EOF
2235                         $c->{$name} = eval $code;
2236                 }
2237         }
2238         elsif ($perlglobal) {
2239                 package Vend::Interpolate;
2240                 if($nostrict) {
2241                         no strict;
2242                         $c->{$name} = eval $sub;
2243                 }
2244                 else {
2245                         $c->{$name} = eval $sub;
2246                 }
2247         }
2248         else {
2249                 package Vend::Interpolate;
2250                 $c->{$name} = $c->{_mvsafe}->reval($sub);
2251         }
2252         if($@) {
2253                 config_warn("Action '%s' did not compile correctly (%s).", $name, $@);
2254         }
2255         return $c;
2256         
2257 }
2258
2259 sub get_directive {
2260         my $name = shift;
2261         $name = $CDname{lc $name} || $name;
2262         no strict 'refs';
2263         if($C) {
2264                 return $C->{$name};
2265         }
2266         else {
2267                 return ${"Global::$name"};
2268         }
2269 }
2270
2271 # Adds features contained in FeatureDir called by catalog
2272
2273 sub parse_feature {
2274         my ($var, $value) = @_;
2275         my $c = $C->{$var} || {};
2276         return $c unless $value;
2277
2278         $value =~ s/^\s+//;
2279         $value =~ s/\s+$//;
2280         my $fdir = Vend::File::catfile($Global::FeatureDir, $value);
2281
2282         unless(-d $fdir) {
2283                 config_warn("Feature '%s' not found, skipping.", $value);
2284                 return $c;
2285         }
2286
2287         # Get the global install files and remove them from the config list
2288         my @gfiles = glob("$fdir/*.global");
2289         my %seen;
2290         @seen{@gfiles} = @gfiles;
2291
2292         # Get the init files and remove them from the config list
2293         my @ifiles = glob("$fdir/*.init");
2294         @seen{@ifiles} = @ifiles;
2295
2296         # Get the uninstall files and remove them from the config list
2297         my @ufiles = glob("$fdir/*.uninstall");
2298         @seen{@ufiles} = @ifiles;
2299
2300         # Any other files are config files
2301         my @cfiles = grep ! $seen{$_}++, glob("$fdir/*");
2302
2303         # directories are for copying
2304         my @cdirs = grep -d $_, @cfiles;
2305
2306         # strip the directories from the config list, leaving catalog.cfg stuff
2307         @cfiles   = grep -f $_, @cfiles;
2308
2309         # Don't install global more than once
2310         @gfiles = grep ! $Global::FeatureSeen{$_}++, @gfiles;
2311
2312         # Place the catalog configuration in the config list
2313         unshift @include, @cfiles;
2314
2315         my @copy;
2316         my $wanted = sub {
2317                 return unless -f $_;
2318                 my $n = $File::Find::name;
2319                 $n =~ s{^$fdir/}{};
2320                 my $d = $File::Find::dir;
2321                 $d =~ s{^$fdir/}{};
2322                 push @copy, [$n, $d];
2323         };
2324
2325         if(@cdirs) {
2326                 File::Find::find({ wanted => $wanted, follow => 1 }, @cdirs);
2327         }
2328 #::logDebug("gfiles=" . ::uneval(\@gfiles));
2329 #::logDebug("cfiles=" . ::uneval(\@cfiles));
2330 #::logDebug("ifiles=" . ::uneval(\@ifiles));
2331 #::logDebug("ufiles=" . ::uneval(\@ufiles));
2332 #::logDebug("cdirs=" . ::uneval(\@cdirs));
2333 #::logDebug("copy=" . ::uneval(\@copy));
2334
2335         for(@copy) {
2336                 my ($n, $d) = @$_;
2337
2338                 my $tf = Vend::File::catfile($C->{VendRoot}, $n);
2339                 next if -f $tf;
2340
2341                 my $td = Vend::File::catfile($C->{VendRoot}, $d);
2342                 unless(-d $td) {
2343                         File::Path::mkpath($td)
2344                                 or do {
2345                                         config_warn("Feature %s not able to make directory %s", $value, $td);
2346                                         next;
2347                                 };
2348                 }
2349                 File::Copy::copy("$fdir/$n", $tf)
2350                         or do {
2351                                 config_warn("Feature %s not able to copy %s to %s", $value, "$fdir/$n", $tf);
2352                                 next;
2353                         };
2354         }
2355
2356         for(@gfiles) {
2357                 global_chunk($_);
2358         }
2359
2360         if(@ifiles) {
2361                 my $initdir = Vend::File::catfile($C->{ConfDir}, 'init', $value);
2362                 File::Path::mkpath($initdir) unless -d $initdir;
2363                 my $unfile = Vend::File::catfile($initdir, 'uninstall');
2364
2365                 ## Feature was previously uninstalled, we *do* need to run init
2366                 my $ignore = -f $unfile;
2367
2368                 if($ignore) {
2369                         unlink $unfile
2370                                         or die errmsg("Couldn't unlink $unfile: $!");
2371                 }
2372
2373                 for(@ifiles) {
2374                         my $fn = $_;
2375                         $fn =~ s{^$fdir/}{};
2376                         if($ignore) {
2377                                 unlink "$initdir/$fn"
2378                                         or die errmsg("Couldn't unlink $fn: $!");
2379                         }
2380
2381                         next if -f "$initdir/$fn";
2382                         $C->{Init} ||= [];
2383                         push @{$C->{Init}}, [$_, "$initdir/$fn"];
2384                 }
2385         }
2386
2387 #::logDebug("Init=" . ::uneval($C->{Init}));
2388
2389         $c->{$value} = 1;
2390         return $c;
2391 }
2392
2393 sub uninstall_feature {
2394         my ($value) = @_;
2395         my $c = $Vend::Cfg
2396                 or die "Not in catalog context.\n";
2397
2398 #::logDebug("Running uninstall for cat=$Vend::Cat, from cfg ref=$c->{CatalogName}");
2399         $value =~ s/^\s+//;
2400         $value =~ s/\s+$//;
2401         my $fdir = Vend::File::catfile($Global::FeatureDir, $value);
2402
2403         unless(-d $fdir) {
2404                 config_warn("Feature '%s' not found, skipping.", $value);
2405                 return $c;
2406         }
2407
2408         my $etag = errmsg("feature %s uninstall -- ", $value);
2409
2410         # Get the global install files and remove them from the config list
2411         my @gfiles = glob("$fdir/*.global");
2412         my %seen;
2413         @seen{@gfiles} = @gfiles;
2414
2415         # Get the init files and remove them from the config list
2416         my @ifiles = glob("$fdir/*.init");
2417         @seen{@ifiles} = @ifiles;
2418
2419         # Get the uninstall files and remove them from the config list
2420         my @ufiles = glob("$fdir/*.uninstall");
2421         @seen{@ufiles} = @ifiles;
2422
2423         # Any other files are config files
2424         my @cfiles = grep ! $seen{$_}++, glob("$fdir/*");
2425
2426         # directories are for copying
2427         my @cdirs = grep -d $_, @cfiles;
2428
2429         my $Tag = new Vend::Tags;
2430
2431         my @copy;
2432         my @errors;
2433         my @warnings;
2434
2435         my $wanted = sub {
2436                 return unless -f $_;
2437                 my $n = $File::Find::name;
2438                 $n =~ s{^$fdir/}{};
2439                 my $d = $File::Find::dir;
2440                 $d =~ s{^$fdir/}{};
2441                 push @copy, [$n, $d];
2442         };
2443
2444         if(@cdirs) {
2445                 File::Find::find({ wanted => $wanted, follow => 1 }, @cdirs);
2446         }
2447 #::logDebug("ufiles=" . ::uneval(\@ufiles));
2448 #::logDebug("ifiles=" . ::uneval(\@ifiles));
2449 #::logDebug("cdirs=" . ::uneval(\@cdirs));
2450 #::logDebug("copy=" . ::uneval(\@copy));
2451
2452         for(@ufiles) {
2453 #::logDebug("Running uninstall file $_");
2454                 my $save = $Global::AllowGlobal->{$Vend::Cat};
2455                 $Global::AllowGlobal->{$Vend::Cat} = 1;
2456                 open UNFILE, "< $_"
2457                         or do {
2458                                 push @errors, $etag . errmsg("error reading %s: %s", $_, $!);
2459                         };
2460                 my $chunk = join "", <UNFILE>;
2461                 close UNFILE;
2462
2463 #::logDebug("uninstall chunk length=" . length($chunk));
2464
2465                 my $out;
2466                 eval {
2467                         $out = Vend::Interpolate::interpolate_html($chunk);
2468                 };
2469
2470                 if($@) {
2471                         push @errors, $etag . errmsg("error running uninstall %s: %s", $_, $@);
2472                 }
2473
2474                 push @warnings, $etag . errmsg("message from %s: %s", $_, $out)
2475                         if $out =~ /\S/;
2476
2477                 $Global::AllowGlobal->{$Vend::Cat} = $save;
2478         }
2479
2480         for(@copy) {
2481                 my ($n, $d) = @$_;
2482
2483                 my $tf = Vend::File::catfile($c->{VendRoot}, $n);
2484                 next unless -f $tf;
2485
2486                 my $contents1 = Vend::File::readfile($tf);
2487
2488                 my $sf = "$fdir/$n";
2489
2490                 open UNSRC, "< $sf"
2491                         or die $etag . errmsg("Couldn't read uninstall source file %s: %s", $sf, $!);
2492
2493                 local $/;
2494                 my $contents2 = <UNSRC>;
2495
2496                 if($contents1 ne $contents2) {
2497                         push @warnings, $etag . errmsg("will not uninstall %s, changed.", $tf);
2498                         next;
2499                 }
2500
2501                 unlink $tf
2502                         or do {
2503                                 push @errors,
2504                                         $etag . errmsg("$etag couldn't unlink file %s: %s", $tf, $!);
2505                                 next;
2506                         };
2507
2508                 my $td = Vend::File::catfile($c->{VendRoot}, $d);
2509                 my @left = glob("$td/*");
2510                 push @left, glob("$td/.?*");
2511                 next if @left;
2512                 File::Path::rmtree($td);
2513         }
2514
2515         if(@ifiles) {
2516 #::logDebug("running uninstall touch and init");
2517                 my $initdir = Vend::File::catfile($c->{ConfDir}, 'init', $value);
2518                 File::Path::mkpath($initdir) unless -d $initdir;
2519                 my $fn = Vend::File::catfile($initdir, 'uninstall');
2520 #::logDebug("touching uninstall file $fn");
2521                 open UNFILE, ">> $fn"
2522                         or die errmsg("Couldn't create uninstall flag file %s: %s", $fn, $!);
2523                 print UNFILE $etag . errmsg("uninstalled at %s.\n", scalar(localtime));
2524                 close UNFILE;
2525         }
2526
2527
2528         my $errors;
2529         for(@errors) {
2530                 $Tag->error({ set => $_});
2531                 ::logError($_);
2532                 $errors++;
2533         }
2534
2535         for(@warnings) {
2536                 $Tag->warnings($_);
2537                 ::logError($_);
2538         }
2539
2540         return ! $errors;
2541 }
2542
2543
2544 # Changes configuration directives into Variable settings, i.e.
2545 # DescriptionField becomes __DescriptionField__, ProductFiles becomes
2546 # __ProductFiles_0__, ProductFiles_1__, etc. Doesn't handle hash keys
2547 # that have non-word chars.
2548
2549 sub parse_autovar {
2550         my($var, $val) = @_;
2551
2552         return '' if ! $val;
2553
2554         my @dirs = grep /\w/, split /[\s,\0]+/, $val;
2555
2556         my $name;
2557         foreach $name (@dirs) {
2558                 next unless $name =~ /^\w+$/;
2559                 my $val = get_directive($name);
2560                 if(! ref $val) {
2561                         parse_variable('Variable', "$name $val");
2562                 }
2563                 elsif ($val =~ /ARRAY/) {
2564                         for(my $i = 0; $i < @$val; $i++) {
2565                                 my $an = "${name}_$i";
2566                                 parse_variable('Variable', "$an $val->[$i]");
2567                         }
2568                 }
2569                 elsif ($val =~ /HASH/) {
2570                         my ($k, $v);
2571                         while ( ($k, $v) = each %$val) {
2572                                 next unless $k =~ /^\w+$/;
2573                                 parse_variable('Variable', "$k $v");
2574                         }
2575                 }
2576                 else {
2577                         config_warn('%s directive not parsable by AutoVariable', $name);
2578                 }
2579         }
2580 }
2581
2582
2583 # Checks to see if a globalsub, sub, usertag, or Perl module is present
2584 # If called with a third parameter, is just "suggestion"
2585 # If called with a fourth parameter, is just capability check
2586
2587 sub parse_capability {
2588         return parse_require(@_, 1, 1);
2589 }
2590
2591 sub parse_tag_group {
2592         my ($var, $setting) = @_;
2593
2594         my $c;
2595         if(defined $C) {
2596                 $c = $C->{$var} || {};
2597         }
2598         else {
2599                 no strict 'refs';
2600                 $c = ${"Global::$var"} || {};
2601         }
2602         
2603         $setting =~ tr/-/_/;
2604         $setting =~ s/[,\s]+/ /g;
2605         $setting =~ s/^\s+//;
2606         $setting =~ s/\s+$//;
2607
2608         my @pairs = Text::ParseWords::shellwords($setting);
2609
2610         while(@pairs) {
2611                 my ($group, $sets) = splice @pairs, 0, 2;
2612                 my @sets = grep $_, split /\s+/, $sets;
2613                 my @groups = grep /:/, @sets;
2614                 @sets = grep $_ !~ /:/, @sets;
2615                 for(@groups) {
2616                         next unless $c->{$_};
2617                         push @sets, @{$c->{$_}};
2618                 }
2619                 $c->{$group} = \@sets;
2620         }
2621         return $c;
2622 }
2623
2624 my %incmap = qw/TagInclude TagGroup/;
2625 sub parse_tag_include {
2626         my ($var, $setting) = @_;
2627
2628         my $c;
2629         my $g;
2630
2631         my $mapper = $incmap{$var} || 'TagGroup';
2632         if(defined $C) {
2633                 $c = $C->{$var} || {};
2634                 $g = $C->{$mapper} || {};
2635         }
2636         else {
2637                 no strict 'refs';
2638                 $c = ${"Global::$var"} || {};
2639                 $g = ${"Global::$mapper"} || {};
2640         }
2641         
2642         $setting =~ s/"/ /g;
2643         $setting =~ s/^\s+//;
2644         $setting =~ s/\s+$//;
2645         $setting =~ s/[,\s]+/ /g;
2646
2647         if($setting eq 'ALL') {
2648                 return { ALL => 1 };
2649         }
2650
2651         delete $c->{ALL};
2652
2653         get_system_groups() unless $SystemGroupsDone;
2654
2655         my @incs = Text::ParseWords::shellwords($setting);
2656
2657         for(@incs) {
2658                 my @things;
2659                 my $not = 0;
2660                 if(/:/) {
2661                         $not = 1 if s/^!//;
2662                         if(! $g->{$_}) {
2663                                 config_warn(
2664                                         "unknown %s %s included from %s",
2665                                         $mapper,
2666                                         $_,
2667                                         $var,
2668                                 );
2669                         }
2670                         else {
2671                                 @things = @{$g->{$_}}
2672                         }
2673                 }
2674                 else {
2675                         @things = ($_);
2676                 }
2677                 for(@things) {
2678                         my $not = s/^!// ? ! $not : $not;
2679                         $c->{$_} = not $not;
2680                 }
2681         }
2682         return $c;
2683 }
2684
2685 sub parse_suggest {
2686         return parse_require(@_, 1);
2687 }
2688
2689 sub parse_require {
2690         my($var, $val, $warn, $cap) = @_;
2691
2692         return if $Vend::ExternalProgram;
2693         return if $Vend::ControllingInterchange;
2694
2695         my $carptype;
2696         my $error_message;
2697         my $pathinfo;
2698
2699         if($val =~ s/\s+"(.*)"//s) {
2700                 $error_message = "\a\n\n$1\n";
2701         }
2702
2703         if($val =~ s%\s+((/[\w.-]+)+)%%) {
2704                 $pathinfo = $1;
2705         }
2706         
2707         if($cap) {
2708                 $carptype = sub { return; };
2709         }
2710         elsif($warn) {
2711                 $carptype = sub { return parse_message('', @_) };
2712                 $error_message = "\a\n\nSuggest %s %s for proper catalog operation. Not all functions will work!\n"
2713                         unless $error_message;
2714         }
2715         else {
2716                 $carptype = \&config_error;
2717                 $error_message ||= 'Required %s %s not present. Aborting '
2718                         . ($C ? 'catalog' : 'Interchange daemon') . '.';
2719         }
2720
2721         my $nostrict;
2722         my $perlglobal = 1;
2723
2724         if($C) {
2725                 $nostrict = $Global::PerlNoStrict->{$C->{CatalogName}};
2726                 $perlglobal = $Global::AllowGlobal->{$C->{CatalogName}};
2727         }
2728
2729         my $vref = $C ? $C->{Variable} : $Global::Variable;
2730         my $require;
2731         my $testsub = sub { 0 };
2732         my $name;
2733         if($val =~ s/^globalsub\s+//i) {
2734                 $require = $Global::GlobalSub;
2735                 $name = 'GlobalSub';
2736         }
2737         elsif($val =~ s/^sub\s+//i) {
2738                 $require = $C->{Sub};
2739                 $name = 'Sub';
2740         }
2741         elsif($val =~ s/^taggroup\s+//i) {
2742                 $require = $Global::UserTag->{Routine};
2743                 my @groups = grep /\S/, split /[\s,]+/, $val;
2744                 my @needed;
2745                 my $ref;
2746                 for (@groups) {
2747                         if($ref = $Global::TagGroup->{$_}) {
2748                                 push @needed, @$ref;
2749                         }
2750                         else {
2751                                 push @needed, $_;
2752                         }
2753                 }
2754                 $name = "TagGroup $val member";
2755                 $val = join " ", @needed;
2756         }
2757         elsif($val =~ s/^usertag\s+//i) {
2758                 $require = {};
2759                 $name = 'UserTag';
2760
2761                 $testsub = sub {
2762                         my $name = shift;
2763
2764                         my @tries = ($Global::UserTag->{Routine});
2765                         push(@tries,$C->{UserTag}->{Routine}) if $C;
2766
2767                         foreach (@tries) {
2768                                 return 1 if defined $_->{$name};
2769                         }
2770                         return 0;
2771                 };
2772         }
2773         elsif($val =~ s/^(?:perl)?module\s+//i) {
2774                 $require = {};
2775                 $name = 'Perl module';
2776                 $testsub = sub {
2777                         my $module = shift;
2778                         my $oldtype = '';
2779                         if($module =~ s/\.pl$//) {
2780                                 $oldtype = '.pl';
2781                         }
2782                         $module =~ /[^\w:]/ and return undef;
2783                         if($perlglobal) {
2784                                 if ($pathinfo) {
2785                                         unshift(@INC, $pathinfo);
2786                                         unshift(@INC, "$pathinfo/$Config{archname}");
2787                                 }
2788                                 eval "require $module$oldtype;";
2789                                 my $error = $@;
2790                                 if ($pathinfo) {
2791                                         shift(@INC);
2792                                         shift(@INC);
2793                                 }
2794                                 ::logGlobal("while eval'ing module %s got [%s]\n", $module, $error) if $error;
2795                                 return ! $error;
2796                         }
2797                         else {
2798                                 # Since we aren't safe to actually require, we will 
2799                                 # just look for a readable module file
2800                                 $module =~ s!::!/!g;
2801                                 $oldtype = '.pm' if ! $oldtype;
2802                                 my $found;
2803                                 for(@INC) {
2804                                         next unless -f "$_/$module$oldtype" and -r _;
2805                                         $found = 1;
2806                                 }
2807                                 return $found;
2808                         }
2809                 };
2810         }
2811         elsif ($val =~ s/^(?:perl)?include\s+//i) {
2812                 my $path = Vend::File::make_absolute_file($val, 1);
2813                 $require = {};
2814                 $name = 'Perl include path';
2815                 $testsub =
2816                         sub {
2817                                 if (-d $path) {
2818                                         unshift @INC, $path;
2819                                         return 1;
2820                                 }
2821                                 return 0;
2822                         };
2823         }
2824         elsif ($val =~ s/^file\s*//i) {
2825                 $require = {};
2826                 $name = 'Readable file';
2827                 $val = $pathinfo unless $val;
2828
2829                 $testsub = sub {
2830                         my $path = Vend::File::make_absolute_file(shift, $C ? 0 : 1);
2831                         if ($C && $path =~ s:^/+::) {
2832                                 $path = "$C->{VendRoot}/$path";
2833                         }
2834                         return -r $path;
2835                 };
2836         }
2837         elsif ($val =~ s/^executable\s*//i) {
2838                 $require = {};
2839                 $name = 'Executable file';
2840                 $val = $pathinfo unless $val;
2841
2842                 $testsub = sub {
2843                         my $path = Vend::File::make_absolute_file(shift, $C ? 0 : 1);
2844                         if ($C && $path =~ s:^/+::) {
2845                                 $path = "$C->{VendRoot}/$path";
2846                         }
2847                         return -x $path;
2848                 };
2849         }
2850         my @requires = grep /\S/, split /\s+/, $val;
2851
2852         my $uname = uc $name;
2853         $uname =~ s/.*\s+//;
2854         for(@requires) {
2855                 $vref->{"MV_REQUIRE_${uname}_$_"} = 1;
2856                 next if defined $require->{$_};
2857                 next if $testsub->($_);
2858                 delete $vref->{"MV_REQUIRE_${uname}_$_"};
2859                 $carptype->( $error_message, $name, $_ );
2860         }
2861         return '';      
2862 }
2863
2864 # Sets the special variable remap array
2865 #
2866
2867 my $Varnames;
2868 INITVARS: {
2869         local($/);
2870         $Varnames = <DATA>;
2871 }
2872
2873 sub parse_varname {
2874         my($item,$settings) = @_;
2875
2876         return if $Vend::ExternalProgram;
2877
2878         my($iv,$vn,$k,$v,@set);
2879 #logDebug("parse_varname: $settings");
2880         if(defined $C) {
2881                 return '' if ! $settings;
2882                 $C->{IV} = { %{$Global::IV} } if ! $C->{IV};
2883                 $C->{VN} = { %{$Global::VN} } if ! $C->{VN};
2884                 $iv = $C->{IV};
2885                 $vn = $C->{VN};
2886         }
2887         else {
2888                 if (! $Global::VarName) {
2889                         unless (-s "$Global::ConfDir/varnames" && -r _) {
2890                                 $settings = $Varnames . "\n$settings";
2891                                 writefile("$Global::ConfDir/varnames", $Varnames);
2892                         }
2893                         else {
2894                                 $settings = readfile("$Global::ConfDir/varnames");
2895                         }
2896                 }
2897                 undef $Varnames;
2898                 $Global::IV = {} if ! $Global::IV;
2899                 $Global::VN = {} if ! $Global::VN;
2900                 $iv = $Global::IV;
2901                 $vn = $Global::VN;
2902         }
2903
2904         @set = grep /\S/, split /\s+/, $settings;
2905         while( $k = shift @set, $v = shift @set ) {
2906                 $vn->{$k} = $v;
2907                 $iv->{$v} = $k;
2908         }
2909         return 1;
2910 }
2911
2912 sub parse_word {
2913         my($name, $val) = @_;
2914
2915         return '' unless $val;
2916         unless ($val =~ /^\w+$/) {
2917                 config_error("Illegal non-word value in '%s' for %s", $val, $name);
2918         }
2919         return $val;
2920 }
2921
2922 # Allow addition of a new catalog directive
2923 sub parse_directive {
2924         my($name, $val) = @_;
2925
2926         return '' unless $val;
2927         my($dir, $parser, $default) = split /\s+/, $val, 3 ;
2928         if(! defined &{"parse_$parser"} and ! defined &{"$parser"}) {
2929                 if (defined $Global::GlobalSub->{"parse_$parser"}) {
2930                         no strict 'refs';
2931                         *{"Vend::Config::parse_$parser"} = $Global::GlobalSub->{"parse_$parser"};
2932                 } else {
2933                         $parser = undef;
2934                 }
2935         }
2936         $default = '' if ! $default or $default eq 'undef';
2937         $Global::AddDirective = [] unless $Global::AddDirective;
2938         push @$Global::AddDirective, [ $dir, $parser, $default ];
2939         return $Global::AddDirective;
2940 }
2941
2942 # Allow a subcatalog value to completely replace a base value
2943 sub parse_replace {
2944         my($name, $val) = @_;
2945
2946         return {} unless $val;
2947
2948         $C->{$val} = get_catalog_default($val);
2949         $C->{$name}->{$val} = 1;
2950         $C->{$name};
2951 }
2952
2953
2954 # Send a message during configuration, goes to terminal if during
2955 # daemon startup, always goes to error log
2956 sub parse_message {
2957         my($name, $val) = @_;
2958
2959         return '' unless $val;
2960
2961         return 1 if $Vend::Quiet;
2962
2963         my $strip;
2964         my $info_only;
2965         ## strip trailing whitespace if -n beins message
2966         while($val =~ s/^-([ni])\s+//) {
2967                 $1 eq 'n' and $val =~ s/^-n\s+// and $strip = 1 and $val =~ s/\s+$//;
2968                 $info_only = 1 if $1 eq 'i';
2969         }
2970
2971         my $msg = errmsg($val,
2972                                                 $name,
2973                                                 $.,
2974                                                 $configfile,
2975                                 );
2976
2977         if($info_only and $Global::Foreground) {
2978                 print $msg;
2979         }
2980         else {
2981                 logGlobal({level => 'info', strip => $strip },
2982                                 errmsg($val,
2983                                                 $name,
2984                                                 $.,
2985                                                 $configfile,
2986                                 )
2987                 );
2988         }
2989 }
2990
2991
2992 # Warn about directives no longer supported in the configuration file.
2993 sub parse_warn {
2994         my($name, $val) = @_;
2995
2996         return '' unless $val;
2997
2998         ::logGlobal({level => 'info'},
2999                                 errmsg("Directive %s no longer supported at line %s of %s.",
3000                                                 $name,
3001                                                 $.,
3002                                                 $configfile,
3003                                 )
3004         );
3005 }
3006
3007 # Each of the parse functions accepts the value of a directive from the
3008 # configuration file as a string and either returns the parsed value or
3009 # signals a syntax error.
3010
3011 # Sets a boolean array for any type of item
3012 sub parse_boolean {
3013         my($item,$settings) = @_;
3014         my(@setting) = grep /\S/, split /[\s,]+/, $settings;
3015         my $c;
3016
3017         if(defined $C) {
3018                 $c = $C->{$item} || {};
3019         }
3020         else {
3021                 no strict 'refs';
3022                 $c = ${"Global::$item"} || {};
3023         }
3024
3025         for (@setting) {
3026                 $c->{$_} = 1;
3027         }
3028         return $c;
3029 }
3030
3031 # Sets a boolean array, but configurable value with tag=value
3032 sub parse_boolean_value {
3033         my($item,$settings) = @_;
3034         my(@setting) = split /[\s,]+/, $settings;
3035         my $c;
3036
3037         if(defined $C) {
3038                 $c = $C->{$item} || {};
3039         }
3040         else {
3041                 no strict 'refs';
3042                 $c = ${"Global::$item"} || {};
3043         }
3044
3045         for (@setting) {
3046                 my ($k,$v);
3047                 if(/=/) {
3048                         ($k,$v) = split /=/, $_, 2;
3049                 }
3050                 else {
3051                         $k = $_;
3052                         $v = 1;
3053                 }
3054                 $c->{$k} = $v;
3055         }
3056         return $c;
3057 }
3058
3059 use POSIX qw(
3060                                 setlocale localeconv
3061                                 LC_ALL          LC_CTYPE        LC_COLLATE
3062                                 LC_MONETARY     LC_NUMERIC      LC_TIME
3063                         );
3064
3065 # Sets the special locale array. Tries to use POSIX setlocale,
3066 # accepts a 'custom' setting with the proper definitions of
3067 # decimal_point,  mon_thousands_sep, and frac_digits (the only supported at
3068 # the moment).  Otherwise uses US-English settings if not set.
3069 #
3070 sub parse_locale {
3071         my($item,$settings) = @_;
3072         return ($settings || '') unless $settings =~ /[^\d.]/;
3073         $settings = '' if "\L$settings" eq 'default';
3074         my $name;
3075         my ($c, $store);
3076         if(defined $C) {
3077                 $c = $C->{$item} || { };
3078                 $C->{$item . "_repository"} = {}
3079                         unless $C->{$item . "_repository"};
3080                 $store = $C->{$item . "_repository"};
3081         }
3082         else {
3083                 no strict 'refs';
3084                 $c = ${"Global::$item"} || {};
3085                 ${"Global::$item" . "_repository"} = {}
3086                         unless ${"Global::$item" . "_repository"};
3087                 $store = ${"Global::$item" . "_repository"};
3088         }
3089
3090         my ($eval, $safe);
3091         if ($settings =~ s/^\s*([-\w.@]+)(?:\s+)?//) {
3092                 $name = $1;
3093
3094                 undef $eval;
3095                 $settings =~ /^\s*{/
3096                         and $settings =~ /}\s*$/
3097                                 and $eval = 1;
3098                 $eval and ! $safe and $safe = new Vend::Safe;
3099                 if(! defined $store->{$name} and $item eq 'Locale') {
3100                     my $past = POSIX::setlocale(POSIX::LC_ALL);
3101                         if(POSIX::setlocale(POSIX::LC_ALL, $name) ) {
3102                                 $store->{$name} = POSIX::localeconv();
3103                         }
3104                         POSIX::setlocale(POSIX::LC_ALL, $past);
3105                 }
3106
3107                 my($sethash);
3108                 if ($eval) {
3109                         $sethash = $safe->reval($settings)
3110                                 or config_warn("bad Locale setting in %s: %s", $name, $@),
3111                                                 $sethash = {};
3112                 }
3113                 else {
3114                         $settings =~ s/^\s+//;
3115                         $settings =~ s/\s+$//;
3116                         $sethash = {};
3117                         %{$sethash} = Text::ParseWords::shellwords($settings);
3118                 }
3119                 $c = $store->{$name} || {};
3120                 my $nodefaults = delete $sethash->{MV_LOCALE_NO_DEFAULTS};
3121                 for (keys %{$sethash}) {
3122                         $c->{$_} = $sethash->{$_};
3123                 }
3124         }
3125         else {
3126                 config_error("Bad locale setting $settings.\n");
3127         }
3128
3129         $C->{LastLocale} = $name if $C and $item eq 'Locale';
3130
3131         $store->{$name} = $c unless $store->{$name};
3132
3133         return $c;
3134 }
3135
3136 #
3137 # Sets a structure like Locale but with the depth and access via key
3138 # No evaled structure setting, only key-value with shell quoting
3139
3140 sub parse_structure {
3141         my ($item, $settings) = @_;
3142         return {} unless $settings;
3143         my $key;
3144         my @rest;
3145         ($key, @rest) = Text::ParseWords::shellwords($settings);
3146         my ($c, $e);
3147         if(defined $C) {
3148                 $c = $C->{$item};
3149                 $e = $c->{$key} || { };
3150         }
3151         else {
3152                 no strict 'refs';
3153                 $c = ${"Global::$item"};
3154                 $e = $c->{$key} || {};
3155         }
3156
3157         while(scalar @rest) {
3158                 my $k = shift @rest;
3159                 $e->{$k} = shift @rest;
3160         }
3161         $c->{$key} = $e;
3162         return $c;
3163 }
3164
3165
3166 # Sets the special page array
3167 sub parse_special {
3168         my($item,$settings) = @_;
3169         return {} unless $settings;
3170         my(%setting) = grep /\S/, split /[\s,]+/, $settings;
3171         for (keys %setting) {
3172                 if($Global::NoAbsolute and file_name_is_absolute($setting{$_}) ) {
3173                         config_warn("Absolute file name not allowed: %s", $setting{$_});
3174                         next;
3175                 }
3176                 $C->{$item}{$_} = $setting{$_};
3177         }
3178         return $C->{$item};
3179 }
3180
3181 # Sets up a hash value from a configuration directive, syntax is
3182
3183 #   Directive  "key" "value"
3184
3185 # quotes are optional if word-only chars
3186
3187 sub parse_hash {
3188         my($item,$settings) = @_;
3189         if (! $settings) {
3190                 return $HashDefaultBlank{$item} ? '' : {};
3191         }
3192
3193         my $c;
3194
3195         if(defined $C) {
3196                 $c = $C->{$item} || {};
3197         }
3198         else {
3199                 no strict 'refs';
3200                 $c = ${"Global::$item"} || {};
3201         }
3202
3203         return hash_string($settings,$c);
3204 }
3205
3206 # Set up illegal values for certain directives
3207 my %IllegalValue = (
3208
3209                 AutoModifier => { qw/   mv_mi 1
3210                                                                 mv_si 1
3211                                                                 mv_ib 1
3212                                                                 group 1
3213                                                                 code  1
3214                                                                 sku   1
3215                                                                 quantity 1
3216                                                                 item  1     /
3217                                                 },
3218                 UseModifier => { qw/   mv_mi 1
3219                                                                 mv_si 1
3220                                                                 mv_ib 1
3221                                                                 group 1
3222                                                                 code  1
3223                                                                 sku   1
3224                                                                 quantity 1
3225                                                                 item  1     /
3226                                                 }
3227 );
3228
3229 my @Dispatches;
3230 my @Cleanups;
3231
3232 %Cleanup_priority = (
3233         AutoEnd => 1,
3234 );
3235
3236 %Dispatch_priority = (
3237         CookieLogin => 1,
3238         Locale => 2,
3239         DiscountSpaces => 5,
3240         Autoload => 8,
3241 );
3242
3243 %Cleanup_code = (
3244         AutoEnd => sub {
3245 #::logDebug("Doing AutoEnd dispatch...");
3246                 Vend::Dispatch::run_macro($Vend::Cfg->{AutoEnd});
3247         },
3248 );
3249
3250 %Dispatch_code = (
3251
3252         Autoload => sub {
3253 #::logDebug("Doing Autoload dispatch...");
3254                 my ($subname, $inspect_sub);
3255
3256                 if ($subname = $Vend::Cfg->{SpecialSub}{autoload_inspect}) {
3257                         $inspect_sub = $Vend::Cfg->{Sub}{$subname} || $Global::GlobalSub->{$subname};
3258                 }
3259                 
3260                 Vend::Dispatch::run_macro($Vend::Cfg->{Autoload}, undef, $inspect_sub);
3261         },
3262
3263         CookieLogin => sub {
3264 #::logDebug("Doing CookieLogin dispatch....");
3265                 if(! $Vend::Session->{logged_in}) {
3266                         COOKIELOGIN: {
3267                                 # Clear password cookie and don't allow automatic login
3268                                 # if mv_force_session is overriding the session cookie,
3269                                 # since user may be coming from a sister site where he
3270                                 # was logged out.
3271                                 (Vend::Util::read_cookie('MV_PASSWORD')
3272                                         and Vend::Util::set_cookie('MV_PASSWORD')), last COOKIELOGIN
3273                                                 if $CGI::values{mv_force_session};
3274                                 my $username;
3275                                 my $password;
3276                                 last COOKIELOGIN
3277                                         if  exists  $CGI::values{mv_username}
3278                                         and defined $CGI::values{mv_username};
3279                                 last COOKIELOGIN
3280                                         unless $username = Vend::Util::read_cookie('MV_USERNAME');
3281                                 last COOKIELOGIN
3282                                         unless $password = Vend::Util::read_cookie('MV_PASSWORD');
3283                                 $CGI::values{mv_username} = $username;
3284                                 $CGI::values{mv_password} = $password;
3285                                 my $profile = Vend::Util::read_cookie('MV_USERPROFILE');
3286                                 local(%SIG);
3287                                 undef $SIG{__DIE__};
3288                                 eval {
3289                                         Vend::UserDB::userdb('login', profile => $profile );
3290                                 };
3291                                 if($@) {
3292                                         $Vend::Session->{failure} .= $@;
3293                                 }
3294                         }
3295                 }
3296         },
3297
3298     Locale => sub {
3299 #::logDebug("Doing Locale dispatch...");
3300         my $locale = $::Scratch->{mv_locale};
3301         my $curr = $::Scratch->{mv_currency};
3302         $locale || $curr    or return;
3303
3304         if($locale and ! $::Scratch->{mv_language}) {
3305             $Global::Variable->{LANG}
3306                     = $::Variable->{LANG}
3307                     = $::Scratch->{mv_language}
3308                     = $locale;
3309         }
3310
3311         if($locale) {
3312             return unless defined $Vend::Cfg->{Locale_repository}{$locale};
3313         }
3314         elsif($curr) {
3315             return unless defined $Vend::Cfg->{Locale_repository}{$curr};
3316         }
3317 #::logDebug("running locale dispatch, locale=$locale, currency=$curr");
3318
3319         Vend::Util::setlocale( $locale, $curr, { persist => 1 } );
3320     },
3321
3322         DiscountSpaces => sub {
3323 #::logDebug("Doing DiscountSpaces dispatch...");
3324                 $::Discounts
3325                         = $Vend::Session->{discount}
3326                         = $Vend::Session->{discount_space}{
3327                                         $Vend::DiscountSpaceName = 'main'
3328                                 }
3329                         ||= {};
3330                 my $dspace;
3331                 for (@{$Vend::Cfg->{DiscountSpaceVar}}) {
3332                         next unless $dspace = $CGI::values{$_};
3333 #::logDebug("$_ is set=...");
3334                         last;
3335                 }
3336                 return unless $dspace;
3337                 $Vend::DiscountSpaceName = $dspace;
3338 #::logDebug("Discount space is set=$Vend::DiscountSpaceName...");
3339                 $::Discounts
3340                                 = $Vend::Session->{discount}
3341                                 = $Vend::Session->{discount_space}{$Vend::DiscountSpaceName}
3342                                 ||= {};
3343     },
3344
3345 );
3346
3347 # Set up defaults for certain directives
3348 my $Have_set_global_defaults;
3349
3350 # Set the default search files based on ProductFiles setting
3351 # Honor a NO_SEARCH parameter in the Database structure
3352 # Set MV_DEFAULT_SEARCH_FILE to the {file} entry,
3353 # and set MV_DEFAULT_SEARCH_TABLE to the table name.
3354 #
3355 # Error out if not SubCatalog and can't find a setting.
3356 #
3357 sub set_default_search {
3358         my $setting = $C->{ProductFiles};
3359
3360         if(! $setting) {
3361                 return 1 if $C->{BaseCatalog};
3362                 return (undef, errmsg("No ProductFiles setting!") );
3363         }
3364         
3365         my @fout;
3366         my @tout;
3367         my $nofile;
3368         my $notable;
3369
3370         if ($C->{Variable}{MV_DEFAULT_SEARCH_FILE}) {
3371                 @fout =
3372                         grep /\S/,
3373                         split /[\s,]+/,
3374                         $C->{Variable}{MV_DEFAULT_SEARCH_FILE};
3375                 $nofile = 1;
3376                 for(@fout) {
3377                         next if /\./;
3378                         next unless exists $C->{Database}{$_};
3379                         $_ = $C->{Database}{$_}{file};
3380                 }
3381         }
3382         if ($C->{Variable}{MV_DEFAULT_SEARCH_TABLE}) {
3383                 @tout =
3384                         grep defined $C->{Database}{$_},
3385                                 split /[\s,]+/,
3386                                 $C->{Variable}{MV_DEFAULT_SEARCH_TABLE}
3387                 ;
3388                 $notable = 1;
3389         }
3390
3391         for(@$setting) {
3392                 next if $C->{Database}{$_}{NO_SEARCH};
3393                 push @tout, $_ unless $notable;
3394                 next unless defined $C->{Database}{$_}{file};
3395                 push @fout, $C->{Database}{$_}{file}
3396                         unless $nofile;
3397         }
3398         unless (scalar @fout) {
3399                 return 1 if $C->{BaseCatalog};
3400                 return (undef, errmsg("No default search file!") );
3401         }
3402         $C->{Variable}{MV_DEFAULT_SEARCH_FILE}  = \@fout;
3403         $C->{Variable}{MV_DEFAULT_SEARCH_TABLE} = \@tout;
3404         return 1;
3405 }
3406
3407 %Default = (
3408                 ## This rather extensive default setting is not typical for IC,
3409                 ## but performance in pricing routines demands it
3410                 Options => sub {
3411                         my $o = $C->{Options_repository} ||= {};
3412                         my $var = $C->{Variable};
3413
3414                         my @base = qw/Simple Matrix Old48/;
3415                         my %base;
3416                         @base{@base} = @base;
3417
3418                         my %seen;
3419                         my @types = grep !$seen{$_}++, keys %$o, @base;
3420
3421                         for(@types) {
3422                                 my $loc = $o->{$_} ||= {};
3423                                 eval "require Vend::Options::$_;";
3424                                 if($@) {
3425                                         my $msg = $@;
3426                                         config_warn(
3427                                                 "Unable to use options type %s, no module. Error: %s",
3428                                                 $_,
3429                                                 $msg,
3430                                         );
3431                                         undef $o->{$_};
3432                                         next;
3433                                 }
3434                                 eval {
3435                                         my $name = "Vend::Options::${_}::Default";
3436                                         no strict;
3437                                         while(my ($k,$v) = each %{"$name"}) {
3438                                                 next unless $k;
3439                                                 next if exists $loc->{$k};
3440                                                 $loc->{$k} = $v;
3441                                         }
3442                                 };
3443                                 $loc->{map} = {};
3444                                 if($loc->{remap} ||= $C->{Variable}{MV_OPTION_TABLE_MAP}) {
3445                                         $loc->{remap} =~ s/^\s+//;
3446                                         $loc->{remap} =~ s/\s+$//;
3447                                         my @points = split /[\0,\s]+/, $loc->{remap};
3448                                         map { m{(.*?)=(.*)} and $loc->{map}{$1} = $2} @points;
3449                                 }
3450                         }
3451                         $C->{Options} = $o->{default} || $o->{Simple};
3452                 },
3453                 Shipping => sub {
3454                         my $o = $C->{Shipping_repository} ||= {};
3455
3456                         my @base = qw/Postal/;
3457                         my %base;
3458                         @base{@base} = @base;
3459
3460                         my %seen;
3461                         my @types = grep !$seen{$_}++, keys %$o, @base;
3462
3463                         my %module_ignore = qw/resolution 1 default 1/;
3464
3465                         for(@types) {
3466                                 next if $module_ignore{$_};
3467                                 my $loc = $o->{$_} ||= {};
3468                                 eval "require Vend::Ship::$_;";
3469                                 if($@) {
3470                                         my $msg = $@;
3471                                         config_warn(
3472                                                 "Unable to use options type %s, no module. Error: %s",
3473                                                 $_,
3474                                                 $msg,
3475                                         );
3476                                         undef $o->{$_};
3477                                         next;
3478                                 }
3479                                 eval {
3480                                         my $name = "Vend::Ship::${_}::Default";
3481                                         no strict;
3482                                         while(my ($k,$v) = each %{"$name"}) {
3483                                                 next unless $k;
3484                                                 next if exists $loc->{$k};
3485                                                 $loc->{$k} = $v;
3486                                         }
3487                                 };
3488                         }
3489                         $C->{Shipping} = $o->{default} || $o->{Postal};
3490                 },
3491                 UserDB => sub {
3492                                         my $set = $C->{UserDB_repository};
3493                                         for(keys %$set) {
3494                                                 if( defined $set->{$_}{admin} ) {
3495                                                         $C->{AdminUserDB} = {} unless $C->{AdminUserDB};
3496                                                         $C->{AdminUserDB}{$_} = $set->{$_}{admin};
3497                                                 }
3498                                                 if($set->{$_}{encsub} =~ /sha1/i and ! $Vend::Util::SHA1) {
3499                                                         return(undef, "Unable to use SHA1 encryption for UserDB, no Digest::SHA or Digest::SHA1 module.");
3500                                                 }
3501                                         }
3502                                         return 1;
3503                                 },
3504                 UserControl => sub {
3505                                         return 1 unless shift;
3506                                         require Vend::UserControl;
3507                                         return 1;
3508                                 },
3509                 AutoModifier => sub {
3510                                         my $auto = shift;
3511                                         if($C->{OptionsEnable}) {
3512                                                 $auto = $C->{AutoModifier} = []
3513                                                         if ! $auto;
3514                                                 push @$auto, $C->{OptionsEnable};
3515                                         }
3516                                         return 1;
3517                                 },
3518                 OptionsEnable => sub {
3519                                         my $enable = shift
3520                                                 or return 1;
3521                                         return 1 if $C->{OptionsAttribute};
3522                                         $enable =~ s,.*:,,;
3523                                         $C->{OptionsAttribute} = $enable;
3524                                         return 1;
3525                                 },
3526                 Glimpse => sub {
3527                                         return 1 unless shift;
3528                                         require Vend::Glimpse;
3529                                         return 1;
3530                                 },
3531                 SOAP_Socket => sub {
3532                                         return 1 if $Have_set_global_defaults;
3533                                         $Global::SOAP_Socket = ['7780']
3534                                                 if $Global::SOAP and ! $Global::SOAP_Socket;
3535                                         return 1;
3536                                 },
3537                 TcpMap => sub {
3538                                         return 1 if defined $Have_set_global_defaults;
3539                                         my (@sets) = keys %{$Global::TcpMap};
3540                                         if(scalar @sets == 1 and $sets[0] eq '-') {
3541                                                 $Global::TcpMap = {};
3542                                         }
3543                                         return 1 if @sets;
3544                                         $Global::TcpMap->{7786} = '-';
3545                                         return 1;
3546                                 },
3547                 Database => sub {
3548                         my @del;
3549                         for ( keys %{$C->{Database}}) {
3550                                 push @del, $_ unless defined $C->{Database}{$_}{type};
3551                         }
3552                         for(@del) {
3553 #::logDebug("deleted non-existent db $_");
3554                                 delete $C->{Database}{$_};
3555                         }
3556                         return 1;
3557                 },
3558                 Locale => sub {
3559                                                 my $repos = $C->{Locale_repository}
3560                                                         or return 1;
3561                                                 if ($C->{DefaultLocale}) {
3562                                                         my $def = $C->{DefaultLocale};
3563                                                         if (exists($repos->{$def})) {
3564                                                                 $C->{Locale} = $repos->{$def};
3565                                                         }
3566                                                         else {
3567                                                                 return (0, errmsg('Default locale %s missing', $def));
3568                                                         }
3569                                                 }
3570                                                 else {
3571                                                         for(keys %$repos) {
3572                                                                 if($repos->{$_}{default}) {
3573                                                                         $C->{Locale} = $repos->{$_};
3574                                                                         $C->{DefaultLocale} = $_;
3575                                                                 }
3576                                                         }
3577                                                         if(! $C->{DefaultLocale} and $C->{LastLocale}) {
3578                                                                 $C->{DefaultLocale} = $C->{LastLocale};
3579                                                                 $C->{Locale} = $repos->{$C->{LastLocale}};
3580                                                         }
3581                                                 }
3582
3583                                                 # create currency repositories
3584                                                 for my $locale (keys %{$C->{Locale_repository}}) {
3585                                                         for my $key (@Locale_keys_currency) {
3586                                                                 if ($C->{Locale_repository}->{$locale}->{$key}) {
3587                                                                         $C->{Currency_repository}->{$locale}->{$key}
3588                                                                                 = $C->{Locale_repository}->{$locale}->{$key};
3589                                                                 }
3590                                                         }
3591                                                 }
3592                                                 
3593                                                 push @Dispatches, 'Locale';
3594                                                 return 1;
3595                                         },
3596
3597                 DiscountSpacesOn => sub {
3598                                         return 1 unless $C->{DiscountSpacesOn};
3599                                         push @Dispatches, 'DiscountSpaces';
3600                                         return 1;
3601                 },
3602                 QueryCache => sub { 
3603                                         my $qc; 
3604                                         return 1 unless $qc = $C->{QueryCache}; 
3605                                         $qc->{table} ||= 'qc'; 
3606                                         $qc->{intro} ||= 'qc'; 
3607                                         $qc->{default_expire} ||= '30min'; 
3608                                         $qc->{default_public_expire} ||= '48hours'; 
3609                                         $qc->{default_return} ||= '{}'; 
3610                                         return 1; 
3611                 },
3612                 CookieLogin => sub {
3613                                         return 1 unless $C->{CookieLogin};
3614                                         push @Dispatches, 'CookieLogin';
3615                                         return 1;
3616                 },
3617                 ProductFiles => \&set_default_search,
3618                 VendRoot => sub {
3619                         my $cat_template_dirs = $C->{TemplateDir} || [];
3620                         if ($Global::NoAbsolute) {
3621                                 for (@$cat_template_dirs) {
3622                                         if (absolute_or_relative($_) and ! /^$C->{VendRoot}/) {
3623                                                 config_error("TemplateDir path %s is prohibited by NoAbsolute", $_);
3624                                         }
3625                                 }
3626                         }
3627                         my @paths = map { quotemeta $_ }
3628                                                         $C->{VendRoot},
3629                                                         @$cat_template_dirs,
3630                                                         @{$Global::TemplateDir || []};
3631                         my $re = join "|", @paths;
3632                         $Global::AllowedFileRegex->{$C->{CatalogName}} = qr{^($re)};
3633                         return 1;
3634                 },
3635                 Autoload => sub {
3636                         return 1 unless $C->{Autoload};
3637                         push @Dispatches, 'Autoload';
3638                         return 1;
3639                 },
3640                 AutoEnd => sub {
3641                         return 1 unless $C->{AutoEnd};
3642                         push @Cleanups, 'AutoEnd';
3643                         return 1;
3644                 },
3645                 External => sub {
3646                         return 1 unless $C->{External};
3647                         unless($Global::External) {
3648                                 config_warn("External directive set to Yes, but not allowed by Interchange configuration.");
3649                                 return 1;
3650                         }
3651                         return 1 unless $C->{External};
3652                         unless($Global::ExternalStructure) {
3653                                 $Global::ExternalStructure = external_global($Global::ExternalExport);
3654                         }
3655                         $C->{ExternalExport} = external_cat($C->{ExternalExport});
3656                         $Global::ExternalStructure->{Catalogs}{ $C->{CatalogName} }{external_config}
3657                                 = $C->{ExternalExport};
3658                         Vend::Util::uneval_file($Global::ExternalStructure, $Global::ExternalFile);
3659                         chmod 0644, $Global::ExternalFile;
3660                 },
3661 );
3662
3663 sub global_directive_postprocess {
3664         if ($Global::UrlSepChar eq '&') {
3665                 if ($Global::Variable->{MV_HTML4_COMPLIANT}) {
3666                         $Global::UrlJoiner = '&amp;';
3667                         $Global::UrlSplittor = qr/\&amp;|\&/;
3668                 }
3669                 else {
3670                         $Global::UrlJoiner = '&';
3671                         $Global::UrlSplittor = qr/\&/;
3672                 }
3673         }
3674         else {
3675                 $Global::UrlJoiner = $Global::UrlSepChar;
3676                 $Global::UrlSplittor = qr/[&$Global::UrlSepChar]/o;
3677         }
3678                 
3679         $Global::CountrySubdomains ||= {};
3680
3681         while (my ($key,$val) = each(%$Global::CountrySubdomains)) {
3682                 $val =~ s/[\s,]+$//;
3683                 next unless $val;
3684
3685                 $val = '\.(?:' . join('|',split('[\s,]+',$val)) . ")\\.$key";
3686                 $Global::CountrySubdomains->{$key} = qr/$val/i;
3687         }
3688 }
3689
3690 sub set_global_defaults {
3691         ## Nothing here currently
3692 }
3693
3694 my @readonly_members = qw/
3695         UserDB_repository
3696         AdminUserDB
3697 /;
3698
3699 sub set_readonly_config {
3700         my $cat = $C->{CatalogName} or return;
3701         my $ro = $Global::ReadOnlyCfg{$cat} ||= {};
3702         for(@readonly_members) {
3703                 $ro->{$_} = copyref($C->{$_});
3704         }
3705 }
3706
3707 sub set_defaults {
3708         @Dispatches = ();
3709         @Cleanups = ();
3710         for(keys %Default) {
3711                 my ($status, $error) = $Default{$_}->($C->{$_});
3712                 next if $status;
3713                 return config_error(
3714                                 errmsg(
3715                                         'Directive %s returned default setting error: %s',
3716                                         $_,
3717                                         $error
3718                                 )
3719                 );
3720         }
3721         @Dispatches = sort { $Dispatch_priority{$a} cmp $Dispatch_priority{$b} } @Dispatches;
3722         @Cleanups = sort { $Cleanup_priority{$a} cmp $Cleanup_priority{$b} } @Cleanups;
3723         for(@Dispatches) {
3724                 push @{ $C->{DispatchRoutines} ||= [] }, $Dispatch_code{$_};
3725         }
3726         for(@Cleanups) {
3727                 push @{ $C->{CleanupRoutines} ||= [] }, $Cleanup_code{$_};
3728         }
3729
3730     # check MV_HTTP_CHARSET against a valid encoding
3731     if ( !$ENV{MINIVEND_DISABLE_UTF8} &&
3732          (my $enc = $C->{Variable}->{MV_HTTP_CHARSET}) ) {
3733         if (my $norm_enc = Vend::CharSet::validate_encoding($enc)) {
3734             if (uc $norm_enc ne uc($enc)) {
3735                 config_warn("Provided MV_HTTP_CHARSET '$enc' resolved to '$norm_enc'.  Continuing.");
3736                 $C->{Variable}->{MV_HTTP_CHARSET} = $norm_enc;
3737             }
3738         }
3739         else {
3740             config_error("Unrecognized/unsupported MV_HTTP_CHARSET: '%s'.", $enc);
3741             delete $C->{Variable}->{MV_HTTP_CHARSET};
3742         }
3743     }
3744
3745         $Have_set_global_defaults = 1;
3746         return;
3747 }
3748
3749 sub parse_url_sep_char {
3750         my($var,$val) = @_;
3751
3752         $val =~ s/\s+//g;
3753
3754         if($val =~ /[\w%]/) {
3755                 config_error(
3756                         errmsg("%s character value '%s' must not be word character or %%.", $var, $val)
3757                 );
3758         }
3759         elsif(length($val) > 1) {
3760                 config_error(
3761                         "%s character value '%s' longer than one character.",
3762                         $var,
3763                         $val,
3764                 );
3765         }
3766         elsif($val !~ /[&;:]/) {
3767                 config_warn("%s character value '%s' not a recommended value.", $var, $val);
3768         }
3769
3770         return $val;
3771 }
3772
3773 sub check_legal {
3774         my ($directive, $value) = @_;
3775         return 1 unless defined $IllegalValue{$directive}->{$value};
3776         config_error ("\nYou may not use a value of '$value' in the $directive directive.");
3777 }
3778
3779 sub parse_array {
3780         my($item,$settings) = @_;
3781         return '' unless $settings;
3782         my(@setting) = grep /\S/, split /[\s,]+/, $settings;
3783
3784         my $c;
3785
3786         if(defined $C) {
3787                 $c = $C->{$item} || [];
3788         }
3789         else {
3790                 no strict 'refs';
3791                 $c = ${"Global::$item"} || [];
3792         }
3793
3794         for (@setting) {
3795                 check_legal($item, $_);
3796                 push @{$c}, $_;
3797         }
3798         $c;
3799 }
3800
3801 sub parse_routine_array {
3802         my($item,$settings) = @_;
3803
3804         return '' unless $settings;
3805
3806         my $c;
3807         if(defined $C) {
3808                 $c = $C->{$item};
3809         }
3810         else {
3811                 no strict 'refs';
3812                 $c = ${"Global::$item"};
3813         }
3814
3815         my @mac;
3816
3817         if($settings =~ /^[-\s\w,]+$/) {
3818                 @mac = grep /\S/, split /[\s,]+/, $settings;
3819         }
3820         else {
3821                 push @mac, $settings;
3822         }
3823
3824         if(ref($c) eq 'ARRAY') {
3825                 push @$c, @mac;
3826         }
3827         elsif($c) {
3828                 $c = [$c, @mac];
3829         }
3830         else {
3831                 $c = scalar(@mac) > 1 ? [ @mac ] : $mac[0];
3832         }
3833
3834         return $c;
3835 }
3836
3837 sub parse_array_complete {
3838         my($item,$settings) = @_;
3839         return '' unless $settings;
3840         my(@setting) = grep /\S/, split /[\s,]+/, $settings;
3841
3842         my $c = [];
3843
3844         for (@setting) {
3845                 check_legal($item, $_);
3846                 push @{$c}, $_;
3847         }
3848
3849         $c;
3850 }
3851
3852 sub parse_list_wildcard {
3853         my $value = get_wildcard_list(@_,0);
3854         return '' unless length($value);
3855         return qr/$value/i;
3856 }
3857
3858 sub parse_list_wildcard_full {
3859         my $value = get_wildcard_list(@_,1);
3860         return '' unless length($value);
3861         return qr/^($value)$/i;
3862 }
3863
3864 # Make a dos-ish regex into a Perl regex, check for errors
3865 sub parse_wildcard {
3866         my($var, $value) = @_;
3867         return '' if ! $value;
3868
3869         $value =~ s/\./\\./g;
3870         $value =~ s/\*/.*/g;
3871         $value =~ s/\?/./g;
3872         $value =~
3873                 s[({(?:.+?,)+.+?})]
3874                  [ local $_ = $1; tr/{,}/(|)/; $_ ]eg;
3875         $value =~ s/\s+/|/g;
3876         eval {  
3877                 my $never = 'NeVAirBE';
3878                 $never =~ m{$value};
3879         };
3880
3881         if($@) {
3882                 config_error("Bad regular expression in $var.");
3883         }
3884         return $value;
3885 }
3886
3887
3888 # Check that a regex won't cause a syntax error. Uses m{}, which
3889 # should be used for all user-input regexes.
3890 sub parse_regex {
3891         my($var, $value) = @_;
3892
3893         eval {  
3894                 my $never = 'NeVAirBE';
3895                 $never =~ m{$value};
3896         };
3897
3898         if($@) {
3899                 config_error("Bad regular expression in $var.");
3900         }
3901         return $value;
3902 }
3903
3904 sub parse_ip_address_regexp {
3905
3906         my ($var, $value) = @_;
3907         return '' unless $value;
3908
3909         my @atoms = split /[\s,\0]/, $value;
3910
3911         eval {
3912                 require Net::IP::Match::Regexp;
3913         };
3914         $@ and config_error("$var directive requires module: $@");
3915
3916         my $re = Net::IP::Match::Regexp::create_iprange_regexp(@atoms)
3917                 or config_error("Improper IP address range for $var");
3918     return $re;
3919 }
3920
3921 # Prepend the Global::VendRoot pathname to the relative directory specified,
3922 # unless it already starts with a leading /.
3923
3924 sub parse_root_dir {
3925         my($var, $value) = @_;
3926         return '' unless $value;
3927         $value = "$Global::VendRoot/$value"
3928                 unless file_name_is_absolute($value);
3929         $value =~ s./+$..;
3930         return $value;
3931 }
3932
3933 sub parse_root_dir_array {
3934         my($var, $value) = @_;
3935         return [] unless $value;
3936
3937         no strict 'refs';
3938         my $c = ${"Global::$var"} || [];
3939
3940         my @dirs = grep /\S/, Text::ParseWords::shellwords($value);
3941
3942         foreach my $dir (@dirs) {
3943                 $dir = "$Global::VendRoot/$dir"
3944                         unless file_name_is_absolute($dir);
3945                 $dir =~ s./+$..;
3946                 push @$c, $dir;
3947         }
3948         return $c;
3949 }
3950
3951 sub parse_dir_array {
3952         my($var, $value) = @_;
3953         return [] unless $value;
3954
3955         $C->{$var} = [] unless $C->{$var};
3956         my $c = $C->{$var} || [];
3957
3958         my @dirs = grep /\S/, Text::ParseWords::shellwords($value);
3959
3960         foreach my $dir (@dirs) {
3961                 unless (allowed_file($dir)) {
3962                         config_error('Path %s not allowed in %s directive',
3963                                                                 $dir, $var);
3964                 }
3965                 $dir = "$C->{VendRoot}/$dir"
3966                         unless file_name_is_absolute($dir);
3967                 $dir =~ s./+$..;
3968                 push @$c, $dir;
3969         }
3970
3971         return $c;
3972 }
3973
3974 sub parse_relative_dir {
3975         my($var, $value) = @_;
3976
3977         if (absolute_or_relative($value)) {
3978                 config_error('Path %s not allowed in %s directive',
3979                                           $value, $var);
3980         }
3981
3982         $C->{Source}{$var} = $value;
3983
3984         $value = "$C->{VendRoot}/$value"
3985                 unless file_name_is_absolute($value);
3986         $value =~ s./+$..;
3987         $value;
3988 }
3989
3990 # Ensure only an integer value in the directive
3991 sub parse_integer {
3992         my($var, $value) = @_;
3993         $value = hex($value) if $value =~ /^0x[\dA-Fa-f]+$/;
3994         $value = oct($value) if $value =~ /^0[0-7]+$/;
3995         config_error("The $var directive (now set to '$value') must be an integer\n")
3996                 unless $value =~ /^\d+$/;
3997         $value;
3998 }
3999
4000 # Make sure no trailing slash in VendURL etc.
4001 sub parse_url {
4002         my($var, $value) = @_;
4003         $value =~ s,/+$,,;
4004         $value;
4005 }
4006
4007 # Parses a time specification such as "1 day" and returns the
4008 # number of seconds in the interval, or undef if the string could
4009 # not be parsed.
4010
4011 sub time_to_seconds {
4012         my($str) = @_;
4013         my($n, $dur);
4014
4015         ($n, $dur) = ($str =~ m/(\d+)[\s\0]*(\w+)?/);
4016         return undef unless defined $n;
4017         if (defined $dur) {
4018                 local($_) = $dur;
4019                 if (m/^s|sec|secs|second|seconds$/i) {
4020                 }
4021                 elsif (m/^m|min|mins|minute|minutes$/i) {
4022                         $n *= 60;
4023                 }
4024                 elsif (m/^h|hour|hours$/i) {
4025                         $n *= 60 * 60;
4026                 }
4027                 elsif (m/^d|day|days$/i) {
4028                         $n *= 24 * 60 * 60;
4029                 }
4030                 elsif (m/^w|week|weeks$/i) {
4031                         $n *= 7 * 24 * 60 * 60;
4032                 }
4033                 else {
4034                         return undef;
4035                 }
4036         }
4037
4038         $n;
4039 }
4040
4041 sub parse_valid_group {
4042         my($var, $value) = @_;
4043
4044         return '' unless $value;
4045
4046         my($name,$passwd,$gid,$members) = getgrnam($value);
4047
4048         config_error("$var: Group name '$value' is not a valid group\n")
4049                 unless defined $gid;
4050         $name = getpwuid($<);
4051         config_error("$var: Interchange user '$name' not in group '$value'\n")
4052                 unless $members =~ /\b$name\b/;
4053         $gid;
4054 }
4055
4056 sub parse_executable {
4057         my($var, $initial) = @_;
4058         my($x);
4059         my(@tries);
4060         
4061         if(ref $initial) {
4062                 @tries = @$initial;
4063         }
4064         else {
4065                 @tries = $initial;
4066         }
4067
4068         TRYEXE:
4069         foreach my $value (@tries) {
4070 #::logDebug("trying $value for $var");
4071                 my $root = $value;
4072                 $root =~ s/\s.*//;
4073
4074                 return $value if $Global::Windows;
4075                 if( ! defined $value or $value eq '') {
4076                         $x = '';
4077                 }
4078                 elsif( $value eq 'none') {
4079                         $x = 'none';
4080                         last;
4081                 }
4082                 elsif( $value =~ /^\w+::[:\w]+\w$/) {
4083                         ## Perl module like Net::SMTP
4084                         eval {
4085                                 eval "require $value";
4086                                 die if $@;
4087                                 $x = $value;
4088                         };
4089                         last if $x;
4090                 }
4091                 elsif ($root =~ m#^/# and -x $root) {
4092                         $x = $value;
4093                         last;
4094                 }
4095                 else {
4096                         my @path = split /:/, $ENV{PATH};
4097                         for (@path) {
4098                                 next unless -x "$_/$root";
4099                                 $x = $value;
4100                                 last TRYEXE;
4101                         }
4102                 }
4103         }
4104         config_error( errmsg(
4105                                         "Can't find executable (%s) for the %s directive\n",
4106                                         join('|', @tries),
4107                                         $var,
4108                                         )
4109                 ) unless defined $x;
4110 #::logDebug("$var=$x");
4111         return $x;
4112 }
4113
4114 sub parse_time {
4115         my($var, $value) = @_;
4116         my($n);
4117
4118         return $value unless $value;
4119
4120 #       $C->{Source}->{$var} = [$value];
4121
4122         $n = time_to_seconds($value);
4123         config_error("Bad time format ('$value') in the $var directive\n")
4124         unless defined $n;
4125         $n;
4126 }
4127
4128 sub parse_cron {
4129         my($var, $value) = @_;
4130
4131         return '' unless $value =~ /\s/ and $value =~ /[a-zA-Z]/;
4132
4133         unless($Vend::Cron::Loaded) {
4134                  config_warn(
4135                         "Cannot use %s unless %s module loaded%s",
4136                         'crontab',
4137                         'Vend::Cron',
4138                         ' (missing Set::Crontab?)',
4139                         );
4140                  return '';
4141         }
4142         return Vend::Cron::read_cron($value);
4143 }
4144
4145 # Determine catalog structure from Catalog config line(s)
4146 sub parse_catalog {
4147         my ($var, $setting) = @_;
4148         my $num = ! defined $Global::Catalog ? 0 : $Global::Catalog;
4149         return $num unless (defined $setting && $setting); 
4150
4151         my($name,$base,$dir,$script, @rest);
4152         ($name,@rest) = Text::ParseWords::shellwords($setting);
4153
4154         my %remap = qw/
4155                                         base      base
4156                                         alias     alias
4157                                         aliases   alias
4158                                         directory dir
4159                                         dir       dir
4160                                         script    script
4161                                         directive directive
4162                                         fullurl   full_url
4163                                         full      full_url
4164                                         /;
4165
4166         my ($cat, $key, $value);
4167         if ($Global::Catalog{$name}) {
4168                 # already defined
4169                 $cat   = $Global::Catalog{$name};
4170                 $key   = shift @rest;
4171                 $value = shift @rest;
4172         }
4173         elsif(
4174                         $var =~ /subcatalog/i and
4175                         @rest > 2
4176                         and file_name_is_absolute($rest[1]) 
4177                   )
4178         {
4179                 $cat = {
4180                         name   => $name,
4181                         base   => $rest[0],
4182                         dir    => $rest[1],
4183                         script => $rest[2],
4184                 };
4185                 splice(@rest, 0, 3);
4186                 $cat->{alias} = [ @rest ]
4187                         if @rest;
4188         }
4189         elsif( file_name_is_absolute($rest[0]) ) {
4190                 $cat = {
4191                         name   => $name,
4192                         dir    => $rest[0],
4193                         script => $rest[1],
4194                 };
4195                 splice(@rest, 0, 2);
4196                 $cat->{alias} = [ @rest ]
4197                         if @rest;
4198         }
4199         else {
4200                 $key   = shift @rest;
4201                 $value = shift @rest;
4202                 $cat = { name   => $name };
4203         }
4204
4205         $key = $remap{$key} if $key && defined $remap{$key};
4206
4207         if(! $key) {
4208                 # Nada
4209         }
4210         elsif($key eq 'alias' or $key eq 'server') {
4211                 $cat->{$key} = [] if ! $cat->{$key};
4212                 push @{$cat->{$key}}, $value;
4213                 push @{$cat->{$key}}, @rest if @rest;
4214         }
4215         elsif($key eq 'global') {
4216                 $cat->{$key} = $Global::AllowGlobal->{$name} = is_yes($value);
4217         }
4218         elsif($key eq 'directive') {
4219                 no strict 'refs';
4220                 my $p = $value;
4221                 my $v = join " ", @rest;
4222                 $cat->{$key} = {} if ! $cat->{$key};
4223                 my $ref = set_directive($p, $v, 1);
4224
4225                 if(ref $ref->[1] =~ /HASH/) {
4226                         if(! $cat->{$key}{$ref->[0]} ) {
4227                                 $cat->{$key}{$ref->[0]} =  { %{"Global::$ref->[0]"} };
4228                         }
4229                         for (keys %{$ref->[1]}) {
4230                                 $cat->{$key}{$ref->[0]}{$_} = $ref->[1]->{$_};
4231                         }
4232                 }
4233                 else {
4234                         $cat->{$key}{$ref->[0]} = $ref->[1];
4235                 }
4236         }
4237         else {
4238                 $cat->{$key} = $value;
4239         }
4240
4241 #::logDebug ("parsing catalog $name = " . uneval_it($cat));
4242
4243         $Global::Catalog{$name} = $cat;
4244
4245         # Define the main script name and array of aliases
4246         return ++$num;
4247 }
4248
4249 my %Explode_ref = (  qw!
4250                                                         COLUMN_DEF    COLUMN_DEF
4251 !);
4252
4253 my %Hash_ref = (  qw!
4254                                                         FILTER_FROM   FILTER_FROM
4255                                                         FILTER_TO     FILTER_TO 
4256                                                         LENGTH_EXCEPTION LENGTH_EXCEPTION
4257                                                         DEFAULT       DEFAULT
4258                                                         DEFAULT_SESSION       DEFAULT_SESSION
4259                                                         FIELD_ALIAS   FIELD_ALIAS
4260                                                         NUMERIC       NUMERIC
4261                                                         NO_UPDATE     NO_UPDATE
4262                                                         PREFER_NULL   PREFER_NULL
4263                                                         WRITE_CATALOG WRITE_CATALOG
4264                                         ! );
4265
4266 my %Ary_ref = (   qw!
4267                                                 NAME                NAME
4268                                                 BINARY              BINARY 
4269                                                 PRECREATE           PRECREATE 
4270                                                 POSTCREATE          POSTCREATE 
4271                                                 PREQUERY                        PREQUERY
4272                                                 INDEX               INDEX 
4273                                                 ALTERNATE_DSN       ALTERNATE_DSN
4274                                                 ALTERNATE_USER      ALTERNATE_USER
4275                                                 ALTERNATE_PASS      ALTERNATE_PASS
4276                                                 ALTERNATE_BASE_DN   ALTERNATE_BASE_DN
4277                                                 ALTERNATE_LDAP_HOST ALTERNATE_LDAP_HOST
4278                                                 ALTERNATE_BIND_DN   ALTERNATE_BIND_DN
4279                                                 ALTERNATE_BIND_PW   ALTERNATE_BIND_PW
4280                                                 POSTEXPORT          POSTEXPORT
4281                                         ! );
4282
4283 sub parse_config_db {
4284         my($name, $value) = @_;
4285         my ($d, $new);
4286         unless (defined $value && $value) { 
4287                 $d = {};
4288                 return $d;
4289         }
4290
4291         if($C) {
4292                 $d = $C->{ConfigDatabase};
4293         }
4294         else {
4295                 $d = $Global::ConfigDatabase;
4296         }
4297
4298         my($database,$remain) = split /[\s,]+/, $value, 2;
4299
4300         $d->{'name'} = $database;
4301         
4302         if(!defined $d->{'file'}) {
4303                 my($file, $type) = split /[\s,]+/, $remain, 2;
4304                 $d->{'file'} = $file;
4305                 if(             $type =~ /^\d+$/        ) {
4306                         $d->{'type'} = $type;
4307                 }
4308                 elsif(  $type =~ /^(dbi|sql)\b/i        ) {
4309                         $d->{'type'} = 8;
4310                         if($type =~ /^dbi:/) {
4311                                 $d->{DSN} = $type;
4312                         }
4313                 }
4314 # LDAP
4315                 elsif(  $type =~ /^ldap\b/i) {
4316                         $d->{'type'} = 9;
4317                         if($type =~ /^ldap:(.*)/i) {
4318                                 $d->{LDAP_HOST} = $1;
4319                         }
4320                 }
4321 # END LDAP
4322                 elsif(  "\U$type" eq 'TAB'      ) {
4323                         $d->{'type'} = 6;
4324                 }
4325                 elsif(  "\U$type" eq 'PIPE'     ) {
4326                         $d->{'type'} = 5;
4327                 }
4328                 elsif(  "\U$type" eq 'CSV'      ) {
4329                         $d->{'type'} = 4;
4330                 }
4331                 elsif(  "\U$type" eq 'DEFAULT'  ) {
4332                         $d->{'type'} = 1;
4333                 }
4334                 elsif(  $type =~ /[%]{1,3}|percent/i    ) {
4335                         $d->{'type'} = 3;
4336                 }
4337                 elsif(  $type =~ /line/i        ) {
4338                         $d->{'type'} = 2;
4339                 }
4340                 else {
4341                         $d->{'type'} = 1;
4342                         $d->{DELIMITER} = $type;
4343                 }
4344         }
4345         else {
4346                 my($p, $val) = split /\s+/, $remain, 2;
4347                 $p = uc $p;
4348
4349                 if(defined $Explode_ref{$p}) {
4350                         my($ak, $v);
4351                         my(@v) = Text::ParseWords::shellwords($val);
4352                         @v = grep defined $_, @v;
4353                         $d->{$p} = {} unless defined $d->{$p};
4354                         for(@v) {
4355                                 my ($sk,$v) = split /\s*=\s*/, $_;
4356                                 my (@k) = grep /\w/, split /\s*,\s*/, $sk;
4357                                 for my $k (@k) {
4358                                         if($d->{$p}->{$k}) {
4359                                                 config_warn(
4360                                                         qq{Database %s explode parameter %s redefined to "%s", was "%s".},
4361                                                         $d->{name},
4362                                                         "$p --> $k",
4363                                                         $v,
4364                                                         $d->{$p}->{$k},
4365                                                 );
4366                                         }
4367                                         $d->{$p}->{$k} = $v;
4368                                 }
4369                         }
4370                 }
4371                 elsif(defined $Hash_ref{$p}) {
4372                         my($k, $v);
4373                         my(@v) = Vend::Util::quoted_comma_string($val);
4374                         @v = grep defined $_, @v;
4375                         $d->{$p} = {} unless defined $d->{$p};
4376                         for(@v) {
4377                                 ($k,$v) = split /\s*=\s*/, $_;
4378                                 if($d->{$p}->{$k}) {
4379                                         config_warn(
4380                                                 qq{Database %s hash parameter %s redefined to "%s", was "%s".},
4381                                                 $d->{name},
4382                                                 "$p --> $k",
4383                                                 $v,
4384                                                 $d->{$p}->{$k},
4385                                         );
4386                                 }
4387                                 $d->{$p}->{$k} = $v;
4388                         }
4389                 }
4390                 elsif(defined $Ary_ref{$p}) {
4391                         my(@v) = Text::ParseWords::shellwords($val);
4392                         $d->{$p} = [] unless defined $d->{$p};
4393                         push @{$d->{$p}}, @v;
4394                 }
4395                 else {
4396                         defined $d->{$p}
4397                         and ! defined $C->{DatabaseDefault}{$p}
4398                                 and config_warn(
4399                                                 qq{Database %s scalar parameter %s redefined to "%s", was "%s".},
4400                                                 $d->{name},
4401                                                 $p,
4402                                                 $val,
4403                                                 $d->{$p},
4404                                         );
4405                         $d->{$p} = $val;
4406                 }
4407         }
4408
4409 #::logDebug("d object: " . uneval_it($d));
4410         if($d->{ACTIVE} and ! $d->{OBJECT}) {
4411                 my $name = $d->{'name'};
4412                 $d->{OBJECT} = Vend::Data::import_database($d)
4413                         or config_error("Config database $name failed import.\n");
4414         }
4415         elsif($d->{LOAD} and ! $d->{OBJECT}) {
4416                 my $name = $d->{'name'};
4417                 $d->{OBJECT} = Vend::Data::import_database($d)
4418                         or config_error("Config database $name failed import.\n");
4419                 if( $d->{type} == 8 ) {
4420                         $d->{OBJECT}->set_query("delete from $name where 1 = 1");
4421                 }
4422         }
4423
4424         return $d;
4425         
4426 }
4427
4428 sub parse_dbauto {
4429         my ($var, $value) = @_;
4430         return '' unless $value;
4431         my @inc = Vend::Table::DBI::auto_config($value);
4432         my %noed;
4433         for(@inc) {
4434                 my ($t, $thing) = @$_;
4435                 parse_boolean('NoImport', $t) unless $noed{$t}++;
4436                 parse_database('Database', "$t $thing");
4437         }
4438         return 1;
4439 }
4440
4441 sub parse_database {
4442         my ($var, $value) = @_;
4443         my ($c, $new);
4444
4445         if (! $value) {
4446                 $c = {};
4447                 return $c;
4448         }
4449
4450         $c = $C ? $C->{Database} : $Global::Database;
4451
4452         my($database,$remain) = split /[\s,]+/, $value, 2;
4453
4454         if( ! defined $c->{$database} ) {
4455                 $c->{$database} = { 'name' => $database, included_from => $configfile };
4456                 $new = 1;
4457         }
4458
4459         my $d = $c->{$database};
4460
4461         if($new) {
4462                 my($file, $type) = split /[\s,]+/, $remain, 2;
4463                 $d->{'file'} = $file;
4464                 if($file eq 'AUTO_SEQUENCE') {
4465                         # database table missing for AUTO_SEQUENCE directive
4466                         config_error('Missing database %s for AUTO_SEQUENCE %s.', $database, $type);
4467                         return $c;
4468                 }
4469                 if(             $type =~ /^\d+$/        ) {
4470                         $d->{'type'} = $type;
4471                 }
4472                 elsif(  $type =~ /^(dbi|sql)\b/i        ) {
4473                         $d->{'type'} = 8;
4474                         if($type =~ /^dbi:/) {
4475                                 $d->{DSN} = $type;
4476                         }
4477                 }
4478 # LDAP
4479                 elsif(  $type =~ /^ldap\b/i) {
4480                         $d->{'type'} = 9;
4481                         if($type =~ /^ldap:(.*)/i) {
4482                                 $d->{LDAP_HOST} = $1;
4483                         }
4484                 }
4485 # END LDAP
4486                 elsif(  $type =~ /^ic:(\w*)(:(.*))?/ ) {
4487                         my $class = $1;
4488                         my $dir = $3;
4489                         $d->{DIR} = $dir if $dir;
4490                         if($class =~ /^default$/i) {
4491                                 # Do nothing
4492                         }
4493                         elsif($class) {
4494                                 $class = uc $class;
4495                                 if(! $Vend::Data::db_config{$class}) {
4496                                         config_error("unrecognized IC database class: %s (from %s)", $class, $type);
4497                                 }
4498                                 $d->{Class} = $class;
4499                         }
4500                         $d->{'type'} = 6;
4501                 }
4502                 elsif(  "\U$type" eq 'TAB'      ) {
4503                         $d->{'type'} = 6;
4504                 }
4505                 elsif(  "\U$type" eq 'PIPE'     ) {
4506                         $d->{'type'} = 5;
4507                 }
4508                 elsif(  "\U$type" eq 'CSV'      ) {
4509                         $d->{'type'} = 4;
4510                 }
4511                 elsif(  "\U$type" eq 'DEFAULT'  ) {
4512                         $d->{'type'} = 1;
4513                 }
4514                 elsif(  $type =~ /[%]{1,3}|percent/i    ) {
4515                         $d->{'type'} = 3;
4516                 }
4517                 elsif(  $type =~ /line/i        ) {
4518                         $d->{'type'} = 2;
4519                 }
4520                 else {
4521                         $d->{'type'} = 1;
4522                         $d->{DELIMITER} = $type;
4523                 }
4524                 if    ($d->{'type'} eq '8')     { $d->{Class} = 'DBI'                                           }
4525                 elsif ($d->{'type'} eq '9') { $d->{Class} = 'LDAP'                                              }
4526                 else                                            { $d->{Class} ||= $Global::Default_database     }
4527
4528                 if($C and $C->{DatabaseDefault}) {
4529                         $C->{DatabaseDefault}{PG_ENABLE_UTF8} = 0
4530                                 unless defined $C->{DatabaseDefault}{PG_ENABLE_UTF8};
4531                         while ( my($k, $v) = each %{$C->{DatabaseDefault}}) {
4532                                 $d->{$k} = $v;
4533                         }
4534                 }
4535
4536                 $d->{HOT} = 1 if $d->{Class} eq 'MEMORY';
4537 #::logDebug("parse_database: type $type -> $d->{type}");
4538         }
4539         else {
4540                 my($p, $val) = split /\s+/, $remain, 2;
4541                 $p = uc $p;
4542 #::logDebug("parse_database: parameter $p = $val");
4543
4544                 if(defined $Explode_ref{$p}) {
4545                         my($ak, $v);
4546                         $val =~ s/,+$//;
4547                         $val =~ s/^,+//;
4548                         my(@v) = Text::ParseWords::shellwords($val);
4549                         @v = grep length $_, @v;
4550                         $d->{$p} = {} unless defined $d->{$p};
4551                         for(@v) {
4552                                 my ($sk,$v) = split /\s*=\s*/, $_;
4553                                 my (@k) = grep /\w/, split /\s*,\s*/, $sk;
4554                                 for my $k (@k) {
4555                                         if($d->{$p}->{$k}) {
4556                                                 config_warn(
4557                                                         qq{Database %s explode parameter %s redefined to "%s", was "%s".},
4558                                                         $d->{name},
4559                                                         "$p --> $k",
4560                                                         $v,
4561                                                         $d->{$p}->{$k},
4562                                                 );
4563                                         }
4564                                         $d->{$p}->{$k} = $v;
4565                                 }
4566                         }
4567                 }
4568                 elsif(defined $Hash_ref{$p}) {
4569                         my($k, $v);
4570                         my(@v) = Vend::Util::quoted_comma_string($val);
4571                         @v = grep defined $_, @v;
4572                         $d->{$p} = {} unless defined $d->{$p};
4573                         for(@v) {
4574                                 ($k,$v) = split /\s*=\s*/, $_;
4575                                 if($d->{$p}->{$k}) {
4576                                         config_warn(
4577                                                 qq{Database %s hash parameter %s redefined to "%s", was "%s".},
4578                                                 $d->{name},
4579                                                 "$p --> $k",
4580                                                 $v,
4581                                                 $d->{$p}->{$k},
4582                                         );
4583                                 }
4584                                 $d->{$p}->{$k} = $v;
4585                         }
4586                 }
4587                 elsif(defined $Ary_ref{$p}) {
4588                         my(@v) = Text::ParseWords::shellwords($val);
4589                         $d->{$p} = [] unless defined $d->{$p};
4590                         push @{$d->{$p}}, @v;
4591                 }
4592                 elsif ($p eq 'COMPOSITE_KEY') {
4593                     ## Magic hardcode
4594                         if($d->{type} == 8) {
4595                                 $d->{Class} = 'DBI_CompositeKey';
4596                                 $d->{$p} = $val;
4597                         }
4598                         else {
4599                                 config_warn(
4600                                         'Database %s parameter in type with no handling. Ignored.', 
4601                                         $p,
4602                                         );
4603                         }
4604                 }
4605                 elsif ($p eq 'CLASS') {
4606                         $d->{Class} = $val;
4607                 }
4608                 elsif ($p =~ /^(MEMORY|SDBM|GDBM|DB_FILE|LDAP)$/i) {
4609                         $d->{Class} = uc $p;
4610                 }
4611                 elsif ($p eq 'ALIAS') {
4612                         if (defined $c->{$val}) {
4613                                 config_warn("Database '%s' already exists, can't alias.", $val);
4614                         }
4615                         else {
4616                                 $c->{$val} = $d;
4617                         }
4618                 }
4619                 elsif ($p =~ /^MAP/) {
4620                         Vend::Table::Shadow::_parse_config_line ($d, $p, $val);
4621                 }
4622
4623                 else {
4624                         defined $d->{$p}
4625                         and ! defined $C->{DatabaseDefault}{$p}
4626                                 and
4627                                 config_warn(
4628                                         qq{Database %s scalar parameter %s redefined to "%s", was "%s".},
4629                                         $d->{name},
4630                                         $p,
4631                                         $val,
4632                                         $d->{$p},
4633                                 );
4634                         $d->{$p} = $val;
4635                 }
4636                 $d->{HOT} = 1 if $d->{Class} eq 'MEMORY';
4637         }
4638
4639         return $c;
4640 }
4641
4642 sub get_configdb {
4643         my ($var, $value) = @_;
4644         my ($table, $file, $type);
4645         unless ($C->{Database}{$value}) {
4646                 return if $Vend::ExternalProgram;
4647                 ($table, $file, $type) = split /\s+/, $value, 3;
4648                 $file = "$table.txt" unless $file;
4649                 $type = 'TAB' unless $type;
4650                 parse_database('Database',"$table $file $type");
4651                 unless ($C->{Database}{$table}) {
4652                         config_warn(
4653                                 "Bad $var value '%s': %s\n%s",
4654                                 "Database $table $file $type",
4655                                 uneval($C->{Database}),
4656                         );
4657                         return '';
4658                 }
4659         }
4660         else {
4661                 $table = $value;
4662         }
4663
4664         my $db;
4665         unless ($db = $C->{Database}{$table}) {
4666                 return if $Vend::ExternalProgram;
4667                 my $err = $@;
4668                 config_warn("Bad $var '%s': %s", $table, $err);
4669                 return '';
4670         }
4671         eval {
4672                 $db = Vend::Data::import_database($db);
4673         };
4674         if($@ or ! $db) {
4675                 my $err = $@ || errmsg("Unable to import table '%s' for config.", $table);
4676                 delete $C->{Database}{$table};
4677                 die $err;
4678         }
4679         return ($db, $table);
4680 }
4681
4682 my %Columnar = (Locale => 1);
4683
4684 sub parse_configdb {
4685         my ($var, $value) = @_;
4686
4687         my ($file, $type);
4688         return '' if ! $value;
4689         local($Vend::Cfg) = $C;
4690         my ($db, $table);
4691         eval {
4692                 ($db, $table) = get_configdb($var, $value);
4693         };
4694         ::logGlobal("$var $value: $@") if $@;
4695         return '' if ! $db;
4696
4697         my ($k, @f);    # key and fields
4698         my @l;                  # refs to locale repository
4699         my @n;                  # names of locales
4700         my @h;                  # names of locales
4701
4702         my $base_direc = $var;
4703         $base_direc =~ s/Database$//;
4704         my $repos_name = $base_direc . '_repository';
4705         my $repos = $C->{$repos_name} ||= {};
4706
4707         @n = $db->columns();
4708         shift @n;
4709         my $i;
4710         if($Columnar{$base_direc}) {
4711                 my @l;
4712                 for(@n) {
4713                         $repos->{$_} ||= {};
4714                         push @l, $repos->{$_};
4715                 }
4716                 my $i;
4717                 while( ($k , undef, @f ) = $db->each_record) {
4718                         for ($i = 0; $i < @f; $i++) {
4719                                 next unless length($f[$i]);
4720                                 $l[$i]->{$k} = $f[$i];
4721                         }
4722                 }
4723         }
4724         else {
4725                 while( ($k, undef, @f ) = $db->each_record) {
4726                         for ($i = 0; $i < @f; $i++) {
4727                                 next unless length($f[$i]);
4728                                 $repos->{$k}{$n[$i]} = $f[$i];
4729                         }
4730                 }
4731         }
4732         $db->close_table();
4733         return $table;
4734 }
4735
4736 sub parse_dirconfig {
4737         my ($var, $value) = @_;
4738
4739         return '' if ! $value;
4740         $value =~ s/(\w+)\s+//;
4741         my $direc = $1;
4742 #::logDebug("direc=$direc value=$value");
4743          
4744         my $ref = $C->{$direc};
4745
4746         unless(ref($ref) eq 'HASH') {
4747                 config_error("DirConfig called for non-hash configuration directive.");
4748         }
4749
4750         my $source = $C->{$var}   || {};
4751         my $sref = $source->{$direc} || {};
4752
4753         my @dirs = grep -d $_, glob($value);
4754         foreach my $dir (@dirs) {
4755                 opendir(DIRCONFIG, $dir)
4756                         or next;
4757                 my @files = grep /^\w+$/, readdir(DIRCONFIG);
4758                 for(@files) {
4759                         next unless -f "$dir/$_";
4760 #::logDebug("reading key=$_ from $dir/$_");
4761                         $ref->{$_} = readfile("$dir/$_", $Global::NoAbsolute, 0);
4762                         $ref->{$_} = substitute_variable($ref->{$_}) if $C->{ParseVariables};
4763                         $sref->{$_} = "$dir/$_";
4764                 }
4765         }
4766         $source->{$direc} = $sref;
4767         return $source;
4768 }
4769
4770 sub parse_dbconfig {
4771         my ($var, $value) = @_;
4772
4773         my ($file, $type);
4774         return '' if ! $value;
4775         local($Vend::Cfg) = $C;
4776
4777         my ($db, $table);
4778         eval {
4779                 ($db, $table) = get_configdb($var, $value);
4780         };
4781
4782         return '' if ! $db;
4783
4784         my ($k, @f);    # key and fields
4785         my @l;                  # refs to locale repository
4786         my @n;                  # names of locales
4787         my @h;                  # names of locales
4788
4789         @n = $db->columns();
4790         shift @n;
4791         my $extra;
4792         for(@n) {
4793                 my $real = $CDname{lc $_};
4794                 if (! ref $Vend::Cfg->{$real} or $Vend::Cfg->{$real} !~ /HASH/) {
4795                         # ignore non-existent directive, but put in hash
4796                         my $ref = {};
4797                         push @l, $ref;
4798                         push @h, [$real, $ref];
4799                         next;
4800                 }
4801                 push @l, $Vend::Cfg->{$real};
4802         }
4803         my $i;
4804         while( ($k, undef, @f ) = $db->each_record) {
4805 #::logDebug("Got key=$k f=@f");
4806                 for ($i = 0; $i < @f; $i++) {
4807                         next unless length($f[$i]);
4808                         $l[$i]->{$k} = $f[$i];
4809                 }
4810         }
4811         for(@h) {
4812                 $Vend::Cfg->{Hash}{$_->[0]} = $_->[1];
4813         }
4814         $db->close_table();
4815         return $table;
4816 }
4817
4818 sub parse_profile {
4819         my ($var, $value) = @_;
4820         my ($c, $ref, $sref, $i);
4821
4822         if($C) {
4823                 $C->{"${var}Name"} = {} if ! $C->{"${var}Name"};
4824                 $sref = $C->{Source};
4825                 $ref = $C->{"${var}Name"};
4826                 $c = $C->{$var} || [];
4827         }
4828         else {
4829                 no strict 'refs';
4830                 $sref = $Global::Source;
4831                 ${"Global::${var}Name"} = {}
4832                          if ! ${"Global::${var}Name"};
4833                 $ref = ${"Global::${var}Name"};
4834                 $c = ${"Global::$var"} || [];
4835         }
4836
4837         $sref->{$var} = $value;
4838
4839         my (@files) = glob($value);
4840         for(@files) {
4841                 next unless $_;
4842                 config_error(
4843                   "No leading / allowed if NoAbsolute set. Contact administrator.\n")
4844                 if m.^/. and $Global::NoAbsolute;
4845                 config_error(
4846                   "No leading ../.. allowed if NoAbsolute set. Contact administrator.\n")
4847                 if m#^\.\./.*\.\.# and $Global::NoAbsolute;
4848                 push @$c, (split /\s*[\r\n]+__END__[\r\n]+\s*/, readfile($_));
4849         }
4850         for($i = 0; $i < @$c; $i++) {
4851                 if($c->[$i] =~ s/(^|\n)__NAME__\s+([^\n\r]+)\r?\n/$1/) {
4852                         my $name = $2;
4853                         $name =~ s/\s+$//;
4854                         $ref->{$name} = $i;
4855                 }
4856         }
4857
4858         return $c;
4859 }
4860
4861 # Parse ordered or named attributes just like in a usertag.  Needs to have the routine specified as follows:
4862 # ['Foo', sub { &parse_ordered_attributes(@_, [qw(foo bar baz)]) }, 'foo bar baz'],
4863 # If called directly in the normal fashion then you cannot specify the attribute order, but you can
4864 # still use it for parsing named attributes.  The results are stored as a hashref (think $opt)
4865 sub parse_ordered_attributes {
4866         my ($var, $value, $order) = @_;
4867
4868         return {} if $value !~ /\S/;
4869
4870         my @settings = Text::ParseWords::shellwords($value);
4871         my %opt;
4872         if ($settings[0] =~ /=/) {
4873                 %opt = map { (split /=/, $_, 2)[0, 1] } @settings;
4874         }
4875
4876         elsif (ref $order eq 'ARRAY') {
4877                 @opt{@$order} = @settings;
4878         }
4879
4880         else {
4881                 config_error("$var only accepts named attributes.");
4882         }
4883
4884         return \%opt;
4885 }
4886
4887 # Designed to parse catalog subroutines and all vars
4888 sub save_variable {
4889         my ($var, $value) = @_;
4890         my ($c, $name, $param);
4891
4892         if(defined $C) {
4893                 $c = $C->{$var};
4894         }
4895         else { 
4896                 no strict 'refs';
4897                 $c = ${"Global::$var"};
4898         }
4899
4900         if ($var eq 'Variable' || $var eq 'Member') {
4901                 $value =~ s/^\s*(\w+)\s*//;
4902                 $name = $1;
4903                 return 1 if defined $c->{'save'}->{$name};
4904                 $value =~ s/\s+$//;
4905                 $c->{'save'}->{$name} = $value;
4906         }
4907         elsif ( !defined $C) { 
4908                 return 0;
4909         }
4910         elsif ( defined $C->{Source}{$var} && ref $C->{Source}{$var}) {
4911                 push @{$C->{Source}{$var}}, $value;
4912         }
4913         elsif ( defined $C->{Source}{$var}) {
4914                 $C->{Source}{$var} .= "\n$value";
4915         }
4916         else {
4917                 $C->{Source}{$var} = $value;
4918         }
4919         return 1;
4920
4921 }
4922
4923 sub map_widgets {
4924         my $gref;
4925         my $return      = ($gref = $Vend::Cfg->{CodeDef}{Widget})
4926                                                 ? $gref->{Routine}
4927                                                 : {};
4928         if(my $ref = $Global::CodeDef->{Widget}{Routine}) {
4929                 while ( my ($k, $v) = each %$ref) {
4930                         next if $return->{$k};
4931                         $return->{$k} = $v;
4932                 }
4933         }
4934         if(my $ref = $Global::CodeDef->{Widget}{MapRoutine}) {
4935                 no strict 'refs';
4936                 while ( my ($k, $v) = each %$ref) {
4937                         next if $return->{$k};
4938                         $return->{$k} = \&{"$v"};
4939                 }
4940         }
4941         if(my $ref = $Global::CodeDef->{Widget}{attrDefault}) {
4942                 no strict 'refs';
4943                 while ( my ($k, $v) = each %$ref) {
4944                         next if $return->{$k};
4945                         $return->{$k} = \&{"$v"};
4946                 }
4947         }
4948         return $return;
4949 }
4950
4951 sub map_widget_defaults {
4952         my $gref;
4953         my $return      = ($gref = $Vend::Cfg->{CodeDef}{Widget})
4954                                                 ? $gref->{attrDefault}
4955                                                 : {};
4956         if(my $ref = $Global::CodeDef->{Widget}{attrDefault}) {
4957                 while ( my ($k, $v) = each %$ref) {
4958                         next if $return->{$k};
4959                         $return->{$k} = $v;
4960                 }
4961         }
4962         return $return;
4963 }
4964
4965 sub map_codedef_to_directive {
4966         my $type = shift;
4967
4968         no strict 'refs';
4969
4970         my $c;
4971         my $cfg;
4972
4973         if( $C ) {
4974                 $c = $C->{CodeDef};
4975                 $cfg = $C->{$type}                      ||= {};
4976         }
4977         else {
4978                 $c = $Global::CodeDef;
4979                 $cfg =${"Global::$type"}        ||= {};
4980         }
4981
4982         my $ref;
4983         my $r;
4984
4985         return unless $r = $c->{$type};
4986         return unless $ref = $r->{Routine};
4987
4988         for(keys %$ref ) {
4989                 $cfg->{$_} = $ref->{$_};
4990                 }
4991 }
4992
4993 sub global_map_codedef {
4994         my $type = shift;
4995         map_codedef_to_directive($type);
4996         Vend::Dispatch::update_global_actions();
4997 }
4998
4999 my %MappedInit = (
5000         Filter => sub {
5001
5002 #::logDebug("Called filter MappedInit");
5003                 return if $C;
5004 #::logDebug("No \$C");
5005
5006                 my $c = $Global::CodeDef;
5007                 my $typeref = $c->{Filter}
5008                         or return;
5009                 my $submap = $typeref->{Routine}
5010                         or return;
5011
5012                 for(keys %$submap) {
5013 #::logDebug("Setting Filter for $_=$submap->{$_}");
5014                         $Vend::Interpolate::Filter{$_} = $submap->{$_};
5015                 }
5016                 if (my $ref = $typeref->{Alias}) {
5017 #::logDebug("We have an Alias ref");
5018                         for(keys %$ref) {
5019 #::logDebug("Checking Alias ref for $_=$ref->{$_}");
5020                                 if (exists $Vend::Interpolate::Filter{$ref->{$_}}) {
5021 #::logDebug("Setting Alias ref to $Vend::Interpolate::Filter{$ref->{$_}}");
5022                                         $submap->{$_}
5023                                                 = $Vend::Interpolate::Filter{$_}
5024                                                 = $Vend::Interpolate::Filter{$ref->{$_}};
5025                                 }
5026                         }
5027                 }
5028 #::logDebug("Filter is " . ::uneval(\%Vend::Interpolate::Filter));
5029         },
5030         ItemAction      => \&map_codedef_to_directive,
5031         OrderCheck      => \&map_codedef_to_directive,
5032         ActionMap       => \&global_map_codedef,
5033         FormAction      => \&global_map_codedef,
5034         Widget          => sub {
5035                                                 return unless $Vend::Cfg;
5036                                                 $Vend::UserWidget = map_widgets();
5037                                                 $Vend::UserWidgetDefault = map_widget_defaults();
5038                                         },
5039         UserTag         => sub {
5040                                                 return if $C;
5041                                                 return unless $Vend::Cfg;
5042                                                 Vend::Parse::add_tags($Global::UserTag);
5043                                         },
5044 );
5045
5046 sub finalize_mapped_code {
5047         my @types = @_;
5048         unless(@types) {
5049                 @types = grep $_, values %valid_dest;
5050         }
5051         
5052         for my $type (@types) {
5053                 if(my $sub = $MappedInit{$type}) {
5054                         $sub->($type);
5055                 }
5056         }
5057 }
5058
5059 my %Compiled = qw/
5060                                         Routine     Routine
5061                                         PosRoutine  PosRoutine
5062                                         HashCode    Routine
5063                                         ArrayCode   Routine
5064                                 /;
5065
5066 sub parse_mapped_code {
5067         my ($var, $value) = @_;
5068
5069         return {} if ! $value;
5070
5071         ## Can't give CodeDef a default or this will be premature
5072         get_system_code() unless defined $SystemCodeDone;
5073
5074         my($tag,$p,$val) = split /\s+/, $value, 3;
5075
5076         # Canonicalize
5077         $p = $tagCanon{lc $p} || ''
5078                 or ::logDebug("bizarre mapped code line '$value'");
5079         $tag =~ tr/-/_/;
5080         $tag =~ s/\W//g
5081                 and config_warn("Bad characters removed from '%s'.", $tag);
5082
5083         my $repos = $C ? ($C->{CodeDef} ||= {}) : ($Global::CodeDef ||= {});
5084
5085         if ($tagSkip{$p}) {
5086                 return $repos;
5087         }
5088         
5089         my $dest = $valid_dest{lc $p} || $current_dest{$tag} || $CodeDest;