[interchange-cvs] interchange - heins modified 6 files
interchange-core@icdevgroup.org
interchange-core@icdevgroup.org
Fri Nov 22 22:55:01 2002
User: heins
Date: 2002-11-23 03:54:12 GMT
Modified: dist/foundation/pages/survey standard.html
Modified: dist/lib/UI/pages/admin/survey index.html overall.html
Added: dist/foundation/pages/survey graph.html graph.png.html
Added: eg survey_graph.tag
Log:
* Add some cheesy results-graphing support based on GD::Graph.
* The actual graphing tag is not ready for prime time, and is so
added to eg/.
* The libraries are difficult to configure for the graphing stuff,
so that feature will probably be left out of 5.0. It requires
libgd.2, and almost every Linux system ships 1.8.4.
* Another deficiency in the [survey-graph ...] tag is that it failes
to do collation based on grouping, and fails to do averaging of
values.
* I will look at the possiblity of degrading to ASCII bar charts
based on presence of GD::Graph -- a FakeGD::Graph::bars would be
nice...but is probably beyond reach of my available time.
Revision Changes Path
1.2 +28 -5 interchange/dist/foundation/pages/survey/standard.html
rev 1.2, prev_rev 1.1
Index: standard.html
===================================================================
RCS file: /var/cvs/interchange/dist/foundation/pages/survey/standard.html,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- standard.html 20 Nov 2002 18:52:17 -0000 1.1
+++ standard.html 23 Nov 2002 03:54:12 -0000 1.2
@@ -3,6 +3,34 @@
ui_template_name: noleft
[/comment]
+
+[control reset=1]
+
+[control-set]
+[component]search_box_small[/component]
+[/control-set]
+
+[control-set]
+[component]category_vertical[/component]
+[/control-set]
+
+[control-set]
+[component][/component]
+[/control-set]
+
+[control-set]
+[component][/component]
+[/control-set]
+
+[control-set]
+[component]promo[/component]
+[matches]3[/matches]
+[cols]3[/cols]
+[banner]Specials[/banner]
+[/control-set]
+
+[control reset=1]
+
<style type="text/css">
.cerror {
color: red
@@ -16,11 +44,6 @@
[/calc]
[tmp survey_id]survey::[cgi survey_start][/tmp]
[/if]
-
-
-[control reset=1]
-
-[control reset=1]
[auto-wizard
compile=auto
1.1 interchange/dist/foundation/pages/survey/graph.html
rev 1.1, prev_rev 1.0
Index: graph.html
===================================================================
[comment]
ui_template: Yes
ui_template_name: noleft
[/comment]
<style type="text/css">
.cerror {
color: red
}
</style>
[control reset=1]
[control-set]
[component]search_box_small[/component]
[/control-set]
[control-set]
[component]category_vertical[/component]
[/control-set]
[control-set]
[component][/component]
[/control-set]
[control-set]
[component][/component]
[/control-set]
[control-set]
[component]promo[/component]
[matches]3[/matches]
[cols]3[/cols]
[banner]Specials[/banner]
[/control-set]
[control reset=1]
@_LEFTONLY_TOP_@
<!-- BEGIN CONTENT -->
[calc]
my ($survey, $question) = split /:+/, $CGI->{id} || $CGI->{item_id} || $Session->{arg};
unless ($survey) {
$CGI->{item_id} = join "::", $CGI->{survey}, $CGI->{question};
}
else {
$CGI->{survey} = $survey;
$CGI->{question} = $question;
$CGI->{item_id} = $survey . "::$question";
}
return;
[/calc]
<blockquote style="color: red">
[warnings]
</blockquote>
[loop extended="[cgi item_id]" table=survey]
<div style="text-align: left; padding: 5">
<h1>[either][loop-param graph_title][or][loop-param label][/either]</h1>
[tmp legend][either][loop-param graph_label][or][loop-param options][/either][/tmp]
<img src="[area
add_dot_html=0
no_session_id=1
no_count=1
href="survey/graph.png"
form="
mv_tmp_session=1
mv_arg=[cgi item_id]
notitle=1
"]">
<table>
[loop prefix=leg acclist=1 list="[scratch legend]"]
[leg-calc]
my $code = q{[leg-code]};
my $lab = q{[leg-param label]};
return '' unless length($code);
return '' if $code eq $lab;
return qq{
<tr>
<td>
$code
</td>
<td>
==>
</td>
<td>
$lab
</td>
</tr>};
[/leg-calc]
[/loop]
</table>
</div>
[/loop]
<!-- END CONTENT -->
@_LEFTONLY_BOTTOM_@
1.1 interchange/dist/foundation/pages/survey/graph.png.html
rev 1.1, prev_rev 1.0
Index: graph.png.html
===================================================================
[survey-graph item_id="[data session arg]" notitle="[cgi notitle]" show_num=1 show_percent=1 cycle_clrs=1]
1.2 +40 -15 interchange/dist/lib/UI/pages/admin/survey/index.html
rev 1.2, prev_rev 1.1
Index: index.html
===================================================================
RCS file: /var/cvs/interchange/dist/lib/UI/pages/admin/survey/index.html,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- index.html 20 Nov 2002 18:52:17 -0000 1.1
+++ index.html 23 Nov 2002 03:54:12 -0000 1.2
@@ -14,28 +14,53 @@
<blockquote>
+[tmp survey_keys]code label
+[loop search="
+ ml=1000
+ fi=survey
+ st=db
+ co=yes
+ se=:
+ sf=code
+ op=rn
+ rf=code,label
+ "][loop-code] [loop-param label]
+[/loop][/tmp]
+
<form action="[area __UI_BASE__/survey/overall]">
<input type=hidden name=mv_action value=back>
<input type=hidden name=mv_session_id value="[data session_id]">
<input type=hidden name="mv_filter:item_id" value=word>
-New survey name: <input type=text size=16 name=item_id>
-<br>
-<input type=submit value="[L]Create[/L]">
+<table>
+<tr>
+ <td>New survey name</td>
+ <td>Clone from</td>
+ <td> </td>
+</tr>
+<tr>
+ <td>
+ <input type=text size=16 name=item_id>
+ </td>
+ <td>
+ <select name="survey_clone">
+ <option value=""> -- none --
+ [loop list="[scratch survey_keys]" lr=1 head-skip=1]<option value="[loop-code]"> [loop-code]</option>[/loop]
+ </select>
+ </td>
+ <td>
+ <input type=submit value="[L]Create[/L]">
+ </td>
+</tr>
+</table>
+
</form>
Edit an existing survey:
<ul>
-[loop search="
- ml=1000
- fi=survey
- st=db
- co=yes
- se=master
- sf=type
- op=eq
- rf=code,label
- "]
-<li>[page href="__UI_BASE__/survey/overall" form="item_id=[loop-code]"][loop-code] -- [loop-param label]</A></li>
+[loop list="[scratch survey_keys]" lr=1 head-skip=1]
+<li>[page href="__UI_BASE__/survey/overall" form="item_id=[loop-code]"][loop-code] -- [loop-param label]</A>
+ ([page href=survey/standard form="survey_start=[loop-code]"]run</a>)
+ </li>
[/loop]
</ul>
</blockquote>
@@ -49,4 +74,4 @@
<!-- ----- END REAL STUFF ----- -->
@_UI_STD_FOOTER_@
-<!-- page: @@MV_PAGE@@ version: $Id: index.html,v 1.1 2002/11/20 18:52:17 mheins Exp $ -->
+<!-- page: @@MV_PAGE@@ version: $Id: index.html,v 1.2 2002/11/23 03:54:12 mheins Exp $ -->
1.2 +99 -1 interchange/dist/lib/UI/pages/admin/survey/overall.html
rev 1.2, prev_rev 1.1
Index: overall.html
===================================================================
RCS file: /var/cvs/interchange/dist/lib/UI/pages/admin/survey/overall.html,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- overall.html 20 Nov 2002 18:52:17 -0000 1.1
+++ overall.html 23 Nov 2002 03:54:12 -0000 1.2
@@ -8,8 +8,69 @@
[/tmp]
[set ui_class]Admin[/set]
+[calc]
+ #make absolutely sure
+ my $id = $CGI->{item_id};
+ $id = lc $id;
+ $id =~ s/\W+/_/g;
+ $CGI->{item_id} = $id;
+ return;
+[/calc]
+
+[if cgi survey_clone]
+[flag type=write table=survey]
+[perl tables=survey]
+ my $id = $CGI->{item_id};
+ $id = lc $id;
+ $id =~ s/\W+/_/g;
+ my $cid = $CGI->{survey_clone};
+ my $db = $Db{survey};
+ if($db->record_exists($id)) {
+ $Tag->error( {
+ name => 'survey_clone',
+ set => errmsg("will not clone over existing survey %s", $id),
+ });
+ return;
+ }
+ $db->clone_row($cid, $id);
+ my $ary = $db->query("select code from survey where code like '$cid:%'");
+ for(@$ary) {
+ my $old = $_->[0];
+ my $new = $old;
+ $new =~ s/^ $cid : /$id:/x
+ or do {
+ $Tag->warnings("Cannot clone row $old to $new");
+ next;
+ };
+ $db->clone_row($old, $new);
+ }
+ return;
+[/perl]
+[/if]
+
+[set click_delete_survey]
+[flag type=write table=survey]
+[perl tables=survey]
+ my $id = $CGI->{item_id};
+ my $db = $Db{survey};
+ $db->delete_record($id);
+ my $ary = $db->query("select code from survey where code like '$id:%'");
+ for(@$ary) {
+ $db->delete_record($_->[0]);
+ }
+ $Tag->warnings(errmsg("Survey %s and all its questions deleted.", $id));
+ return;
+[/perl]
+mv_nextpage=admin/survey/index
+[/set]
+
@_UI_STD_HEAD_@
+[if cgi zero_out]
+[calc] delete $Session->{surveys}; delete $Session->{auto_wizard}; return; [/calc]
+[/if]
+
+<blockquote>
[if !value formatter]
[page href=@@MV_PAGE@@
form=|
@@ -40,6 +101,20 @@
[/else]
[/if]
+
+
+
+[page href=@@MV_PAGE@@ form="
+ item_id=[cgi item_id]
+ zero_out=1
+ "]Zero "already completed"</A>
+
+<div style="font-size: larger">
+ Access URL:
+ [area no_session_id=1 no_count=1 href=survey/standard form="survey_start=[cgi item_id]"]
+ ([page no_session_id=1 no_count=1 href=survey/standard form="survey_start=[cgi item_id]"]run</A>)
+ </div>
+</blockquote>
[if type=data term="survey::code::[cgi item_id]"]
[tmpn survey_hide_key]1[/tmpn]
[tmp list_questions][data table=survey col=extended.ui_data_fields key="[cgi item_id]" serial=1][/tmp]
@@ -122,10 +197,24 @@
[/else]
[/if-loop-data]
</td>
+ <td>
+ [page href=survey/graph arg="[loop-code]"]results</A>
+ </td>
</tr>
[/list]
[on-match]
</table>
+<blockquote>
+ <a href="[area href=@@MV_PAGE@@
+ form="
+ mv_click=click_delete_survey
+ item_id=[cgi item_id]
+ mv_action=back
+ "
+ ]"
+ onClick="confirm('Are you sure you want to delete [cgi item_id] and all its questions?')"
+ ><img src="delete.gif" border=0> Delete survey [cgi item_id]</A>
+</blockquote>
[/on-match]
</td>
[/loop]
@@ -174,6 +263,7 @@
extended.data_row_class
extended.break_row_class
+ extended.title_row_class
extended.spacer_row_class
extended.combo_row_class
extended.border_cell_class
@@ -228,6 +318,7 @@
'extended.output_repeated' => 'Allow repeated survey?',
'extended.output_type' => 'Output Type',
'extended.restrict_allow' => 'Allow these ITL tags',
+ 'extended.title_row_class' => 'Title row class',
'extended.spacer_row_class' => 'Spacer row class',
'extended.table_width' => 'Width specification for editor table',
'extended.thanks_message' => 'Body of finished page',
@@ -330,6 +421,13 @@
]
</td>
</tr>
+<tr>
+ <td colspan=2>
+ Access URL:
+ [area no_session_id=1 no_count=1 href=survey/standard form="survey_start=[cgi item_id]"]
+ </td>
+</tr>
</table>
+
@_UI_STD_FOOTER_@
-<!-- page: @@MV_PAGE@@ version: $Revision: 1.1 $ -->
+<!-- page: @@MV_PAGE@@ version: $Revision: 1.2 $ -->
1.1 interchange/eg/survey_graph.tag
rev 1.1, prev_rev 1.0
Index: survey_graph.tag
===================================================================
UserTag survey-graph Order item_id
UserTag survey-graph addAttr
UserTag survey-graph Routine <<EOR
use GD::Graph;
use GD::Graph::pie;
use GD::Graph::bars;
use GD::Graph::Data;
use vars qw/$Tag/;
sub {
my ($id, $opt) = @_;
my $tab = $opt->{table} || 'survey';
my $meta;
my $survey;
my $question;
my $db = database_exists_ref($tab);
if($id) {
($survey, $question) = split /:+/, $id;
}
elsif($opt->{survey} and $opt->{question}) {
$id = $opt->{survey} . '::' . $opt->{question};
}
my @meta_opts = qw/
graph_enable
graph_label
graph_value_font
graph_value_font_size
graph_low_water
graph_title
graph_type
graph_height
graph_width
graph_label_length
/;
my @possible_gd = qw/
accent_threshold accentclr axis_space axislabelclr
b_margin bar_spacing bar_width bgclr borderclrs box_axis
boxclr correct_width cumulate cycle_clrs dclrs fgclr
interlaced l_margin labelclr legendclr line_type_scale
line_types line_width logo logo_position logo_resize
long_ticks marker_size markers overwrite r_margin
shadow_depth shadowclr show_values skip_undef t_margin
text_space textclr tick_length transparent two_axes
types values_format values_space values_vertical
valuesclr x_all_ticks x_label x_label_position
x_label_skip x_label_skip x_label_skip x_labels_vertical
x_max_value x_min_value x_number_format x_plot_values
x_tick_number x_tick_offset x_ticks y_label
y_label_position y_label_skip y_label_skip y_max_value
y_min_value y_number_format y_plot_values y_tick_number
zero_axis zero_axis_only
/;
my %meta_opts;
@meta_opts{@meta_opts} = @meta_opts;
my %gd_opts;
for(@possible_gd) {
next unless defined $opt->{$_} or length $meta->{"graph_$_"};
$gd_opts{$_} = defined $opt->{$_} ? $opt->{$_} : $meta->{"graph_$_"};
}
if($id) {
$meta = $Tag->meta_record($id, undef, $tab);
}
$meta ||= {};
for(@meta_opts) {
$meta->{$_} = $opt->{$_} if defined $opt->{$_};
}
$meta->{graph_width} ||= 400;
$meta->{graph_height} ||= 300;
$meta->{graph_label_length} ||= 20;
# If we ever support multiple types
$meta->{graph_type} ||= 'pie';
my %label;
$gd_opts{title} = $meta->{graph_title} || $meta->{label};
$gd_opts{title} = '' if $opt->{notitle};
my $str;
if($str = $meta->{graph_label}) {
$str =~ s/\s+$//;
$str =~ s/^\s+//;
$str =~ s/[\r\n]+/\n/g;
my @things = split /\n/, $str;
for(@things) {
s/^\s+//;
s/\s+$//;
my ($k, $v) = split /\s*=\s*/, $_, 2;
$label{$k} = $v;
}
}
elsif($str = $meta->{options}) {
$str =~ s/\s+$//;
$str =~ s/^\s+//;
HTML::Entities::decode_entities($str);
$str =~ s/[\r\n]+/\n/g;
my @things = split /\s*,\s*/, $str;
for(@things) {
s/^\s+//;
s/\s+$//;
my ($k, $v) = split /\s*=\s*/, $_, 2;
next unless length($k);
$label{$k} = $v;
}
}
my $ary;
my %answer;
if(! $opt->{file}) {
$opt->{file} = "logs/survey/$survey.txt";
}
if($opt->{search}) {
my $c = {};
Vend::Scan::find_search_params($c, $opt->{search});
my $so = new Vend::TextSearch;
my $q = $so->array($c);
$ary = $q->{mv_results};
}
elsif ($opt->{query}) {
unless($db) {
die errmsg("survey-graph: No database table base for query!\n");
}
$ary = $db->query($opt->{query});
}
my $tot_ans = 0;
if(! $ary) {
my $file = $Tag->filter('filesafe', $opt->{file});
open INP, "< $file"
or die errmsg("survey-graph: Unknown survey file %s.\n", $file);
my $hdr = <INP>;
chomp($hdr);
my @f = split /\t/, $hdr;
my $idx = 0;
for(@f) {
last if $_ eq $question;
$idx++;
}
if($f[$idx] ne $question) {
die errmsg("survey-graph: Unknown question %s.\n", $question);
}
while(<INP>) {
chomp;
$tot_ans++;
@f = split /\t/, $_;
$answer{$f[$idx]}++;
}
close INP;
}
else {
for(@$ary) {
$tot_ans++;
$answer{$_->[0]}++;
}
}
my @keys = keys %answer;
@keys = sort { $answer{$b} <=> $answer{$a} } @keys;
die "No answers!" unless $tot_ans > 0;
my @labs;
my @data;
my $stop;
if($#keys > 7) {
$stop = 6;
}
else {
$stop = $#keys;
}
for(my $i = 0; $i <= $stop; $i++) {
my $val = $keys[$i];
my $lab = $label{$val} || $val;
$lab = $Tag->filter("$meta->{graph_label_length}.", $lab)
if length($lab) > $meta->{graph_label_length};
if($opt->{show_percent}) {
my $pct = $answer{$val} / $tot_ans * 100;
my $num = $opt->{show_num} ? "$answer{$val}, " : '';
$lab .= sprintf " (%s%.1f%%)", $num, $pct;
}
elsif ($opt->{show_num}) {
$lab .= " ($answer{$val})";
}
push @labs, $lab;
push @data, $answer{$val};
}
$stop++;
my $other = 0;
for(my $i = $stop; $i <= $#keys; $i++) {
$other += $answer{$keys[$i]};
}
if($other > 0) {
my $lab = errmsg('Other');
$lab = $Tag->filter("$meta->{graph_label_length}.", $lab)
if length($lab) > $meta->{graph_label_length};
if($opt->{show_percent}) {
my $pct = $other / $tot_ans * 100;
my $num = $opt->{show_num} ? "$other, " : '';
$lab .= sprintf " (%s%.1f%%)", $num, $pct;
}
elsif ($opt->{show_num}) {
$lab .= " ($other)";
}
push @labs, $lab;
push @data, $other;
}
#::logDebug("labels=" . ::uneval(\@labs));
#::logDebug("data=" . ::uneval(\@data));
my $graph;
my $font;
if($meta->{graph_type} eq 'bars') {
$graph = GD::Graph::bars->new($meta->{graph_width}, $meta->{graph_height});
}
else {
$graph = GD::Graph::pie->new($meta->{graph_width}, $meta->{graph_height});
if($font = $meta->{graph_value_font}) {
if($font eq 'small') {
$font = GD::gdSmallFont();
}
elsif($font eq 'medium') {
$font = GD::gdMediumBoldFont();
}
elsif ($font eq 'large') {
$font = GD::gdLargeFont();
}
elsif ($font eq 'giant') {
$font = GD::gdGiantFont();
}
$gd_opts{label_font} = $font;
}
$graph->set_value_font($font, $meta->{graph_value_font_size});
#::logDebug("GD font set error: " . GD::Text->error());
}
$graph->set(%gd_opts);
my $gd = $graph->plot([ \@labs, \@data ]);
$Tag->deliver( { type => 'image/png', body => $gd->png });
return;
}
EOR