[interchange-cvs] interchange - heins modified 7 files

interchange-cvs at icdevgroup.org interchange-cvs at icdevgroup.org
Fri May 20 09:55:19 EDT 2005


User:      heins
Date:      2005-05-20 13:55:19 GMT
Modified:  lib/Vend Config.pm Dispatch.pm
Added:     features/quickpoll quickpoll.catalog.cfg quickpoll.global
Added:              quickpoll.init
Added:     features/quickpoll/doc/quickpoll README
Added:     features/quickpoll/templates/components quickpoll
Log:
* Add new "Feature" facility which allows easy installation of new
  capabilities to Interchange.

* We have the convention of "extensions" which allows us to put together
  features to add to Interchange. But the installation is manual, and
  requires good docs to make it easily installable for end-users. Also,
  many features require access to the global configuration.

* We also have the problem of feature creep, where we tend to add everything
  to the "standard" catalog.

* New Feature directive is simple in execution:

	Feature quickpoll

* There is also a global FeatureDir directive, with a default of
  "features". Features are placed in a subdirectory based on
  the feature name -- I am including a "quickpoll" feature in
  this.

* Basic mechanism is pretty simple. There are two special kinds
  of files called by the extensions .global and .init.

  (In the included "quickpoll" feature, these are named quickpoll.global
  and quickpoll.init)

  If a file has a .global extension, it is added to the global
  configuration. The included quickpoll feature adds the ActionMap
  quickpoll, and the UserTags [poll-answer] and [ascii-graph].

  If a file has a .init extension, it is run once the first time
  the target catalog is accessed. In the example, it is used to add
  mv_metadata entries and a couple of sample polls.

  All other files in the directory are catalog configuration,
  in this example "quickpoll.catalog.cfg". It could have been
  broken up into "quickpoll.sql" and "quickpoll_answer.sql".

  All subdirectories contain files which are copied to the
  catalog directory with the same relative path. In this
  case, ICDIR/features/quickpoll/templates/components/quickpoll
  goes to CATDIR/templates/components/quickpoll.

* The .init file, when run, sends its output to

	 ConfDir/init/<feature>/<feature>.init

  (etc/init/quickpoll/quickpoll.init in the example.)

  Once it is run, the existence of the file prevents it being run again.
  When the server is restarted, the file test is no longer needed.

* You can add documentation simply by creating a doc/<feature>/README file
  or anything else you want.

* TODO: Uninstall procedure.

Revision  Changes    Path
1.1                  interchange/features/quickpoll/quickpoll.catalog.cfg


rev 1.1, prev_rev 1.0
Index: quickpoll.catalog.cfg
===================================================================

Database	quickpoll	quickpoll.txt	__SQLDSN__
Database	quickpoll	NAME	code poll_id owner title question choices colors num_answers
Database	quickpoll	CREATE_EMPTY_TXT	1
Database	quickpoll	AUTO_SEQUENCE	quickpoll_seq
Database	quickpoll	COLUMN_DEF	"poll_id=int"
Database	quickpoll	COLUMN_DEF	"owner=varchar(128)"
Database	quickpoll	COLUMN_DEF	"question=varchar(255)"
Database	quickpoll	COLUMN_DEF	"choices=text"
Database	quickpoll	COLUMN_DEF	"colors=text"

Database	quickpoll_answer	quickpoll_answer.txt	__SQLDSN__
Database	quickpoll_answer	NAME	code poll_id question_id answer comment answer_date ipaddr username login_table
Database	quickpoll_answer	CREATE_EMPTY_TXT	1
Database	quickpoll_answer	AUTO_SEQUENCE	quickpoll_answer_seq
Database	quickpoll_answer	COLUMN_DEF	"poll_id=int"
Database	quickpoll_answer	COLUMN_DEF	"question_id=int"
Database	quickpoll_answer	COLUMN_DEF	"answer=varchar(255)"
Database	quickpoll_answer	COLUMN_DEF	"comment=text"
Database	quickpoll_answer	INDEX  question_id



1.1                  interchange/features/quickpoll/quickpoll.global


rev 1.1, prev_rev 1.0
Index: quickpoll.global
===================================================================
ActionMap quickpoll <<EOR
sub {
	my $path = shift;
	$path =~ s{^quickpoll/}{};

	use vars qw/$Tag/;
	$CGI::values{mv_nextpage} ||= $path;
	my $code = $CGI::values{poll};
	$code =~ s/\D+//g;
	return 1 if $Vend::Session->{quickpoll}{$code}++;
	my $answer = $CGI::values{answer};
	my $adb = dbref($::Variable->{POLL_ANSWER_TABLE} || 'quickpoll_answer');
	my $pdb = dbref($::Variable->{POLL_TABLE} || 'quickpoll');
	my $poll = $pdb->row_hash($code) 
		or do {
			::logError("Bad poll %s, no database record", $code);
			return 1;
		};
	my $date = POSIX::strftime('%Y%m%d%H%M%S', localtime());
	my $poll_id = $poll->{poll_id} || $code;
	my $record = {
		answer => $CGI::values{answer},
		poll_id => $poll_id,
		question_id => $code,
		ipaddr => $CGI::remote_addr,
		username => $Vend::username,
		answer_date => $date,
		login_table => $Vend::login_table,
	};
	$Vend::Session->{quickpoll}{$code} = $adb->set_slice(undef, $record);
	return 1;
}
EOR

UserTag poll-answer Order code
UserTag poll-answer addAttr
UserTag poll-answer Routine <<EOR
sub {
	my ($code, $opt) = @_;

	use vars qw/$Tag/;

	my $adb = dbref($::Variable->{POLL_ANSWER_TABLE} || 'quickpoll_answer');
	my $pdb = dbref($::Variable->{POLL_TABLE} || 'quickpoll');
	my $poll = $pdb->row_hash($code)
		or do {
			::logError("Bad poll %s, no database record", $code);
			return undef;
		};
	my $answer_ary = Vend::Form::options_to_array($poll->{choices});
	my %key;
	for(@$answer_ary) {
		$key{$_->[0]} = $_->[1];
	}
	
	my $tname = $adb->name();
	my $q = qq{SELECT answer, COUNT(answer) FROM $tname
				WHERE question_id = $code
				GROUP BY answer
			};

	my $ary = $adb->query($q)
		or do {
			::logError("Bad answers to poll %s, no database return", $code);
			return undef;
		};
	my @out;
	push @out, qq{<table>};

	my $total = 0;
	my @results;

	for(@$ary) {
		my ($ans, $number) = @$_;
		$total += $number;
		push @results, [$ans, $number];
	}

	@results = sort { $b->[1] <=> $a->[1] } @results;

	return "No answers yet!" unless $total > 0;

	my $tops = $opt->{shown} || 4;
	if(@results > $tops) {
		my $other = 0;
		for(my $i = $tops; $i < @results; $i++) {
			$other += $results[$i][1];
		}
		splice @results, $tops;
		push @results, [ $opt->{other_title} || 'Other', $other];
	}

	for(@results) {
		push @$_, int($_->[1] / $total * 100);
	}

	my @colors = qw(
		red
		green
		blue
		orange
		yellow
		brown
		purple
		cyan
		chartruese
	);

	if($poll->{colors}) {
		my @custom = grep /\w/, split /[\s,\0]+/, $poll->{colors};
		for(my $i = 0; $i < @custom; $i++) {
			$colors[$i] = $custom[$i];
		}
	}

	for( my $i = 0; $i < @results; $i++) {
		my ($answer, $number, $percent) = @{$results[$i]};
		$answer = $key{$answer} if $key{$answer};
		my $short = $Tag->filter('16.', $answer);
		if(length($answer) > length($short)) {
			my $encode_answer = HTML::Entities::encode($answer);
			my $encode_short = HTML::Entities::encode($short);
			$answer = qq{<span title="$encode_answer">$encode_short</span>};
		}
		else {
			HTML::Entities::encode($answer);
		}
		my $opt = {
			hr => 1,
			hr_color => $colors[$i],
			value => $percent,
		};
		my $graph = $Tag->ascii_graph($opt);
		push @out, <<EOF;
<tr>
	<td>$answer</td>
	<td>$number</td>
	<td>$graph</td>
</tr>
EOF
	}
	push @out, '</table>';
	return join "\n", @out;
	
}
EOR

UserTag ascii-graph Order value scale
UserTag ascii-graph addAttr
UserTag ascii-graph Routine <<EOR
sub {
	my ($value, $scale, $opt) = @_;

	unless($opt->{div_per_scale}) {
		$opt->{div_per_scale} = ($opt->{image} || $opt->{hr}) ? 100 : 25;
	}
	$scale ||= 100;
	my $factor = $opt->{div_per_scale} / $scale;
	
	my $amount = int($value * $factor);

	my $out = '';

	return $out unless $amount;

	if($opt->{image}) {
		$opt->{line_width} ||= 5;
		if($opt->{vertical}) {
			$out = qq{<img src="$opt->{image}" height=$amount width=$opt->{line_width}>};
		}
		else {
			$out = qq{<img src="$opt->{image}" width=$amount height=$opt->{line_width}>};
		}
	}
	elsif ($opt->{hr}) {
		$opt->{hr_color} ||= '#666666';
		$opt->{hr_height} ||= 5;
		my $shade = $opt->{hr_noshade} ? ' noshade' : '';
		$out = qq{<hr align=left size=$opt->{hr_height} width=$amount$shade color="$opt->{hr_color}">};
	}
	else {
		my $char = $opt->{character} || $opt->{char} || '*';
		$out = $char x $amount;
	}

	if($opt->{prepend_value}) {
		$out = qq{<table cellspacing=0 cellpadding=0><tr><td width=20 align=right>$value</td><td>&nbsp;</td><td>$out</td></tr></table>};
	}
	elsif($opt->{append_value}) {
		$out = "$out&nbsp;$value";
	}
	return $out;
}
EOR



1.1                  interchange/features/quickpoll/quickpoll.init


rev 1.1, prev_rev 1.0
Index: quickpoll.init
===================================================================
[flag type=write table=mv_metadata]
[write-relative-file file="tmp/poll_metadata.asc"]code	type	width	height	field	db	name	outboard	options	attribute	label	help	lookup	filter	help_url	pre_filter	lookup_exclude	prepend	append	display_filter	extended
quickpoll::choices	textarea	30	5							Choices	Standard IC option format, i.e.:
<blockquote>
value1=Label which may be long<br>
value2=Another label<br>
value3=Yet another label<br>
value4<br>
value5=The above is just shown as value4
</blockquote>
		line2options		options2line					{}
quickpoll::code	hidden_text									Question ID										{}
quickpoll::colors	movecombo							green,red,blue,brown,yellow,cyan,chartreuse,gray		Colors	Colors for results, in order (highest value first color, next second, etc.)									{}
quickpoll::num_answers	select							=--default is 4--,1,2,3,4,5,6,7,8,9,10		Answers to show	Answers after this number are added together and shown as "Other"									{}
quickpoll::question	text_40									Question										{}
quickpoll	table																			{'no_code_link' => "1",'restrict_allow' => "poll_answer cgi",'panel_shade' => "f",'include_form' => "<td class=clabel> Answers </td>
<td class=cdata>

   [poll-answer code=\"[cgi item_id]\"]
</td>
",'include_form_interpolate' => "1",'display_type' => "image_meta",'ui_more_decade' => "10",'include_before' => "code",'explicit_edit' => "1",'ui_data_fields' => "code
title
question
choices
colors
num_answers",}
quickpoll::title	text_30									Title	Default is "Quick poll"									{}
[/write-relative-file]
[import-fields table=mv_metadata file="tmp/poll_metadata.asc" add=1]

[flag type=write table=quickpoll]
[write-relative-file file="tmp/quickpoll.asc"]code	poll_id	owner	title	question	choices	colors	num_answers
1	0		A New Poll	Will this poll work?	Yes,No,Maybe,Sometimes,Always,Never,x=When it wants to it will&#44; you bet	cyan green red blue yellow chartreuse	4
2			Another Poll	Do you like polls?	Yes,No,Sometimes,Always,Never,Anytime!	green red blue chartreuse	0
[/write-relative-file]
[import-fields table=quickpoll file="tmp/quickpoll.asc" add=1]



1.1                  interchange/features/quickpoll/doc/quickpoll/README


rev 1.1, prev_rev 1.0
Index: README
===================================================================
=head1 NAME

quickpoll- Quick poll for Interchange

=head1 VERSION

$Revision: 1.1 $

=head1 SYNOPSIS

	[control-set]
		[component]quickpoll[/component]
	    [code]1[/code]
	[/control-set]

=head1 DESCRIPTION

This feature adds a "Quick Poll" feature to an interchange catalog. To implement,
place the "quickpoll" component in a page (or take the page code from
templates/components/quickpoll and incorporate it).

It creates two tables, "quickpoll" and "quickpoll_answer". It is tested on
MySQL, but should run on Postgres as well.

+-------------+--------------+------+-----+---------+----------------+
| Field       | Type         | Null | Key | Default | Extra          |
+-------------+--------------+------+-----+---------+----------------+
| code        | int(11)      |      | PRI | NULL    | auto_increment |
| poll_id     | varchar(128) | YES  |     | NULL    |                |
| owner       | varchar(128) | YES  |     | NULL    |                |
| title       | varchar(128) | YES  |     | NULL    |                |
| question    | varchar(255) | YES  |     | NULL    |                |
| choices     | text         | YES  |     | NULL    |                |
| colors      | text         | YES  |     | NULL    |                |
| num_answers | varchar(128) | YES  |     | NULL    |                |
+-------------+--------------+------+-----+---------+----------------+

+-------------+--------------+------+-----+---------+----------------+
| Field       | Type         | Null | Key | Default | Extra          |
+-------------+--------------+------+-----+---------+----------------+
| code        | int(11)      |      | PRI | NULL    | auto_increment |
| poll_id     | int(11)      | YES  |     | NULL    |                |
| question_id | int(11)      | YES  | MUL | NULL    |                |
| answer      | varchar(255) | YES  |     | NULL    |                |
| comment     | text         | YES  |     | NULL    |                |
| answer_date | varchar(128) | YES  |     | NULL    |                |
| ipaddr      | varchar(128) | YES  |     | NULL    |                |
| username    | varchar(128) | YES  |     | NULL    |                |
| login_table | varchar(128) | YES  |     | NULL    |                |
+-------------+--------------+------+-----+---------+----------------+

To create a poll, go to Tables->quickpoll->New Entry in the admin UI.

=head1 AUTHOR

Mike Heins, Perusion, <mikeh at perusion.com>.





1.1                  interchange/features/quickpoll/templates/components/quickpoll


rev 1.1, prev_rev 1.0
Index: quickpoll
===================================================================
[comment]
ui_name: poll
ui_type: component
ui_class: vertical
ui_group: info
ui_label: Quick one-question poll

code:
	label: Poll ID
	lookup_query: select distinct code, question from poll
	type: select

answer_type:
	label: Answer type
	default: select
	options: radio_left_1=Radio box, select=Dropdown, checkbox_left_1=Checkbox (multiple choice)
	type: select

submit_label:
	label: Button text
	type: text_10
	default: Go

[/comment]
<!-- BEGIN COMPONENT poll -->

[tmp tmp_answered][calc]
		my $code = $Tag->control('code');
		return $Session->{quickpoll}{$code};
		[/calc][/tmp]

[if !scratch tmp_answered] 

	[loop list="[control code]"]
	<form action="[area quickpoll]">
	[form-session-id]
	<input type=hidden name="poll" value="[loop-code]">
	<input type=hidden name="mv_nextpage" value="@@MV_PAGE@@">
	<input type=hidden name="mv_arg" value="[data session arg]">
	  <div class=titlebox>
		[either][loop-data quickpoll title][or]Quick poll[/either]
	  </div>
	  <div class=shadowbox>
			[loop-data quickpoll question]<br>
			[display
				name="answer"
				type="[control answer_type radio_left_1]"
				passed="[loop-data quickpoll choices]"
			]
			<br>
			<input type=submit value="[control submit_label Go]">
	  </div>
	</form>
	[/loop]

[else]
	[loop list="[control code]"]
	  <div class=titlebox>
		[either][loop-data quickpoll title][or]Quick poll[/either]
	  </div>
	  <div class=shadowbox>
			<h5>[loop-data quickpoll question]</h5>
			[poll-answer code="[control code]"]
	  </div>
	[/loop]
[/else]
[/if]

<!-- END COMPONENT poll -->



2.176     +131 -5    interchange/lib/Vend/Config.pm


rev 2.176, prev_rev 2.175
Index: Config.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Config.pm,v
retrieving revision 2.175
retrieving revision 2.176
diff -u -r2.175 -r2.176
--- Config.pm	16 May 2005 21:22:28 -0000	2.175
+++ Config.pm	20 May 2005 13:55:19 -0000	2.176
@@ -1,6 +1,6 @@
 # Vend::Config - Configure Interchange
 #
-# $Id: Config.pm,v 2.175 2005/05/16 21:22:28 mheins Exp $
+# $Id: Config.pm,v 2.176 2005/05/20 13:55:19 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -42,7 +42,7 @@
 			%Default %Dispatch_code %Dispatch_priority
 			@Locale_directives_currency @Locale_keys_currency
 			$GlobalRead  $SystemCodeDone $SystemGroupsDone $CodeDest
-			$SystemReposDone $ReposDest
+			$SystemReposDone $ReposDest @include
 			);
 use Safe;
 use Fcntl;
@@ -52,7 +52,7 @@
 use Vend::Data;
 use Vend::Cron;
 
-$VERSION = substr(q$Revision: 2.175 $, 10);
+$VERSION = substr(q$Revision: 2.176 $, 10);
 
 my %CDname;
 my %CPname;
@@ -380,6 +380,7 @@
 	['DebugFile',		 'root_dir',     	 ''],
 	['CatalogUser',		 'hash',			 ''],
 	['ConfigDir',		  undef,	         'etc/lib'],
+	['FeatureDir',		 'root_dir',	     'features'],
 	['ConfigDatabase',	 'config_db',	     ''],
 	['ConfigParseComments',	'yesno',		'Yes'],
 	['ConfigAllBefore',	 'array',	         "$Global::VendRoot/catalog_before.cfg"],
@@ -572,6 +573,7 @@
 	['AutoEnd',			 'routine_array',	 ''],
 	['Replace',			 'replace',     	 ''],
 	['Member',		  	 'variable',     	 ''],
+	['Feature',          'feature',          ''],
 	['WritePermission',  'permission',       'user'],
 	['ReadPermission',   'permission',       'user'],
 	['SessionExpire',    'time',             '1 hour'],
@@ -735,6 +737,39 @@
 	
 }
 
+sub global_chunk {
+	my ($fn) = @_;
+
+	my $save_c = $C;
+	undef $C;
+
+	local $/;
+	$/ = "\n";
+
+
+	open GCHUNK, "< $fn"
+		or config_error("read global chunk %s: %s", $fn, $!);
+
+	while(<GCHUNK>) {
+		my $line = $_;
+		my($lvar, $value) = read_config_value($_, \*GCHUNK);
+		next unless $lvar;
+		eval {
+			$GlobalRead->($lvar, $value);
+		};
+		if($@ =~ /Duplicate\s+usertag/i) {
+			next;
+		}
+	}
+    close GCHUNK;
+
+	Vend::Dispatch::update_global_actions();
+	finalize_mapped_code();
+
+	$C = $save_c;
+	return 1;
+}
+
 sub code_from_file {
 	my ($area, $name, $nohup) = @_;
 	my $c;
@@ -1017,7 +1052,7 @@
 		}
 	}
 
-	my(@include) = ($passed_file || $C->{ConfigFile});
+	@include = ($passed_file || $C->{ConfigFile});
 	my %include_hash = ($include[0] => 1);
 	my $done_one;
 	my ($db, $dname, $nm);
@@ -1592,7 +1627,6 @@
 				#
 	s/\s+$//;		#  trailing spaces
 	return undef unless $_;
-::logGlobal("What is going on? line=$_") unless /^.*\S.*/;
 
 	local($Vend::config_line);
 	$Vend::config_line = $_;
@@ -2155,6 +2189,98 @@
 	else {
 		return ${"Global::$name"};
 	}
+}
+
+# Adds features contained in FeatureDir called by catalog
+
+sub parse_feature {
+	my ($var, $value) = @_;
+	my $c = $C->{$var} || {};
+	return $c unless $value;
+
+	$value =~ s/^\s+//;
+	$value =~ s/\s+$//;
+	my $fdir = Vend::File::catfile($Global::FeatureDir, $value);
+
+	unless(-d $fdir) {
+		config_warn("Feature '%s' not found, skipping.", $value);
+		return $c;
+	}
+
+	my @gfiles = glob("$fdir/*.global");
+	my %seen;
+	@seen{@gfiles} = @gfiles;
+	my @ifiles = glob("$fdir/*.init");
+	@seen{@ifiles} = @ifiles;
+	my @cfiles = grep ! $seen{$_}++, glob("$fdir/*");
+
+	my @cdirs = grep -d $_, @cfiles;
+	@cfiles   = grep -f $_, @cfiles;
+
+	@gfiles = grep ! $Global::FeatureSeen{$_}++, @gfiles;
+
+	unshift @include, @cfiles;
+
+	my @copy;
+	my $wanted = sub {
+		return unless -f $_;
+		my $n = $File::Find::name;
+		$n =~ s{^$fdir/}{};
+		my $d = $File::Find::dir;
+		$d =~ s{^$fdir/}{};
+		push @copy, [$n, $d];
+	};
+
+	if(@cdirs) {
+		File::Find::find($wanted, @cdirs);
+	}
+#::logDebug("gfiles=" . ::uneval(\@gfiles));
+#::logDebug("cfiles=" . ::uneval(\@cfiles));
+#::logDebug("ifiles=" . ::uneval(\@ifiles));
+#::logDebug("cdirs=" . ::uneval(\@cdirs));
+#::logDebug("copy=" . ::uneval(\@copy));
+
+	for(@copy) {
+		my ($n, $d) = @$_;
+
+		my $tf = Vend::File::catfile($C->{VendRoot}, $n);
+		next if -f $tf;
+
+		my $td = Vend::File::catfile($C->{VendRoot}, $d);
+		unless(-d $td) {
+			File::Path::mkpath($td)
+				or do {
+					config_warn("Feature %s not able to make directory %s", $value, $td);
+					next;
+				};
+		}
+		File::Copy::copy("$fdir/$n", $tf)
+			or do {
+				config_warn("Feature %s not able to copy %s to %s", $value, "$fdir/$n", $tf);
+				next;
+			};
+	}
+
+	for(@gfiles) {
+		global_chunk($_);
+	}
+
+	if(@ifiles) {
+		my $initdir = Vend::File::catfile($C->{ConfDir}, 'init', $value);
+		File::Path::mkpath($initdir) unless -d $initdir;
+		for(@ifiles) {
+			my $fn = $_;
+			$fn =~ s{^$fdir/}{};
+			next if -f "$initdir/$fn";
+			$C->{Init} ||= [];
+			push @{$C->{Init}}, [$_, "$initdir/$fn"];
+		}
+	}
+
+#::logDebug("Init=" . ::uneval($C->{Init}));
+
+	$c->{$value} = 1;
+	return $c;
 }
 
 # Changes configuration directives into Variable settings, i.e.



1.55      +33 -2     interchange/lib/Vend/Dispatch.pm


rev 1.55, prev_rev 1.54
Index: Dispatch.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Dispatch.pm,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -r1.54 -r1.55
--- Dispatch.pm	16 May 2005 21:22:28 -0000	1.54
+++ Dispatch.pm	20 May 2005 13:55:19 -0000	1.55
@@ -1,6 +1,6 @@
 # Vend::Dispatch - Handle Interchange page requests
 #
-# $Id: Dispatch.pm,v 1.54 2005/05/16 21:22:28 mheins Exp $
+# $Id: Dispatch.pm,v 1.55 2005/05/20 13:55:19 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.54 $, 10);
+$VERSION = substr(q$Revision: 1.55 $, 10);
 
 use POSIX qw(strftime);
 use Vend::Util;
@@ -1420,6 +1420,37 @@
 		}
 		for(keys %$macro) {
 			Vend::Interpolate::input_filter_do($_, { op => $macro->{$_} } );
+		}
+	}
+
+	## Here we initialize new features
+	if(my $ary = $Vend::Cfg->{Init}) {
+		undef $Vend::Cfg->{Init};
+		for(@$ary) {
+			my ($source, $touch) = @$_;
+			next if -f $touch;
+			open INITOUT, "> $touch"
+				or do {
+					::logError(
+						"Unable to open init file %s for feature init", $touch,
+						);
+					next;
+				};
+			my $out;
+			eval {
+				$out = Vend::Interpolate::interpolate_html(
+									Vend::Util::readfile($source)
+						  );
+			};
+			if($@) {
+				$out .= $@;
+			}
+			print INITOUT errmsg(
+							"Results of init at %s: ",
+							POSIX::strftime("%Y-%m-%d %H:%M:%S", localtime()),
+							);
+			print INITOUT $out;
+			close INITOUT;
 		}
 	}
 








More information about the interchange-cvs mailing list