code/UserTag/component.tag

   1 # Copyright 2002-2007 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: component.tag,v 1.10 2009-05-01 13:50:00 pajamian Exp $
   9
  10 UserTag component Order     component
  11 UserTag component addAttr
  12 UserTag component NoReparse 1
  13 UserTag component Version   $Revision: 1.10 $
  14 UserTag component Routine   <<EOR
  15 sub {
  16         my ($name, $opt) = @_;
  17
  18         my %ignore = (
  19                 qw/
  20                         component    1
  21                         comp_table   1
  22                         comp_field   1
  23                         comp_cache   1
  24                         reparse      1
  25                         interpolate  1
  26                 /
  27         );
  28         my @override = grep ! $ignore{$_}, keys %$opt;
  29
  30         my $control = $::Control->[$::Scratch->{control_index}];
  31         for(grep $_ !~ /^comp(?:onent)?_?/, keys %$opt) {
  32                 $control->{$_} = $opt->{$_};
  33         }
  34
  35         $name ||= $control->{component};
  36         $name ||= $opt->{default};
  37
  38         if (! $name or $name eq 'none') {
  39                 # Increment control_index so empty component has no side effect
  40                 $::Scratch->{control_index}++;
  41                 return;
  42         }
  43
  44         my $t = $opt->{comp_table} || $::Variable->{MV_COMPONENT_TABLE} || 'component';
  45         my $ctab = $::Variable->{MV_COMPONENT_CACHE} || 'component_cache';
  46
  47         my $record;
  48         my $db = database_exists_ref($t);
  49         my $nocache;
  50
  51         if($db) {
  52                 if(my $when = $Vend::Session->{teleport}) {
  53                         $nocache = 1;
  54                         my $q = qq{
  55                                 SELECT code from $t
  56                                 WHERE  base_code = '$name'
  57                                 AND    expiration_date < $when
  58                                 AND    show_date >= $when
  59                                 ORDER BY show_date DESC
  60                         };
  61                         my $ary = $db->query($q);
  62                         if($ary and $ary->[0]) {
  63                                 $name = $ary->[0][0];
  64                         }
  65                 }
  66                 $record = $db->row_hash($name);
  67         }
  68
  69         $record ||= $opt;
  70
  71         my $body = $record->{comptext};
  72
  73         if(! length($body)) {
  74                 my $dir = $opt->{comp_dir}
  75                                 || $::Variable->{MV_COMPONENT_DIR}
  76                                 || 'templates/components';
  77                 $body = readfile("$dir/$name",undef,1);
  78         }
  79
  80         # Increment control_index so empty component has no side effect
  81         if (! length $body) {
  82                 $::Scratch->{control_index}++;
  83                 return;
  84         }
  85
  86         my $cache_it;
  87         my $cdb;
  88         my $now;
  89         my $crecord;
  90         if (
  91                 ! $nocache
  92                 and $record->{cache_interval}
  93                 and $cdb = database_exists_ref($ctab)
  94                 )
  95         {
  96                 $cache_it = $name;
  97
  98                 # Cache based not only on name, but control values specified
  99                 if($record->{cache_options}) {
 100                         my @opts = split /[\s,\0]+/, $record->{cache_options};
 101                         $cache_it .= '.';
 102                         $cache_it .= generate_key( join "\0", @{$control}{@opts});
 103                 }
 104
 105                 $crecord = $cdb->row_hash($cache_it) || {};
 106                 $now = time;
 107
 108                 my $exp = adjust_time($record->{cache_interval}, $crecord->{cache_time});
 109
 110                 if ($exp > $now) {
 111                         # Increment control_index as not done below
 112                         $::Scratch->{control_index}++;
 113                         return $crecord->{compcache};
 114                 }
 115         }
 116
 117         my $result = interpolate_html($body);
 118         $::Scratch->{control_index}++;
 119         if($cache_it) {
 120                 my $thing = {
 121                                                 compcache => $result,
 122                                                 cache_time => $now,
 123                                         };
 124                 $cdb->set_slice($cache_it, $thing);
 125         }
 126
 127         if($record->{output}) {
 128                 Vend::Interpolate::substitute_image(\$result)
 129                         unless $opt->{no_image_substitute};
 130                 $Tag->output_to($record->{output}, undef, $result);
 131                 return;
 132         }
 133         return $result;
 134 }
 135 EOR