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