[interchange-cvs] interchange - heins modified 5 files
interchange-core@interchange.redhat.com
interchange-core@interchange.redhat.com
Sat Oct 6 03:04:00 2001
User: heins
Date: 2001-10-06 07:03:38 GMT
Modified: dist/lib/UI Primitive.pm
Modified: dist/lib/UI/usertag table_editor.tag
Modified: dist/lib/UI/profiles process_filter
Modified: scripts interchange.PL
Modified: lib/Vend Util.pm
Log:
* Add serialization capability to table_editor tag.
* : is now specified to be a table::column separator,
and . in a column name makes an auto-vivified serialized hash
reference.
* Example:
[table-editor
table=userdb
href=process
auto_secure=1
ui_data_fields="
username
preferences.deep.deeper
preferences.another.deep.deeper
"
key="junk"
label.preferences.deep.deeper="Deep Key"
default.preferences.deep.deeper="pretty deep"
label.preferences.another.deep.deeper="Deeper Key"
default.preferences.another.deep.deeper="quite deep"
]
This will result in:
username:junk
preferences:{ deep => { deeper => 'pretty deep'}, another => { deep => { deeper => 'pretty deep'}} }
Values are read for defaults, can mix and match anywhere, and
use outboard tables, i.e.
ui_data_fields="
username
preferences.deep.deeper
othertable:column.deep.deeper
"
Revision Changes Path
2.5 +49 -18 interchange/dist/lib/UI/Primitive.pm
rev 2.5, prev_rev 2.4
Index: Primitive.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/dist/lib/UI/Primitive.pm,v
retrieving revision 2.4
retrieving revision 2.5
diff -u -r2.4 -r2.5
--- Primitive.pm 2001/09/07 15:03:04 2.4
+++ Primitive.pm 2001/10/06 07:03:36 2.5
@@ -1,6 +1,6 @@
# UI::Primitive - Interchange configuration manager primitives
-# $Id: Primitive.pm,v 2.4 2001/09/07 15:03:04 mheins Exp $
+# $Id: Primitive.pm,v 2.5 2001/10/06 07:03:36 mheins Exp $
# Copyright (C) 1998-2001 Red Hat, Inc. <interchange@redhat.com>
@@ -25,7 +25,7 @@
package UI::Primitive;
-$VERSION = substr(q$Revision: 2.4 $, 10);
+$VERSION = substr(q$Revision: 2.5 $, 10);
$DEBUG = 0;
use vars qw!
@@ -808,26 +808,23 @@
$base_entry_value = $value =~ /::/ ? $table : $value;
}
}
- my $tag = '';
- if($o->{arbitrary}) {
- $tag = "$o->{arbitrary}::";
- }
- my (@tries) = "$tag${table}::$column";
- if($key) {
- # Don't think we need table::key combo anymore....
- # unshift @tries, "$tag${table}::${column}::$key", "$tag${table}::$key";
- unshift @tries, "$tag${table}::${column}::$key";
+
+ my (@tries) = "${table}::$column";
+ unshift @tries, "${table}::${column}::$key"
+ if $key;
+
+ my $view;
+ if($view = $o->{arbitrary}) {
+ unshift @tries, "$o->{arbitrary}::${table}::${column}";
+ unshift @tries, "$o->{arbitrary}::${table}::${column}::$key" if $key;
}
my $sess = $Vend::Session->{mv_metadata} || {};
- if($tag and $o->{fallback}) {
- push @tries, "${table}::${column}::$key", "${table}::${column}";
- }
-
push @tries, { type => $o->{type} }
if $o->{type} || $o->{label};
+#::logDebug("calling meta_display with type=$o->{type}");
for $metakey (@tries) {
my $record;
unless ( $record = $sess->{$metakey} and ref $record ) {
@@ -845,15 +842,28 @@
}
my $opt;
+ # Get additional settings from extended field, which is a serialized
+ # hash
+ my $hash;
if($record->{extended}) {
- my $hash = Vend::Util::get_option_hash($record->{extended});
+ $hash = Vend::Util::get_option_hash($record->{extended});
if(ref $hash) {
- for (keys %$hash) {
- $record->{$_} = $hash->{$_};
- }
+ @$record{keys %$hash} = values %$hash;
+ }
+ else {
+ undef $hash;
}
}
- ## Here we allow override with the display tag...
+
+ # Allow view settings to be placed in the extended area
+ if($view and $hash and $hash->{view}) {
+ my $view_hash = $record->{view}{$view};
+ ref $view_hash
+ and @$record{keys %$view_hash} = values %$view_hash;
+ }
+
+ ## Here we allow override with the display tag, even with views and
+ ## extended
my @override = grep defined $o->{$_},
qw/
append
@@ -966,6 +976,27 @@
$record->{passed} = '1=' . ::errmsg('No');
$record->{passed} .= ',=' . ::errmsg('Yes');
$o->{type} = 'select' unless $o->{type} =~ /radio/;
+ }
+ elsif ($record->{type} =~ s/^custom\s+//s) {
+ my $wid = lc $record->{type};
+ $wid =~ tr/-/_/;
+ my $w;
+ $record->{attribute} ||= $column;
+ $record->{table} ||= $meta_db;
+ $record->{rows} ||= $record->{height};
+ $record->{cols} ||= $record->{width};
+ $record->{field} ||= 'options';
+ $record->{name} ||= $column;
+ $record->{outboard} ||= $metakey;
+ my $Tag = new Vend::Tags;
+ eval {
+ $w = $Tag->$wid($record->{name}, $value, $record, $o);
+ };
+ if($@) {
+ ::logError("error using custom widget %s: %s", $wid, $@);
+ }
+ return $w unless $o->{template};
+ return ($w, $record->{label}, $record->{help}, $record->{help_url});
}
elsif ($record->{type} eq 'option_format') {
my $w = option_widget($record->{name}, $value);
2.11 +95 -12 interchange/dist/lib/UI/usertag/table_editor.tag
rev 2.11, prev_rev 2.10
Index: table_editor.tag
===================================================================
RCS file: /anon_cvs/repository/interchange/dist/lib/UI/usertag/table_editor.tag,v
retrieving revision 2.10
retrieving revision 2.11
diff -u -r2.10 -r2.11
--- table_editor.tag 2001/08/10 20:21:23 2.10
+++ table_editor.tag 2001/10/06 07:03:36 2.11
@@ -129,6 +129,7 @@
my @messages;
my @errors;
+#Debug("labels=" . uneval($opt->{label}));
FORMATS: {
no strict 'refs';
my $ref;
@@ -209,6 +210,7 @@
my $widget = $opt->{widget};
my $width = $opt->{widget_width};
#::logDebug("widget=" . ::uneval_it($widget) );
+#::logDebug("label=" . ::uneval_it($label) );
#my $blabel = $opt->{begin_label} || '<b>';
#my $elabel = $opt->{end_label} || '</b>';
@@ -241,12 +243,14 @@
if($opt->{action_click}) {
$ntext = <<EOF;
mv_todo=return
+ui_wizard_action=Next
mv_click=$opt->{action_click}
EOF
}
else {
$ntext = <<EOF;
mv_todo=return
+ui_wizard_action=Next
mv_click=ui_override_next
EOF
}
@@ -256,12 +260,14 @@
$hidgo =~ s/\0.*//s;
$ctext = $Scratch->{$opt->{cancel_text}} = <<EOF;
mv_form_profile=
+ui_wizard_action=Cancel
mv_nextpage=$hidgo
mv_todo=back
EOF
if($opt->{mv_prevpage}) {
$btext = $Scratch->{$opt->{back_text}} = <<EOF;
mv_form_profile=
+ui_wizard_action=Back
mv_nextpage=$opt->{mv_prevpage}
mv_todo=return
EOF
@@ -750,8 +756,16 @@
EOF
if($opt->{mv_blob_nick}) {
- my $ref = $blob->{$opt->{mv_blob_nick}}
- or last DOBLOB;
+ my @keys = split /::/, $opt->{mv_blob_nick};
+ my $ref = $blob->{shift @keys};
+ for(@keys) {
+ my $prior = $ref;
+ undef $ref;
+ eval {
+ $ref = $prior->{$_};
+ };
+ last DOBLOB unless ref $ref;
+ }
for(keys %$ref) {
$data->{$_} = $ref->{$_};
}
@@ -1070,7 +1084,7 @@
my %email_cols;
my %ok_col;
- while($passed_fields =~ s/(\w+:+\S+)//) {
+ while($passed_fields =~ s/(\w+[.:]+\S+)//) {
push @extra_cols, $1;
}
@@ -1091,17 +1105,25 @@
if($opt->{ui_data_fields}) {
for(@dbcols, @extra_cols) {
- unless (/^(\w+):+(\S+)/) {
+ unless (/^(\w+)([.:]+)(\S+)/) {
$ok_col{$_} = 1;
next;
}
my $t = $1;
- my $c = $2;
+ my $s = $2;
+ my $c = $3;
+ if($s eq '.') {
+ $c = $t;
+ $t = $table;
+ }
+ else {
+ $c =~ s/\..*//;
+ }
next unless $Tag->db_columns( { name => $t, columns => $c, });
$ok_col{$_} = 1;
}
}
-
+
@cols = grep $ok_col{$_}, split /\s+/, $opt->{ui_data_fields};
if($opt->{defaults}) {
@@ -1141,6 +1163,10 @@
$row_template =~ s/~OPT:(\w+)~/$opt->{$1}/g;
$row_template =~ s/~BLABEL~/$blabel/g;
$row_template =~ s/~ELABEL~/$elabel/g;
+
+ my %serialize;
+ my %serial_data;
+
foreach my $col (@cols) {
my $t;
my $c;
@@ -1162,9 +1188,14 @@
my $do = $display_only{$col};
my $currval;
+ my $serialize;
+
if($col =~ /(\w+):+([^:]+)(?::+(\S+))?/) {
$t = $1;
$c = $2;
+ $c =~ /(.+?)\.\w.*/
+ and $col = "$t:$1"
+ and $serialize = $c;
$k = $3 || undef;
push @ext_enable, ("$t:$c" . $k ? ":$k" : '')
unless $do;
@@ -1172,7 +1203,10 @@
else {
$t = $table;
$c = $col;
- push @data_enable, $c
+ $c =~ /(.+?)\.\w.*/
+ and $col = $1
+ and $serialize = $c;
+ push @data_enable, $col
unless $do and ! $opt->{mailto};
}
@@ -1216,6 +1250,37 @@
$overridden = 1;
}
+ my $namecol;
+ if($serialize) {
+#Debug("serialize=$serialize");
+ if($serialize{$col}) {
+ push @{$serialize{$col}}, $serialize;
+ }
+ else {
+ my $sd;
+ if($col =~ /:/) {
+ my ($tt, $tc) = split /:+/, $col;
+ $sd = tag_data($tt, $tc, $k);
+ }
+ else {
+ $sd = $data->{$col} || $::Values->{$col};
+ }
+#Debug("serial_data=$sd");
+ $serial_data{$col} = $sd;
+ $opt->{hidden}{$col} = $data->{$col};
+ $serialize{$col} = [$serialize];
+ }
+ $c =~ /\.(.*)/;
+ my $hk = $1;
+#Debug("fetching serial_data for $col hk=$hk data=$serial_data{$col}");
+ $currval = dotted_hash($serial_data{$col}, $hk);
+#Debug("fetched hk=$hk value=$currval");
+ $overridden = 1;
+ $namecol = $c = $serialize;
+ }
+
+ $namecol = $col unless $namecol;
+
$type = 'value' if $do and ! ($opt->{wizard} || ! $opt->{mailto});
if (! length $currval and defined $default->{$c}) {
@@ -1240,7 +1305,7 @@
$template =~ s/\$LABEL\$/$Tag->error($parm)/eg;
}
$template =~ s/~TKEY~/$tkey_message || ''/eg;
-#::logDebug("col=$c widget=$widget->{$c} (type=$type)");
+#::logDebug("col=$c widget=$widget->{$c} label=$label->{$c} (type=$type)");
my $display = $Tag->display({
applylocale => 1,
arbitrary => $opt->{ui_meta_view},
@@ -1254,7 +1319,7 @@
help_url => $help_url->{$c},
label => $label->{$c},
key => $key,
- name => $col,
+ name => $namecol,
override => $overridden,
field => $field->{$c},
passed => $passed->{$c},
@@ -1308,15 +1373,15 @@
$display =~ s/\~META\~/$meta/g;
$display =~ s/\~ERROR\~/$Tag->error({ name => $c, keep => 1 })/eg;
- if ($break{$col}) {
+ if ($break{$namecol}) {
while($rowcount % $rowdiv) {
$out .= '<TD> </td><TD> </td>';
$rowcount++;
}
$out .= "</TR>\n";
- $out .= <<EOF if $break{$col};
+ $out .= <<EOF if $break{$namecol};
<TR class=rbreak>
- <TD COLSPAN=$span class=cbreak>$break_label{$col}<IMG SRC="$opt->{clear_image}" WIDTH=1 HEIGHT=1 alt=x></TD>
+ <TD COLSPAN=$span class=cbreak>$break_label{$namecol}<IMG SRC="$opt->{clear_image}" WIDTH=1 HEIGHT=1 alt=x></TD>
</TR>
EOF
$rowcount = 0;
@@ -1338,6 +1403,24 @@
}
if(@ext_enable) {
$Scratch->{mv_data_enable} .= " " . join(" ", @ext_enable) . " ";
+ }
+
+ my @serial = keys %serialize;
+ my @serial_fields;
+ for (@serial) {
+#Debug("$_ serial_data=$serial_data{$_}");
+ $serial_data{$_} = uneval($serial_data{$_})
+ if is_hash($serial_data{$_});
+ $serial_data{$_} =~ s/\&/&/g;
+ $serial_data{$_} =~ s/"/"/g;
+ $out .= qq{<INPUT TYPE=hidden NAME="$_" VALUE="$serial_data{$_}">};
+ push @serial_fields, @{$serialize{$_}};
+ }
+
+ if(@serial_fields) {
+ $out .= qq{<INPUT TYPE=hidden NAME="ui_serial_fields" VALUE="};
+ $out .= join " ", @serial_fields;
+ $out .= qq{">};
}
###
2.1 +39 -1 interchange/dist/lib/UI/profiles/process_filter
rev 2.1, prev_rev 2.0
Index: process_filter
===================================================================
RCS file: /anon_cvs/repository/interchange/dist/lib/UI/profiles/process_filter,v
retrieving revision 2.0
retrieving revision 2.1
diff -u -r2.0 -r2.1
--- process_filter 2001/07/18 02:22:13 2.0
+++ process_filter 2001/10/06 07:03:36 2.1
@@ -16,6 +16,44 @@
}
}
}
+
+ SERIALIZE: {
+ last SERIALIZE unless $CGI->{ui_serial_fields};
+#Debug("Found serialzed values $CGI->{ui_serial_fields}");
+ my(@scols) = split /\s+/, $CGI->{ui_serial_fields};
+ my(@cols) = split /\s+/, $CGI->{mv_data_fields};
+ my %serial_data;
+ for(@scols) {
+#Debug("serial field $_");
+ my $val = defined $CGI->{$_} ? $CGI->{$_} : '';
+#Debug("serial field $_ value=$val");
+ m/(\w+)\.(.*)/
+ or next;
+ my $maincol = $1;
+ my $hashkey = $2;
+ if(! $serial_data{$maincol}) {
+ for(@cols) {
+ next unless /^(\w+:+)?$maincol$/;
+ $serial_data{$maincol} = delete $CGI->{$_};
+ last;
+ }
+ }
+
+ $serial_data{$maincol} = dotted_hash(
+ $serial_data{$maincol},
+ $hashkey,
+ $val,
+ );
+
+ }
+ for(keys %serial_data) {
+ $CGI->{$_} = $serial_data{$_};
+ }
+ for(@cols) {
+#Debug("after serialize data for $_: $CGI->{$_}");
+ }
+ }
+
my @uploads = grep /^ui_upload_file_path:/, keys %$CGI;
#Debug("Check uploads: " . join ",", @uploads);
return unless @uploads;
@@ -37,7 +75,7 @@
my $isfile = $Tag->value_extended( { name => $key, test => 'isfile' } );
#Debug("cgi->$key isfile='$isfile'");
next unless $isfile;
- $path =~ s,/+$,,;
+ $path =~ s,[\\/]+$,,;
my $fn = $CGI->{$key};
$fn =~ s,.*/,,;
$fn =~ s,.*\\,,;
2.10 +17 -7 interchange/scripts/interchange.PL
rev 2.10, prev_rev 2.9
Index: interchange.PL
===================================================================
RCS file: /anon_cvs/repository/interchange/scripts/interchange.PL,v
retrieving revision 2.9
retrieving revision 2.10
diff -u -r2.9 -r2.10
--- interchange.PL 2001/09/04 13:24:18 2.9
+++ interchange.PL 2001/10/06 07:03:37 2.10
@@ -50,7 +50,7 @@
#
# Interchange version 4.9.0
#
-# $Id: interchange.PL,v 2.9 2001/09/04 13:24:18 mheins Exp $
+# $Id: interchange.PL,v 2.10 2001/10/06 07:03:37 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -528,6 +528,7 @@
my($key,$value);
# Update a database record
# Check to see if this is allowed
+::logDebug("mv_data_enable=$::Scratch->{mv_data_enable}");
if(! $::Scratch->{mv_data_enable}) {
logError(
"Attempted database update without permission, table=%s key=%s.",
@@ -644,7 +645,7 @@
while (($key, $value) = each %CGI::values) {
next unless defined $data{$key};
- $count = (@{$data{$key}} = split /\0/, $value);
+ $count = (@{$data{$key}} = split /\0/, $value, -1);
$max = $count, $maxname = $key if $count > $max;
$min = $count, $minname = $key if $count < $min;
}
@@ -845,6 +846,11 @@
push(@v, $value);
}
+ if(! length($select_key) ) {
+ next if defined $CGI::values{mv_update_empty_key}
+ and ! $CGI::values{mv_update_empty_key};
+ }
+
if($function eq 'delete') {
$base_db->delete_record($select_key);
}
@@ -877,10 +883,15 @@
#::logDebug("update_data: blob string=$string");
$blob = $safe->reval($string);
#::logDebug("update_data: blob object=$blob");
- $blob = {} if ! $blob;
- $blob->{$blob_nick} = {}
- if ! $blob->{$blob_nick};
- $brec = $blob->{$blob_nick};
+ $blob = {} unless ref($blob) eq 'HASH';
+ $brec = $blob;
+ my @keys = split /::/, $blob_nick;
+ for(@keys) {
+ unless ( ref($brec->{$_}) eq 'HASH') {
+ $brec->{$_} = {};
+ }
+ $brec = $brec->{$_};
+ }
}
while($field = shift @k) {
$value = shift @v;
@@ -960,7 +971,6 @@
}
return;
}
-
# Parse the mv_click and mv_check special variables
sub parse_click {
my ($ref, $click, $extra) = @_;
2.5 +56 -2 interchange/lib/Vend/Util.pm
rev 2.5, prev_rev 2.4
Index: Util.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Util.pm,v
retrieving revision 2.4
retrieving revision 2.5
diff -u -r2.4 -r2.5
--- Util.pm 2001/09/07 04:38:27 2.4
+++ Util.pm 2001/10/06 07:03:37 2.5
@@ -1,6 +1,6 @@
# Vend::Util - Interchange utility functions
#
-# $Id: Util.pm,v 2.4 2001/09/07 04:38:27 jon Exp $
+# $Id: Util.pm,v 2.5 2001/10/06 07:03:37 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -36,12 +36,14 @@
errmsg
escape_chars
evalr
+ dotted_hash
file_modification_time
file_name_is_absolute
find_special_page
format_log_msg
generate_key
get_option_hash
+ is_hash
is_no
is_yes
l
@@ -77,7 +79,7 @@
use Safe;
use subs qw(logError logGlobal);
use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION = substr(q$Revision: 2.4 $, 10);
+$VERSION = substr(q$Revision: 2.5 $, 10);
BEGIN {
eval {
@@ -767,6 +769,51 @@
return $safe->reval($string);
}
+sub is_hash {
+ return ref($_[0]) eq 'HASH';
+}
+
+sub dotted_hash {
+ my($hash, $key, $value) = @_;
+::logDebug("dotted_hash hash=$hash key=$key");
+ $hash = get_option_hash($hash) unless is_hash($hash);
+::logDebug("dotted_hash hash=$hash key=$key after get_option_hash");
+ unless (is_hash($hash)) {
+ return undef unless defined $value;
+ $hash = {};
+ }
+ my @keys = split /[\.:]+/, $key;
+ my $final;
+ my $ref;
+
+ if(! defined $value) {
+ # Retrieving
+::logDebug("dotted_hash retrieving key=$key");
+ $ref = $hash->{shift @keys};
+ for(@keys) {
+ return undef unless is_hash($ref);
+ $ref = $ref->{$_};
+ }
+::logDebug("dotted_hash returning value=$ref");
+ return $ref;
+ }
+
+ # Storing
+ $final = pop @keys;
+::logDebug("dotted_hash storing key=$key final=$final value=$value");
+ $ref = $hash;
+
+ for(@keys) {
+ $ref->{$_} = {} unless is_hash($ref->{$_});
+ $ref = $ref->{$_};
+ }
+
+ $ref->{$final} = $value;
+ $hash = uneval_it($hash);
+::logDebug("dotted_hash returning=$hash");
+ return $hash;
+}
+
sub get_option_hash {
if (ref $_[0]) {
return $_[0] unless ref $_[1];
@@ -1655,6 +1702,14 @@
# Here for convenience in calls
sub set_cookie {
my ($name, $value, $expire, $domain, $path) = @_;
+
+ # Set expire to now + some time if expire string is something like
+ # "30 days" or "7 weeks" or even "60 minutes"
+ if($expire =~ /^\s*\d+[\s\0]*[A-Za-z]\S*\s*$/) {
+ my $add = Vend::Config::time_to_seconds($expire);
+ $expire = time() + $add if $add;
+ }
+
if (! $::Instance->{Cookies}) {
$::Instance->{Cookies} = []
}
@@ -2062,9 +2117,8 @@
$ok;
}
-
-sub Vend::Util::get_cfg_header {
+sub get_cfg_header {
my ($file) = @_;
my $cfg = {};
local ($_, *IN);