[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> </td><td>$out</td></tr></table>};
}
elsif($opt->{append_value}) {
$out = "$out $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, 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