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.9 2007-03-30 23:40:56 pajamian Exp $ 9 10UserTag component Order component 11UserTag component addAttr 12UserTag component NoReparse 1 13UserTag component Version $Revision: 1.9 $ 14UserTag component Routine <<EOR 15sub { 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 $secs = $record->{cache_interval} =~ /\D/ 109 ? time_to_seconds($record->{cache_interval}) 110 : $record->{cache_interval}; 111 my $exp = $crecord->{cache_time} + $secs; 112 113 if ($exp > $now) { 114 # Increment control_index as not done below 115 $::Scratch->{control_index}++; 116 return $crecord->{compcache}; 117 } 118 } 119 120 my $result = interpolate_html($body); 121 $::Scratch->{control_index}++; 122 if($cache_it) { 123 my $thing = { 124 compcache => $result, 125 cache_time => $now, 126 }; 127 $cdb->set_slice($cache_it, $thing); 128 } 129 130 if($record->{output}) { 131 Vend::Interpolate::substitute_image(\$result) 132 unless $opt->{no_image_substitute}; 133 $Tag->output_to($record->{output}, undef, $result); 134 return; 135 } 136 return $result; 137} 138EOR 139