code/UI_Tag/run_profile.coretag

   1 # Copyright 2002-2009 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: run_profile.coretag,v 1.7 2009-01-26 09:49:11 racke Exp $
   9
  10 UserTag run-profile Order   check cgi profile name
  11 UserTag run-profile addAttr
  12 UserTag run-profile Version $Revision: 1.7 $
  13 UserTag run-profile Routine <<EOR
  14 sub {
  15         my ($check, $cgi, $profile, $name, $opt) = @_;
  16 #::logDebug("call check $check");
  17         my $ref;
  18         my $pname = $name;
  19
  20         if ($opt->{ref}) {
  21                 if (ref($opt->{ref}) eq 'HASH') {
  22                         $ref = $opt->{ref};
  23                 }
  24                 else {
  25                         # error message
  26                         ::logError("Invalid ref parameter provided for profile %s", $pname || $check);
  27                 }
  28         }
  29         elsif ($cgi) {
  30                 $ref = \%CGI::values;
  31         }
  32         else {
  33                 $ref = $::Values;
  34         }
  35
  36         unless ($pname) {
  37             # check scratch for profile if none specified
  38             $profile = $Scratch->{"profile_$check"} unless $profile;
  39
  40     #::logDebug("PROFILE(" . $Tag->var('MV_PAGE',1) . "):***$profile***");
  41             # test passes if no profile exists
  42             return 1 if ! $profile;
  43
  44             $opt->{no_error} = 1 unless defined $opt->{no_error};
  45
  46             $pname = 'tmp_profile.' . $Vend::Session->{id};
  47     #Debug("running check $check, pname=$pname profile=$profile");
  48             $profile .= "\n&fatal=1\n";
  49             $profile = "&noerror=1\n$profile" if $opt->{no_error};
  50             $profile = "&overwrite=1\n$profile" if $opt->{overwrite_error};
  51             $::Scratch->{$pname} = $profile;
  52         }
  53
  54         my ($status) = ::check_order($pname, $ref);
  55
  56         delete $::Scratch->{$pname} unless $name;
  57
  58         return is_yes($opt->{hide}) ? undef : $status;
  59 }
  60 EOR