[interchange-cvs] interchange - heins modified 7 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Tue May 3 02:03:27 EDT 2005
User: heins
Date: 2005-05-03 06:03:27 GMT
Modified: lib/Vend Config.pm Dispatch.pm Form.pm Interpolate.pm
Modified: Parse.pm Server.pm Util.pm
Log:
* Implement new AccumulateCode and TagRepository directives. The rationale
is:
-- There is a huge base of Interchange code, much of which is not
needed in even the standard catalog with full UI. This causes a
larger memory profile than necessary.
-- It is difficult to determine from the page code what code is
needed, especially when a [tag] can call a $Tag can call
a filter can call some sort of Action.
-- A feature is needed to allow building catalogs with a more
nearly optimal set of code than just "everything".
If AccumulateCode is no, operation is exactly as before. There have
been some code initialization changes and routine calling changes,
but the data structures are identical and no difference in operation
should be seen.
If you set AccumulateCode to "Yes" and specify a TagRepository that
contains all known UserTag, ActionMap, Filter, Widget, etc. etc.
code, Interchange starts accumulating and compiling these as
needed.
The code is sent to the master process for compilation and
incorporation, so that the next iteration of a page after HouseKeeping
seconds will find the code already compiled and ready to go.
It also copies the code file to the "code" (actually $Global::TagDir)
directory in the "Accumulated" subdirectory tree. When you restart
Interchange, these tags/filters/widgets/checks are read normally
and need not be recompiled on the fly.
Over time, as you access pages and routines, a full set of tags
will be developed and you can turn AccumulateCode to "No".
* There can be failures due to calling a $Tag from within embedded
Perl for the first time, particularly when it uses a MapRoutine or
calls another $Tag within. This is due to Safe, and there is probably
not much to be done about it. The good news is that the error should
go away after HouseKeeping seconds when the tag gets compiled by the
master.
This could be avoided in the case of an AllowGlobal catalog, and it
might be possible to make a directive that turns on AllowGlobal only
when in AccumulateCode mode.
The area, tmp, tmpn, and image tags are known to fail in this
way in the standard catalog. Tags that are frequently called
in this fashion should probably be placed in a "code/Vital"
directory and not be accumulated.
* This is only recommended for development -- it might
be possible to remove a tag/filter/etc. from the master
and recompile these on the fly, but I haven't looked at that
yet.
Another nice feature is that you can easily add a tag simply
by adding its code to the TagRepository and having it
compiled.
* WARNING: Nice features are often dangerous! Don't run this in
production -- you have been warned!
* WARNING: OrderCheck is not yet implemented, and a full audit has
not been done on all compiled code directives.
* WARNING: Not fully tested in Prefork mode, and really not intended for
that mode.
* WARNING: Including multiple tags in a file may have unpredictable
behavior. You should try to keep related Alias and tag things in
the same file.
* This feature only applies to Global code -- Catalog-based code
shows no change.
* Passes the regression tests 100% when called with an empty "code"
directory, compiling every tested tag and executing without error.
Revision Changes Path
2.170 +390 -121 interchange/lib/Vend/Config.pm
rev 2.170, prev_rev 2.169
Index: Config.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Config.pm,v
retrieving revision 2.169
retrieving revision 2.170
diff -u -r2.169 -r2.170
--- Config.pm 30 Apr 2005 15:09:57 -0000 2.169
+++ Config.pm 3 May 2005 06:03:26 -0000 2.170
@@ -1,6 +1,6 @@
# Vend::Config - Configure Interchange
#
-# $Id: Config.pm,v 2.169 2005/04/30 15:09:57 mheins Exp $
+# $Id: Config.pm,v 2.170 2005/05/03 06:03:26 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -37,11 +37,12 @@
use vars qw(
$VERSION $C
@Locale_directives_ary @Locale_directives_scalar
- @Locale_directives_code
+ @Locale_directives_code %tagCanon
%ContainerSave %ContainerTrigger %ContainerSpecial %ContainerType
%Default %Dispatch_code %Dispatch_priority
@Locale_directives_currency @Locale_keys_currency
$GlobalRead $SystemCodeDone $SystemGroupsDone $CodeDest
+ $SystemReposDone $ReposDest
);
use Safe;
use Fcntl;
@@ -50,7 +51,7 @@
use Vend::File;
use Vend::Data;
-$VERSION = substr(q$Revision: 2.169 $, 10);
+$VERSION = substr(q$Revision: 2.170 $, 10);
my %CDname;
my %CPname;
@@ -202,6 +203,110 @@
Variable->SQLUSER
);
+my %extmap = qw/
+ ia ItemAction
+ fa FormAction
+ am ActionMap
+ oc OrderCheck
+ ut UserTag
+ fi Filter
+ so SearchOp
+ fw Widget
+ lc LocaleChange
+ tag UserTag
+ ct CoreTag
+ jsc JavaScriptCheck
+/;
+
+for( values %extmap ) {
+ $extmap{lc $_} = $_;
+}
+
+%tagCanon = ( qw(
+
+ group Group
+ actionmap ActionMap
+ arraycode ArrayCode
+ hashcode HashCode
+ coretag CoreTag
+ searchop SearchOp
+ filter Filter
+ formaction FormAction
+ ordercheck OrderCheck
+ usertag UserTag
+ systemtag SystemTag
+ widget Widget
+
+ alias Alias
+ addattr addAttr
+ attralias attrAlias
+ attrdefault attrDefault
+ cannest canNest
+ description Description
+ override Override
+ visibility Visibility
+ help Help
+ documentation Documentation
+ extrameta ExtraMeta
+ gobble Gobble
+ hasendtag hasEndTag
+ implicit Implicit
+ interpolate Interpolate
+ invalidatecache InvalidateCache
+ isendanchor isEndAnchor
+ norearrange noRearrange
+ order Order
+ posnumber PosNumber
+ posroutine PosRoutine
+ maproutine MapRoutine
+ noreparse NoReparse
+ javascriptcheck JavaScriptCheck
+ required Required
+ routine Routine
+ version Version
+));
+
+
+my %tagAry = ( qw! Order 1 Required 1 ! );
+my %tagHash = ( qw!
+ attrAlias 1
+ Implicit 1
+ attrDefault 1
+ ! );
+my %tagBool = ( qw!
+ ActionMap 1
+ addAttr 1
+ canNest 1
+ Filter 1
+ FormAction 1
+ hasEndTag 1
+ Interpolate 1
+ isEndAnchor 1
+ isOperator 1
+ ItemAction 1
+ noRearrange 1
+ NoReparse 1
+ OrderCheck 1
+ UserTag 1
+ ! );
+
+my %current_dest;
+my %valid_dest = qw/
+ actionmap ActionMap
+ coretag UserTag
+ filter Filter
+ formaction FormAction
+ itemaction ItemAction
+ ordercheck OrderCheck
+ usertag UserTag
+ hashcode HashCode
+ arraycode ArrayCode
+ searchop SearchOp
+ widget Widget
+ javascriptcheck JavaScriptCheck
+ /;
+
+
my $StdTags;
use vars qw/ $configfile /;
@@ -303,6 +408,8 @@
)
? ($Global::Unix_Mode || 0) : 'Yes'],
['TcpMap', 'hash', ''],
+ ['TagRepository', 'root_dir', ''],
+ ['AccumulateCode', 'yesno', 'No'],
['Environment', 'array', ''],
['TcpHost', undef, 'localhost 127.0.0.1'],
['AcceptRedirect', 'yesno', 'No'],
@@ -624,6 +731,124 @@
}
+sub code_from_file {
+ my ($area, $name, $nohup) = @_;
+ my $c;
+ my $fn;
+#::logDebug("code_from_file $area, $name");
+ return unless $c = $Global::TagLocation->{$area};
+#::logDebug("We have a repos for $area");
+ return unless $fn = $c->{$name};
+#::logDebug("code_from_file found file=$fn");
+
+#::logDebug("master reading in new area=$area name=$name fn=$fn") if $nohup;
+
+ local $/;
+ $/ = "\n";
+
+ undef $C;
+
+ my $tdir = $Global::TagDir->[0];
+ my $accdir = "$tdir/Accumulated";
+
+ my $newfn = $fn;
+ $newfn =~ s{^$Global::TagRepository/*}{};
+
+ my $lfile = "$accdir/$newfn";
+ my $ldir = $lfile;
+ $ldir =~ s{/[^/]+$}{};
+ unless(-d $ldir) {
+ die "Supposed directory $ldir is a file" if -e $ldir;
+ File::Path::mkpath($ldir)
+ or die "Cannot create directory $ldir: $!";
+ }
+
+ my $printnew;
+ if(-f $lfile) {
+ ## This has already been submitted for master integration, no
+ ## need to do it
+ $nohup = 1;
+ }
+ else {
+ open NEWTAG, ">> $lfile"
+ or die "Cannot write new tag file $lfile: $!";
+ if (lockfile(\*NEWTAG, 1, 0)) {
+ ## We got a lock, we are the only one
+ File::Copy::copy($fn, $lfile);
+ unlockfile(\*NEWTAG);
+ close NEWTAG;
+ }
+ else {
+ ## No lock, some other process doing same thing
+ }
+ }
+
+ open SYSTAG, "< $fn"
+ or config_error("read system tag file %s: %s", $fn, $!);
+
+ while(<SYSTAG>) {
+ my $line = $_;
+ my($lvar, $value) = read_config_value($_, \*SYSTAG);
+ next unless $lvar;
+ eval {
+ $GlobalRead->($lvar, $value);
+ };
+ if($@ =~ /Duplicate\s+usertag/i) {
+ next;
+ }
+ }
+ close SYSTAG;
+ close NEWTAG;
+
+ finalize_mapped_code($area);
+
+ my $precursor = '';
+ my $routine;
+ my $init;
+ if($area eq 'UserTag') {
+ $init = $Global::UserTag->{Bootstrap}{$name};
+ $routine = $Global::UserTag->{Routine}{$name};
+#::logDebug("NO ROUTINE FOR area=$area name=$name") unless $routine;
+ }
+ else {
+ $precursor = 'CodeDef ';
+ $init = $Global::CodeDef->{$area}{Bootstrap}{$name};
+ $routine = $Global::CodeDef->{$area}{Routine}{$name};
+ if(! $routine) {
+ no strict 'refs';
+ $routine = $Global::CodeDef->{$area}{MapRoutine}{$name}
+ and $routine = \&{"$routine"};
+ }
+#::logDebug("area=$area name=$name now=" . ::uneval($Global::CodeDef->{$area}));
+ }
+
+ if($init and ref($routine) eq 'CODE') {
+ ## Attempt to initialize
+ $init = Vend::Util::get_option_hash($init);
+ $routine->($init);
+ }
+
+
+ ## Tell the master server we have a new tag
+ unless($nohup) {
+#::logDebug("notifying master of new area=$area name=$name fn=$fn");
+ ## Bring this tag in global
+ open(RESTART, ">>$Global::RunDir/restart")
+ or die "open $Global::RunDir/restart: $!\n";
+ lockfile(\*RESTART, 1, 1)
+ or die "lock $Global::RunDir/restart: $!\n";
+ print RESTART "$precursor$area $name\n";
+ unlockfile(\*RESTART)
+ or die "unlock $Global::RunDir/restart: $!\n";
+ close RESTART;
+ kill 'HUP', $Vend::MasterProcess;
+ }
+
+#::logDebug("routine=$routine for area=$area name=$name");
+#::logDebug("REF IS=" . ::uneval($Global::UserTag)) if $nohup;
+ return $routine;
+}
+
sub set_directive {
my ($directive, $value, $global) = @_;
my $directives;
@@ -1227,25 +1452,6 @@
use File::Find;
-my %extmap = qw/
- ia ItemAction
- fa FormAction
- am ActionMap
- oc OrderCheck
- ut UserTag
- fi Filter
- so SearchOp
- fw Widget
- lc LocaleChange
- tag UserTag
- ct CoreTag
- jsc JavaScriptCheck
-/;
-
-for( values %extmap ) {
- $extmap{lc $_} = $_;
-}
-
sub get_system_groups {
my @files;
@@ -1269,6 +1475,59 @@
return;
}
+sub get_repos_code {
+
+#::logDebug("get_repos_code called");
+ return unless $Global::TagRepository;
+
+ return if $Vend::ControllingInterchange;
+
+ my @files;
+ my $wanted = sub {
+ return if (m{^\.} || ! -f $_);
+ return unless m{^[^.]+\.(\w+)$};
+ my $ext = $extmap{lc $1} or return;
+ push @files, [ $File::Find::name, $ext];
+ };
+ File::Find::find($wanted, $Global::TagRepository);
+
+ my $c = $Global::TagLocation = {};
+
+ # %valid_dest is scoped as my variable above
+
+ for(@files) {
+ my $foundfile = $_->[0];
+ my $dest = $_->[1];
+ open SYSTAG, "< $foundfile"
+ or next;
+ while(<SYSTAG>) {
+ my($lvar, $value) = read_config_value($_, \*SYSTAG);
+ my $name;
+ my $dest;
+ if($lvar eq 'codedef') {
+ $value =~ s/^(\S+)\s+(\S+).*//s;
+ $dest = $valid_dest{lc $2};
+ $name = $1;
+ }
+ elsif($dest = $valid_dest{$lvar}) {
+ $value =~ m/^(\S+)\s+/
+ and $name = $1;
+ }
+
+ next unless $dest and $name;
+
+ $name = lc $name;
+ $name =~ s/-/_/g;
+ $c->{$dest} ||= {};
+ $c->{$dest}{$name} ||= $foundfile;
+ }
+ close SYSTAG;
+ }
+
+#::logDebug("repos is:\n" . ::uneval($Global::TagLocation));
+
+}
+
sub get_system_code {
return if $CodeDest;
@@ -1320,6 +1579,7 @@
#
s/\s+$//; # trailing spaces
return undef unless $_;
+::logGlobal("What is going on? line=$_") unless /^.*\S.*/;
local($Vend::config_line);
$Vend::config_line = $_;
@@ -1335,7 +1595,7 @@
}
else {
# lines read from the config file become untainted
- m/^[ \t]*(\w+)\s+(.*)/ or config_error("Syntax error");
+ m/^[ \t]*(\w+)\s+(.*)/ or config_error("Syntax error from $_");
$var = $1;
$value = $2;
}
@@ -1487,21 +1747,25 @@
my $read = sub {
my ($lvar, $value, $tie) = @_;
+#::logDebug("Doing a GlobalRead for $lvar") unless $Global::Foreground;
unless (defined $CDname{$lvar}) {
config_error("Unknown directive '%s'", $var);
return;
}
+#::logDebug("Continuing a GlobalRead for $lvar") unless $Global::Foreground;
if (defined $DumpSource{$CDname{$directive}}) {
$Global::Structure->{ $CDname{$directive} } = $value;
}
# call the parsing function for this directive
$parse = $parse{$lvar};
+#::logDebug("parse routine is $parse for $CDname{$lvar}") unless $Global::Foreground;
$value = $parse->($CDname{$lvar}, $value) if defined $parse;
# and set the Global::directive variable
${'Global::' . $CDname{$lvar}} = $value;
+#::logDebug("It is now=" . ::uneval($value)) unless $Global::Foreground;
$Global::Structure->{ $CDname{$lvar} } = $value
unless defined $DontDump{ $CDname{$lvar} };
};
@@ -1600,7 +1864,10 @@
ADDTAGS: {
Vend::Parse::global_init;
}
- undef $GlobalRead;
+ undef $GlobalRead unless $Global::AccumulateCode;
+
+ ## Pulls in the places where code can be found when AccumulatingTags
+ get_repos_code() if $Global::AccumulateCode;
finalize_mapped_code();
@@ -3977,118 +4244,116 @@
}
-my %tagCanon = ( qw(
+sub map_widgets {
+ my $ref;
+ my $return = ($ref = $Vend::Cfg->{CodeDef}{Widget})
+ ? $ref->{Routine}
+ : {};
+ if(my $ref = $Global::CodeDef->{Widget}{Routine}) {
+ while ( my ($k, $v) = each %$ref) {
+ next if $return->{$k};
+ $return->{$k} = $v;
+ }
+ }
+ if(my $ref = $Global::CodeDef->{Widget}{MapRoutine}) {
+ no strict 'refs';
+ while ( my ($k, $v) = each %$ref) {
+ next if $return->{$k};
+ $return->{$k} = \&{"$v"};
+ }
+ }
+ return $return;
+}
- group Group
- actionmap ActionMap
- arraycode ArrayCode
- hashcode HashCode
- coretag CoreTag
- searchop SearchOp
- filter Filter
- formaction FormAction
- ordercheck OrderCheck
- usertag UserTag
- systemtag SystemTag
- widget Widget
+sub map_codedef_to_directive {
+ my $type = shift;
- alias Alias
- addattr addAttr
- attralias attrAlias
- attrdefault attrDefault
- cannest canNest
- description Description
- override Override
- visibility Visibility
- help Help
- documentation Documentation
- extrameta ExtraMeta
- gobble Gobble
- hasendtag hasEndTag
- implicit Implicit
- interpolate Interpolate
- invalidatecache InvalidateCache
- isendanchor isEndAnchor
- norearrange noRearrange
- order Order
- posnumber PosNumber
- posroutine PosRoutine
- maproutine MapRoutine
- noreparse NoReparse
- javascriptcheck JavaScriptCheck
- required Required
- routine Routine
- version Version
-));
+ no strict 'refs';
+ my $c;
+ my $cfg;
-my %tagAry = ( qw! Order 1 Required 1 Version 1 ! );
-my %tagHash = ( qw!
- attrAlias 1
- Implicit 1
- attrDefault 1
- ! );
-my %tagBool = ( qw!
- ActionMap 1
- addAttr 1
- canNest 1
- Filter 1
- FormAction 1
- hasEndTag 1
- Interpolate 1
- isEndAnchor 1
- isOperator 1
- ItemAction 1
- noRearrange 1
- NoReparse 1
- OrderCheck 1
- UserTag 1
- ! );
+ if( $C ) {
+ $c = $C->{CodeDef};
+ $cfg = $C->{$type} ||= {};
+ }
+ else {
+ $c = $Global::CodeDef;
+ $cfg =${"Global::$type"} ||= {};
+ }
-my %current_dest;
-my %valid_dest = qw/
- actionmap ActionMap
- coretag UserTag
- filter Filter
- formaction FormAction
- itemaction ItemAction
- ordercheck OrderCheck
- usertag UserTag
- hashcode HashCode
- arraycode ArrayCode
- searchop SearchOp
- widget Widget
- /;
+ my $ref;
+ my $r;
-sub finalize_mapped_code {
- my $c = $C ? $C->{CodeDef} : $Global::CodeDef;
- my ($typeref, $ref, $cfg);
+ next unless $r = $c->{$type};
+ next unless $ref = $r->{Routine};
- if(! $C && ($typeref = $c->{Filter}) && ($ref = $typeref->{Routine})) {
- for(keys %$ref) {
- $Vend::Interpolate::Filter{$_} = $ref->{$_};
+ for(keys %$ref ) {
+ $cfg->{$_} = $ref->{$_};
}
- if ($ref = $typeref->{Alias}) {
+}
+
+sub global_map_codedef {
+ my $type = shift;
+ map_codedef_to_directive($type);
+ Vend::Dispatch::update_global_actions();
+}
+
+my %MappedInit = (
+ Filter => sub {
+
+#::logDebug("Called filter MappedInit");
+ return if $C;
+#::logDebug("No \$C");
+
+ my $c = $Global::CodeDef;
+ my $typeref = $c->{Filter}
+ or return;
+ my $submap = $typeref->{Routine}
+ or return;
+
+ for(keys %$submap) {
+#::logDebug("Setting Filter for $_=$submap->{$_}");
+ $Vend::Interpolate::Filter{$_} = $submap->{$_};
+ }
+ if (my $ref = $typeref->{Alias}) {
+#::logDebug("We have an Alias ref");
for(keys %$ref) {
+#::logDebug("Checking Alias ref for $_=$ref->{$_}");
if (exists $Vend::Interpolate::Filter{$ref->{$_}}) {
- $Vend::Interpolate::Filter{$_} = $Vend::Interpolate::Filter{$ref->{$_}};
+#::logDebug("Setting Alias ref to $Vend::Interpolate::Filter{$ref->{$_}}");
+ $submap->{$_}
+ = $Vend::Interpolate::Filter{$_}
+ = $Vend::Interpolate::Filter{$ref->{$_}};
}
}
}
+#::logDebug("Filter is " . ::uneval(\%Vend::Interpolate::Filter));
+ },
+ ItemAction => \&map_codedef_to_directive,
+ OrderCheck => \&map_codedef_to_directive,
+ ActionMap => \&global_map_codedef,
+ FormAction => \&global_map_codedef,
+ Widget => sub {
+ return unless $Vend::Cfg;
+ $Vend::UserWidget = map_widgets();
+ },
+ UserTag => sub {
+ return if $C;
+ return unless $Vend::Cfg;
+ Vend::Parse::add_tags($Global::UserTag);
+ },
+);
+
+sub finalize_mapped_code {
+ my @types = @_;
+ unless(@types) {
+ @types = grep $_, values %valid_dest;
}
- no strict 'refs';
- for my $type (qw/ ActionMap FormAction ItemAction OrderCheck /) {
- my $ref;
- my $r;
- next unless $r = $c->{$type};
- next unless $ref = $r->{Routine};
- my $cfg = $C
- ? ($C->{$type} ||= {})
- : (${"Global::$type"} ||= {})
- ;
- for(keys %$ref ) {
- $cfg->{$_} = $ref->{$_};
+ for my $type (@types) {
+ if(my $sub = $MappedInit{$type}) {
+ $sub->($type);
}
}
}
@@ -4164,6 +4429,7 @@
my ($var, $value) = @_;
my ($new);
+#::logDebug("parse_tag var=$var val=$value") unless $Global::Foreground;
return if $Vend::ExternalProgram;
unless (defined $value && $value) {
@@ -4173,6 +4439,7 @@
return parse_mapped_code($var, $value)
if $var ne 'UserTag';
+#::logDebug("ready to read tag, C='$C' SystemCodeDone=$SystemCodeDone") unless $Global::Foreground;
get_system_code() unless defined $SystemCodeDone;
my $c = defined $C ? $C->{UserTag} : $Global::UserTag;
@@ -4194,6 +4461,7 @@
return $c unless $Global::TagInclude->{$tag} || $Global::TagInclude->{ALL};
}
+#::logDebug("ready to read tag=$tag p=$p") unless $Global::Foreground;
if($p eq 'Override') {
for (keys %$c) {
delete $c->{$_}{$tag};
@@ -4273,6 +4541,7 @@
unless defined $c->{Order}{$tag};
}
elsif (! $C and $p eq 'MapRoutine') {
+#::logDebug("In MapRoutine ") unless $Global::Foreground;
$val =~ s/^\s+//;
$val =~ s/\s+$//;
no strict 'refs';
1.53 +4 -2 interchange/lib/Vend/Dispatch.pm
rev 1.53, prev_rev 1.52
Index: Dispatch.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Dispatch.pm,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- Dispatch.pm 30 Apr 2005 15:09:58 -0000 1.52
+++ Dispatch.pm 3 May 2005 06:03:26 -0000 1.53
@@ -1,6 +1,6 @@
# Vend::Dispatch - Handle Interchange page requests
#
-# $Id: Dispatch.pm,v 1.52 2005/04/30 15:09:58 mheins Exp $
+# $Id: Dispatch.pm,v 1.53 2005/05/03 06:03:26 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 2002 Mike Heins <mike at perusion.net>
@@ -26,7 +26,7 @@
package Vend::Dispatch;
use vars qw($VERSION);
-$VERSION = substr(q$Revision: 1.52 $, 10);
+$VERSION = substr(q$Revision: 1.53 $, 10);
use POSIX qw(strftime);
use Vend::Util;
@@ -642,8 +642,10 @@
$sub = $Vend::Cfg->{FormAction}{$todo};
}
elsif (not $sub = $form_action{$todo} ) {
+ unless ($sub = Vend::Util::codedef_routine('FormAction', $todo)) {
interaction_error("No action passed for processing\n");
return;
+ }
}
eval {
$status = $sub->($todo);
2.60 +11 -23 interchange/lib/Vend/Form.pm
rev 2.60, prev_rev 2.59
Index: Form.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Form.pm,v
retrieving revision 2.59
retrieving revision 2.60
diff -u -r2.59 -r2.60
--- Form.pm 30 Apr 2005 15:09:58 -0000 2.59
+++ Form.pm 3 May 2005 06:03:26 -0000 2.60
@@ -1,6 +1,6 @@
# Vend::Form - Generate Form widgets
#
-# $Id: Form.pm,v 2.59 2005/04/30 15:09:58 mheins Exp $
+# $Id: Form.pm,v 2.60 2005/05/03 06:03:26 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -39,7 +39,7 @@
require Exporter;
@ISA = qw(Exporter);
-$VERSION = substr(q$Revision: 2.59 $, 10);
+$VERSION = substr(q$Revision: 2.60 $, 10);
@EXPORT = qw (
display
@@ -1327,29 +1327,17 @@
}
}
- # Optimization for large lists
- unless($Vend::UserWidget) {
- my $ref;
- $Vend::UserWidget = ($ref = $Vend::Cfg->{CodeDef}{Widget})
- ? $ref->{Routine}
- : {};
- if(my $ref = $Global::CodeDef->{Widget}{Routine}) {
- while ( my ($k, $v) = each %$ref) {
- next if $Vend::UserWidget->{$k};
- $Vend::UserWidget->{$k} = $v;
- }
- }
- if(my $ref = $Global::CodeDef->{Widget}{MapRoutine}) {
- no strict 'refs';
- while ( my ($k, $v) = each %$ref) {
- next if $Vend::UserWidget->{$k};
- $Vend::UserWidget->{$k} = \&{"$v"};
- }
- }
+ # Optimization for large lists, we cache the widgets
+ $Vend::UserWidget ||= Vend::Config::map_widgets();
+
+ my $sub = $Vend::UserWidget->{$type};
+ if(! $sub and $Global::AccumulateCode) {
+ $sub = Vend::Config::code_from_file('Widget', $type)
+ and $Vend::UserWidget->{$type} = $sub;
}
- my $sub = $Vend::UserWidget->{$type} || $Vend::UserWidget->{default};
- $sub ||= \&template_sub; # Just in case "default" widget is removed
+ # Last in case "default" widget is removed
+ $sub ||= $Vend::UserWidget->{default} || \&template_sub;
if($opt->{variant}) {
#::logDebug("variant='$opt->{variant}'");
2.245 +5 -4 interchange/lib/Vend/Interpolate.pm
rev 2.245, prev_rev 2.244
Index: Interpolate.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.244
retrieving revision 2.245
diff -u -r2.244 -r2.245
--- Interpolate.pm 2 May 2005 14:13:51 -0000 2.244
+++ Interpolate.pm 3 May 2005 06:03:26 -0000 2.245
@@ -1,6 +1,6 @@
# Vend::Interpolate - Interpret Interchange tags
#
-# $Id: Interpolate.pm,v 2.244 2005/05/02 14:13:51 mheins Exp $
+# $Id: Interpolate.pm,v 2.245 2005/05/03 06:03:26 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -28,7 +28,7 @@
require Exporter;
@ISA = qw(Exporter);
-$VERSION = substr(q$Revision: 2.244 $, 10);
+$VERSION = substr(q$Revision: 2.245 $, 10);
@EXPORT = qw (
@@ -727,12 +727,13 @@
}
next;
}
- unless (defined $Filter{$_}) {
+ my $sub;
+ unless ($sub = $Filter{$_} || Vend::Util::codedef_routine('Filter', $_) ) {
logError ("Unknown filter '%s'", $_);
next;
}
unshift @args, $value, $tag;
- $value = $Filter{$_}->(@args);
+ $value = $sub->(@args);
}
#::logDebug("filter_value returns: value='$value'");
return $value;
2.33 +35 -2 interchange/lib/Vend/Parse.pm
rev 2.33, prev_rev 2.32
Index: Parse.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Parse.pm,v
retrieving revision 2.32
retrieving revision 2.33
diff -u -r2.32 -r2.33
--- Parse.pm 30 Apr 2005 15:09:58 -0000 2.32
+++ Parse.pm 3 May 2005 06:03:26 -0000 2.33
@@ -1,6 +1,6 @@
# Vend::Parse - Parse Interchange tags
#
-# $Id: Parse.pm,v 2.32 2005/04/30 15:09:58 mheins Exp $
+# $Id: Parse.pm,v 2.33 2005/05/03 06:03:26 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -36,7 +36,7 @@
@ISA = qw(Exporter Vend::Parser);
-$VERSION = substr(q$Revision: 2.32 $, 10);
+$VERSION = substr(q$Revision: 2.33 $, 10);
@EXPORT = ();
@EXPORT_OK = qw(find_matching_end);
@@ -425,13 +425,27 @@
if defined $Vend::Cfg->{AdminSub}{$tag} and
($Vend::restricted or ! $Vend::admin);
+ if (! defined $Routine{$tag} and $Global::AccumulateCode) {
+#::logDebug("missing $tag, trying code_from_file");
+ if($Alias{$tag}) {
+ $tag = $Alias{$tag};
+#::logDebug("missing $tag found alias=$tag");
+ }
+ else {
+ $Routine{$tag} = Vend::Config::code_from_file('UserTag', $tag)
+ if ! $Routine{$tag};
+ }
+ }
+
if (! defined $Routine{$tag}) {
+#::logDebug("missing $tag, but didn't try code_from_file?");
if (! $Alias{$tag}) {
::logError("Tag '$tag' not defined.");
return undef;
}
$tag = $Alias{$tag};
};
+
if($Special{$tag}) {
my $ref = pop(@_);
my @args = @$ref{ @{$Order{$tag}} };
@@ -453,6 +467,7 @@
return &{$Routine{$tag}}(@args, $text || undef);
}
else {
+#::logDebug("Parse-do_tag tag=$tag: args now=" . ::uneval_it(\@_) );
return &{$Routine{$tag}}(@_);
}
}
@@ -460,6 +475,11 @@
sub resolve_args {
my $tag = shift;
#::logDebug("resolving args for $tag, attrAlias = $attrAlias{$tag}");
+ if (! defined $Routine{$tag} and $Global::AccumulateCode) {
+#::logDebug("missing $tag, trying code_from_file");
+ $Routine{$tag} = Vend::Config::code_from_file('UserTag', $tag);
+ }
+
return @_ unless defined $Routine{$tag};
my $ref = shift;
my @list;
@@ -630,6 +650,18 @@
# $attr is reference to a HASH, $attrseq is reference to an ARRAY
my $aliasname = '';
+ if (! defined $Routine{$tag} and $Global::AccumulateCode) {
+ my $newtag;
+ if($newtag = $Alias{$tag}) {
+ $newtag =~ s/\s+.*//s;
+ Vend::Config::code_from_file('UserTag', $newtag)
+ unless $Routine{$newtag};
+ }
+ else {
+ Vend::Config::code_from_file('UserTag', $tag);
+ }
+ }
+
unless (defined $Routine{$tag}) {
if(defined $Alias{$tag}) {
$aliasname = $tag;
@@ -686,6 +718,7 @@
my ($routine, at args);
+#::logDebug("tag=$tag order=$Order{$tag}");
# Check for old-style positional tag
if(!@$attrseq and $origtext =~ s/\[[-\w]+\s+//i) {
$origtext =~ s/\]$//;
2.61 +10 -2 interchange/lib/Vend/Server.pm
rev 2.61, prev_rev 2.60
Index: Server.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Server.pm,v
retrieving revision 2.60
retrieving revision 2.61
diff -u -r2.60 -r2.61
--- Server.pm 30 Apr 2005 14:51:29 -0000 2.60
+++ Server.pm 3 May 2005 06:03:26 -0000 2.61
@@ -1,6 +1,6 @@
# Vend::Server - Listen for Interchange CGI requests as a background server
#
-# $Id: Server.pm,v 2.60 2005/04/30 14:51:29 mheins Exp $
+# $Id: Server.pm,v 2.61 2005/05/03 06:03:26 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -26,7 +26,7 @@
package Vend::Server;
use vars qw($VERSION);
-$VERSION = substr(q$Revision: 2.60 $, 10);
+$VERSION = substr(q$Revision: 2.61 $, 10);
use POSIX qw(setsid strftime);
use Vend::Util;
@@ -1084,6 +1084,7 @@
or die "lock $Global::RunDir/restart: $!\n";
while(<Vend::Server::RESTART>) {
chomp;
+#::logDebug("restart file reads line '$_'");
my ($directive,$value) = split /\s+/, $_, 2;
if($value =~ /<<(.*)/) {
my $mark = $1;
@@ -1107,6 +1108,13 @@
)
{
::remove_catalog($1);
+ }
+ elsif( $directive =~ /^usertag$/i) {
+ Vend::Config::code_from_file($directive, $value, 'nohup');
+ }
+ elsif( $directive =~ /^codedef$/i) {
+ ($directive, $value) = split /\s+/, $value, 2;
+ Vend::Config::code_from_file($directive, $value, 'nohup');
}
else {
::change_global_directive($directive, $value);
2.84 +42 -27 interchange/lib/Vend/Util.pm
rev 2.84, prev_rev 2.83
Index: Util.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Util.pm,v
retrieving revision 2.83
retrieving revision 2.84
diff -u -r2.83 -r2.84
--- Util.pm 30 Apr 2005 15:09:58 -0000 2.83
+++ Util.pm 3 May 2005 06:03:26 -0000 2.84
@@ -1,6 +1,6 @@
# Vend::Util - Interchange utility functions
#
-# $Id: Util.pm,v 2.83 2005/04/30 15:09:58 mheins Exp $
+# $Id: Util.pm,v 2.84 2005/05/03 06:03:26 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -88,7 +88,7 @@
use Vend::File;
use subs qw(logError logGlobal);
use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION = substr(q$Revision: 2.83 $, 10);
+$VERSION = substr(q$Revision: 2.84 $, 10);
my $Eval_routine;
my $Eval_routine_file;
@@ -1797,16 +1797,25 @@
my @headers;
if(ref $to) {
my $head = $to;
+
+ for(my $i = $#$head; $i > 0; $i--) {
+ if($head->[$i] =~ /^\s/) {
+ my $new = splice @$head, $i, 1;
+ $head->[$i - 1] .= "\n$new";
+ }
+ }
+
$body = $subject;
undef $subject;
for(@$head) {
- if( /^To:\s*(.+)/ ) {
+ s/\s+$//;
+ if( /^To:\s*(.+)/s ) {
$to = $1;
}
- elsif (/Reply-to:\s*(.+)/) {
+ elsif (/^Reply-to:\s*(.+)/si) {
$reply = $_;
}
- elsif (/^subj(?:ect)?:\s*(.+)/i) {
+ elsif (/^subj(?:ect)?:\s*(.+)/si) {
$subject = $1;
}
elsif($_) {
@@ -1815,7 +1824,6 @@
}
}
-
my($ok);
#::logDebug("send_mail: to=$to subj=$subject r=$reply mime=$use_mime\n");
@@ -1972,32 +1980,39 @@
sub codedef_routine {
my ($tag, $routine, $modifier) = @_;
- my @tries;
- my $tried;
+ my $area = $Vend::Config::tagCanon{lc $tag}
+ or do {
+ logError("Unknown CodeDef type %s", $tag);
+ return undef;
+ };
- RESOLVEDEF: {
- if($Vend::Cfg->{CodeDef}{$tag}) {
- push @tries, $Vend::Cfg->{CodeDef}{$tag}{Routine} || {};
- }
- if($Global::CodeDef->{$tag}) {
- push @tries, $Global::CodeDef->{$tag}{Routine} || {};
- }
- if(! @tries and ! $tried++) {
- my @keys = keys %{$Vend::Cfg->{CodeDef}};
- push @keys, keys %{$Global::CodeDef};
- for(@keys) {
- if(lc($tag) eq lc($_)) {
- $tag = $_;
- redo RESOLVEDEF;
- }
- }
+ $routine =~ s/-/_/g;
+ my @tries;
+ if ($tag eq 'UserTag') {
+ @tries = ($Vend::Cfg->{UserTag}, $Global::UserTag);
}
+ else {
+ @tries = ($Vend::Cfg->{CodeDef}{$area}, $Global::CodeDef->{$area});
}
- for(@tries) {
- return $_->{$routine} if $_->{$routine};
+ no strict 'refs';
+
+ my $ref;
+
+ for my $base (@tries) {
+ next unless $base;
+ $ref = $base->{Routine}{$routine}
+ and return $ref;
+ $ref = $base->{MapRoutine}{$routine}
+ and return \&{"$ref"};
}
- return undef;
+
+ return undef unless $Global::AccumulateCode;
+#::logDebug("trying code_from file for area=$area routine=$routine");
+ $ref = Vend::Config::code_from_file($area, $routine)
+ or return undef;
+#::logDebug("returning ref=$ref for area=$area routine=$routine");
+ return $ref;
}
sub codedef_options {
More information about the interchange-cvs
mailing list