[interchange-cvs] interchange - heins modified 2 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Thu Apr 21 23:02:44 EDT 2005
User: heins
Date: 2005-04-22 03:02:44 GMT
Modified: lib/Vend Config.pm External.pm
Log:
* Add mechanism for other programs to use Interchange sessions and
possibly other things.
* Just a proof of concept at this point and is *not* for serious
use. The interface needs serious work.
* The External mechanism in Vend::Config will pretty much stay
the same, though it needs to exclusive lock the file while writing
and the module needs to shared-lock it for reading.
* Works with the PHP5 perl connector, i.e.:
<?php
$interchange_base = '/usr/lib/interchange';
$interchange_lib = "$interchange_base/lib";
$interchange_struct = "/var/run/interchange/external.structure";
putenv("PERL_SIGNALS=unsafe");
umask(7);
$perl = new Perl();
$perlstring = "
use lib '$interchange_lib';
\$ENV{EXT_INTERCHANGE_FILE} = '$interchange_struct';
\$ENV{EXT_INTERCHANGE_DIR} = '$interchange_base';
";
$perl->eval($perlstring);
$perl->require("Vend/External.pm");
$origsid = $sid = $_COOKIE["MV_SESSION_ID"];
if(! $sid) {
$_REQUEST["mv_session_id"];
}
$cat = 'standard';
$catback = $perl->catalog($cat);
$out = "sid=$sid<br>";
$out .= "parm is debug=" . $_REQUEST["debug"] . "<br>";
$out .= "catalog is $catback<br>";
$out .= "now sid=$sid<br>";
$remote = $_SERVER['REMOTE_ADDR'];
$perl->remote_addr($remote);
$new = $perl->session($sid);
if($new) {
$sid = $perl->session_name();
$out .= "new session, now sid=$sid<br>";
}
if($sid != $origsid) {
setcookie('MV_SESSION_ID', $sid, 0 , '/');
}
## Can print now that cookie is set
print $out;
$fname = $perl->value("values","fname");
$lname = $perl->value("values","lname");
print "Well what do you know, we have a '$fname $lname'!<br>";
$cart = $perl->value('carts', 'main');
$nitems = count($cart);
if($nitems) {
print "We have a cart with $nitems items</br>";
for($i = 0; $i < $nitems; $i++) {
$code = $cart[$i]["code"];
$quantity = $cart[$i]["quantity"];
print "Item $code is in cart, quantity $quantity.<br>";
}
}
?>
* Pretty slow. Uses Vend::Session currently, but I will be adding a
Vend::MinimalSession which strips out all the junk which is
probably slowing things down. It may even motivate me to do a real
(and long needed) Vend::Session rewrite.
Revision Changes Path
2.166 +150 -5 interchange/lib/Vend/Config.pm
rev 2.166, prev_rev 2.165
Index: Config.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Config.pm,v
retrieving revision 2.165
retrieving revision 2.166
diff -u -r2.165 -r2.166
--- Config.pm 17 Apr 2005 12:44:39 -0000 2.165
+++ Config.pm 22 Apr 2005 03:02:43 -0000 2.166
@@ -1,6 +1,6 @@
# Vend::Config - Configure Interchange
#
-# $Id: Config.pm,v 2.165 2005/04/17 12:44:39 mheins Exp $
+# $Id: Config.pm,v 2.166 2005/04/22 03:02:43 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -49,7 +49,7 @@
use Vend::File;
use Vend::Data;
-$VERSION = substr(q$Revision: 2.165 $, 10);
+$VERSION = substr(q$Revision: 2.166 $, 10);
my %CDname;
my %CPname;
@@ -185,6 +185,22 @@
SOAP_Control 1
));
+my @External_directives = qw(
+ CatalogName
+ ScratchDefault
+ ValuesDefault
+ ScratchDir
+ SessionDB
+ SessionDatabase
+ SessionExpire
+ VendRoot
+ VendURL
+ SecureURL
+ Variable->SQLDSN
+ Variable->SQLPASS
+ Variable->SQLUSER
+);
+
my $StdTags;
use vars qw/ $configfile /;
@@ -223,14 +239,18 @@
}
local($^W);
-
- ::logGlobal({level => 'notice'},
- "%s\nIn line %s of the configuration file '%s':\n%s\n",
+ my $extra = '';
+ if($configfile and $Vend::config_line) {
+ $extra = errmsg(
+ "\nIn line %s of the configuration file '%s':\n%s\n",
$msg,
$.,
$configfile,
$Vend::config_line,
);
+ }
+
+ ::logGlobal({level => 'notice'}, "$msg$extra");
}
sub setcat {
@@ -362,6 +382,9 @@
['SubCatalog', 'catalog', ''],
['AutoVariable', 'autovar', 'UrlJoiner'],
['XHTML', 'yesno', 'No'],
+ ['External', 'yesno', 'No'],
+ ['ExternalFile', 'root_dir', "$Global::RunDir/external.structure"],
+ ['ExternalExport', undef, 'Global::Catalog=Catalog'],
];
return $directives;
@@ -564,6 +587,8 @@
['AutoVariable', 'autovar', ''],
['ErrorDestination', 'hash', ''],
['XHTML', 'yesno', $Global::XHTML],
+ ['External', 'yesno', 'No'],
+ ['ExternalExport', undef, join " ", @External_directives],
];
@@ -1653,6 +1678,110 @@
return parse_regex($var, $value);
}
+sub external_global {
+ my ($value) = @_;
+
+ my $main = {};
+
+ my @sets = grep /\w/, split /[\s,]+/, $value;
+#::logDebug( "Parsing sets=" . join(",", @sets) . "\n" );
+
+ no strict 'refs';
+
+ for my $set (@sets) {
+#::logDebug( "Parsing $set\n" );
+ my @keys = split /->/, $set;
+ my ($k, $v) = split /=/, $keys[0];
+ my $major;
+ my $var;
+ if($k =~ m/^(\w+)::(\w+)$/) {
+ $major = $1;
+ $var = $2;
+ }
+ $major ||= 'Global';
+ $v ||= $var;
+ my $walk = ${"${major}::$var"};
+ my $ref = $main->{$v} = $walk;
+ for(my $i = 1; $i < @keys; $i++) {
+ my $current = $keys[$i];
+#::logDebug( "Walking $current\n" );
+ if($i == $#keys) {
+ if( CORE::ref($ref) eq 'ARRAY' ) {
+ $current =~ s/\D+//g;
+ $current =~ /^\d+$/
+ or config_error("External: Bad array index $current from $set");
+ $ref->[$current] = $walk->[$current];
+#::logDebug( "setting $current to ARRAY\n" );
+ }
+ elsif( CORE::ref($ref) eq 'HASH' ) {
+ $ref->{$current} = $walk->{$current};
+#::logDebug( "setting $current to HASH\n" );
+ }
+ else {
+ config_error("External: bad data structure for $set");
+ }
+ }
+ else {
+ $walk = $walk->{$current};
+#::logDebug( "Walking $current\n" );
+ if( CORE::ref($walk) eq 'HASH' ) {
+ $ref->{$current} = {};
+ $ref = $ref->{$current};
+ }
+ else {
+ config_error("External: bad data structure for $set");
+ }
+ }
+ }
+ }
+ return $main;
+}
+
+# Set the External environment, dumps, etc.
+sub external_cat {
+ my ($value) = @_;
+
+ my $c = $C
+ or config_error( "Not in catalog configuration context." );
+
+ my $main = {};
+ my @sets = grep /\w/, split /[\s,]+/, $value;
+ for my $set (@sets) {
+ my @keys = split /->/, $set;
+ my $ref = $main;
+ my $walk = $c;
+ for(my $i = 0; $i < @keys; $i++) {
+ my $current = $keys[$i];
+ if($i == $#keys) {
+ if( CORE::ref($ref) eq 'ARRAY' ) {
+ $current =~ s/\D+//g;
+ $current =~ /^\d+$/
+ or config_error("External: Bad array index $current from $set");
+ $ref->[$current] = $walk->[$current];
+ }
+ elsif( CORE::ref($ref) eq 'HASH' ) {
+ $ref->{$current} = $walk->{$current};
+ }
+ else {
+ config_error("External: bad data structure for $set");
+ }
+ }
+ else {
+ $walk = $walk->{$current};
+ if( CORE::ref($walk) eq 'HASH' ) {
+ $ref->{$current} = {};
+ $ref = $ref->{$current};
+ }
+ else {
+ config_error("External: bad data structure for $set");
+ }
+ }
+ }
+ }
+
+ return $main;
+}
+
# Set up an ActionMap or FormAction or FileAction
sub parse_action {
my ($var, $value, $mapped) = @_;
@@ -2710,6 +2839,22 @@
return 1 unless $C->{Autoload};
push @Dispatches, 'Autoload';
return 1;
+ },
+ External => sub {
+ return 1 unless $C->{External};
+ unless($Global::External) {
+ config_warn("External directive set to Yes, but not allowed by Interchange configuration.");
+ return 1;
+ }
+ return 1 unless $C->{External};
+ unless($Global::ExternalStructure) {
+ $Global::ExternalStructure = external_global($Global::ExternalExport);
+ }
+ $C->{ExternalExport} = external_cat($C->{ExternalExport});
+ $Global::ExternalStructure->{Catalogs}{ $C->{CatalogName} }{external_config}
+ = $C->{ExternalExport};
+ Vend::Util::uneval_file($Global::ExternalStructure, $Global::ExternalFile);
+ chmod 0644, $Global::ExternalFile;
},
);
2.3 +165 -2 interchange/lib/Vend/External.pm
rev 2.3, prev_rev 2.2
Index: External.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/External.pm,v
retrieving revision 2.2
retrieving revision 2.3
diff -u -r2.2 -r2.3
--- External.pm 18 Jun 2003 17:34:44 -0000 2.2
+++ External.pm 22 Apr 2005 03:02:43 -0000 2.3
@@ -1,6 +1,7 @@
-# Vend::External - Interchange routines for calling external programs
+# Vend::External - Interchange setup for linking sessions to other programs
+# Vend::External - Also Interchange routines for calling external programs
#
-# $Id: External.pm,v 2.2 2003/06/18 17:34:44 jon Exp $
+# $Id: External.pm,v 2.3 2005/04/22 03:02:43 mheins Exp $
#
# Copyright (C) 1996-2002 Red Hat, Inc.
#
@@ -22,7 +23,31 @@
package Vend::External;
use strict;
+
+BEGIN {
+
+ if($ENV{EXT_INTERCHANGE_DIR}) {
+ $Global::VendRoot = $ENV{EXT_INTERCHANGE_DIR};
+ if(-f "$Global::VendRoot/_session_storable") {
+ $ENV{MINIVEND_STORABLE} = 1;
+ }
+ }
+}
+
use Vend::Util;
+use Vend::Session;
+use Vend::Cart;
+use Cwd;
+require Data::Dumper;
+
+BEGIN {
+ if($ENV{EXT_INTERCHANGE_DIR}) {
+ die "No VendRoot specified.\n" unless $Global::VendRoot;
+ $Global::RunDir = $ENV{EXT_INTERCHANGE_RUNDIR} || "$Global::VendRoot/etc";
+ Vend::Util::setup_escape_chars();
+ }
+ $Global::ExternalFile = $ENV{EXT_INTERCHANGE_FILE} || "$Global::RunDir/external.structure";
+}
sub check_html {
my($out) = @_;
@@ -41,6 +66,144 @@
unlink $file or die "Couldn't unlink temp file $file: $!\n";
$$out .= $begin . $check . $end;
return;
+}
+
+1;
+
+package main;
+
+BEGIN {
+ if($ENV{EXT_INTERCHANGE_DIR}) {
+ sub logDebug {
+ warn caller() . ':external_debug: ', Vend::Util::errmsg(@_), "\n";
+ }
+
+ sub catalog {
+ my $cat = shift or return $Vend::Cat;
+ $Vend::Cat = $cat;
+ }
+
+ sub session {
+ my $id = shift;
+ $Vend::Cat ||= $ENV{EXT_INTERCHANGE_CATALOG}
+ or die "No Interchange catalog specified\n";
+ $Vend::Cfg = $Vend::Global->{Catalogs}{$Vend::Cat}{external_config}
+ or die "Catalog $Vend::Cat not found.\n";
+ $CGI::remote_addr = $ENV{REMOTE_ADDR};
+ if($id =~ /^(\w+):/) {
+ $Vend::SessionID = $1;
+ $Vend::SessionName = $id;
+ }
+ else {
+ $Vend::SessionID = $id;
+ $Vend::SessionName = "${id}:$CGI::remote_addr";
+ }
+
+ Vend::Session::get_session();
+ }
+
+ sub _walk {
+ my $ref = shift;
+ my $last = pop (@_);
+
+ if($last =~ /->/ and ! scalar(@_)) {
+ @_ = split /->/, $last;
+ $last = pop @_;
+ }
+
+ eval {
+ for(@_) {
+ $ref = /^\[\d+\]$/ ? $ref->[0] : $ref->{$_};
+ }
+ };
+ if($@) {
+ logDebug(caller() . ": problem following structure: " . join("->", @_, $last));
+ }
+ return $last =~ /^\[\d+\]$/ ? $ref->[$last] : $ref->{$last};
+ }
+
+ sub _set_walk {
+ my $ref = shift;
+ my $value = shift;
+ my $last = pop (@_);
+
+ if($last =~ /->/ and ! scalar(@_)) {
+ @_ = split /->/, $last;
+ $last = pop @_;
+ }
+
+ eval {
+ for(@_) {
+ $ref = /^\[\d+\]$/ ? $ref->[0] : $ref->{$_};
+ }
+ };
+ if($@) {
+ logDebug(caller() . ": problem following structure: " . join("->", @_, $last));
+ }
+ if($last =~ /^\[\d+\]$/) {
+ $ref->[$last] = $value;
+ }
+ else {
+ $ref->{$last} = $value;
+ }
+ }
+
+ sub set_value {
+ return _set_walk($Vend::Session, @_);
+ }
+
+ sub value {
+ return _walk($Vend::Session, @_);
+ }
+
+ sub directive {
+ return _walk($Vend::Cfg, @_);
+ }
+
+ sub session_id {
+ return $Vend::SessionID;
+ }
+
+ sub session_name {
+ return $Vend::SessionName;
+ }
+
+ sub remote_addr {
+ my $in = shift
+ or return $CGI::remote_addr;
+ $CGI::remote_addr = $CGI::host = $in;
+ }
+
+ sub write_session {
+ Vend::Session::write_session();
+ }
+
+ sub init_session {
+ Vend::Session::init_session();
+ return $Vend::Session;
+ }
+
+ sub new_session {
+ Vend::Session::new_session();
+ }
+
+ sub put_session {
+ Vend::Session::put_session();
+ }
+
+ *uneval = \&Vend::Util::uneval;
+#::logDebug("external file is $Global::ExternalFile");
+#::logDebug("storable is $ENV{MINIVEND_STORABLE}, dumper= $ENV{MINIVEND_NO_DUMPER}, signals=$ENV{PERL_SIGNALS}");
+ unless(-r $Global::ExternalFile) {
+ logDebug "Cannot read $Global::ExternalFile.";
+ die "Cannot read $Global::ExternalFile.";
+ }
+#::logDebug("ready to read global");
+ $Vend::Global ||= Vend::Util::eval_file($Global::ExternalFile)
+ or die "eval_file failed (value=$Vend::Global): $!";
+#::logDebug("DID read global");
+ #logDebug(uneval($Vend::Global));
+ }
}
1;
More information about the interchange-cvs
mailing list