package Apache::ClearSilver; use strict; use warnings; use Apache::Constants qw(:common); use Apache::ModuleConfig; use DynaLoader (); use ClearSilver; our $VERSION = '0.01'; if ($ENV{MOD_PERL}) { no strict; @ISA = qw(DynaLoader); __PACKAGE__->bootstrap($VERSION); } sub handler ($$) { my ($class, $r) = @_; my $cfg = Apache::ModuleConfig->get($r) || {}; $class->render($r, $cfg); } sub render { my ($class, $r, $cfg) = @_; my $hdf = $class->create_hdf($r, $cfg); return DECLINED unless $hdf; my $cs = ClearSilver::CS->new($hdf); unless ($cs->parseFile($r->filename)) { $r->log_reason("cannot parse file " . $r->filename . '.'); return DECLINED; } my $output = $cs->render; my $type = $cfg->{CSContentType} || 'text/html'; $r->content_type($type); $r->header_out('Content-Length' => length $output); $r->send_http_header; $r->print($output); return OK; } sub create_hdf { my ($class, $r, $cfg) = @_; my $hdf = ClearSilver::HDF->new; $cfg->{HDFLoadPath} ||= []; _hdf_setValue($hdf, 'hdf.loadpaths', $cfg->{HDFLoadPath}); for my $file (@{$cfg->{HDFFile}}) { my $ret = $hdf->readFile($file); unless ($ret) { $r->log_reason("cannot open file $file."); return; } } while (my ($key, $val) = each(%{$cfg->{HDFValue}})) { $hdf->setValue($key, $val); } my %query = $r->args; _hdf_setValue($hdf, 'Query', \%query); my $http = { Accept => $ENV{HTTP_ACCEPT} || '', AcceptEncoding => $ENV{HTTP_ACCEPT_ENCODING} || '', AcceptLanguage => $ENV{HTTP_ACCEPT_LANGUAGE} || '', Cookie => $ENV{HTTP_COOKIE} || '', Host => $ENV{HTTP_HOST} || '', UserAgent => $ENV{HTTP_USER_AGENT} || '', Referer => $ENV{HTTP_REFERER} || '', }; _hdf_setValue($hdf, 'HTTP', $http); my $cgi = { DocumentRoot => $ENV{DOCUMENT_ROOT} || '', QueryString => $ENV{QUERY_STRING} || '', RemoteAddress => $ENV{REMOTE_ADDR} || '', RemotePort => $ENV{REMOTE_PORT} || '', RequestMethod => $ENV{REQUEST_METHOD} || '', RequestURI => $ENV{REQUEST_URI} || '', ScriptFilename => $ENV{SCRIPT_FILENAME} || '', ScriptName => $ENV{SCRIPT_NAME} || '', ServerAddress => $ENV{SERVER_ADDR} || '', ServerAdmin => $ENV{SERVER_ADMIN} || '', ServerName => $ENV{SERVER_NAME} || '', ServerPort => $ENV{SERVER_PORT} || '', ServerProtocol => $ENV{SERVER_PROTOCOL} || '', ServerSoftware => $ENV{SERVER_SOFTWARE} || '', }; _hdf_setValue($hdf, 'CGI', $cgi); $hdf; } sub _hdf_setValue { my ($hdf, $key, $val) = @_; if (ref $val eq 'ARRAY') { my $index = 0; for my $v (@$val) { _hdf_setValue($hdf, "$key.$index", $v); $index++; } } elsif (ref $val eq 'HASH') { while (my ($k, $v) = each %$val) { _hdf_setValue($hdf, "$key.$k", $v); } } elsif (ref $val eq 'SCALAR') { _hdf_setValue($hdf, $key, $$val); } elsif (ref $val eq '') { $hdf->setValue($key, $val); } } sub HDFLoadPath($$@) { my ($cfg, $params, $arg) = @_; my $paths = $cfg->{HDFLoadPath} ||= []; push @$paths, $arg; } sub HDFFile($$@) { my ($cfg, $params, $arg) = @_; my $paths = $cfg->{HDFFile} ||= []; push @$paths, $arg; } sub HDFSetValue($$$$) { my ($cfg, $parms, $name, $value) = @_; $cfg->{HDFValue}->{$name} = $value; } sub CSContentType($$$) { my ($cfg, $params, $arg) = @_; $cfg->{CSContentType} = $arg; } 1; __END__ =head1 NAME Apache::ClearSilver - Apache/mod_perl interface to the ClearSilver template system. =head1 SYNOPSIS # add the following to your httpd.conf PerlModule Apache::Template # set various configuration options, e.g. HDFLoadPath /path/to/loadpath /path/to/anotherpath HDFFile /path/to/mydata.hdf /path/to/mydata2.hdf HDFSetValue Foo bar CSContentType "text/html; charset=utf-8" # now define Apache::Clearsilver as a PerlHandler, e.g. SetHandler perl-script PerlHandler Apache::Template =head1 DESCRIPTION Apache::ClearSilver is Apache/mod_perl interface to the ClearSilver template system. implementing ClearSilver CGI Kit. =head1 CONFIGURATION =over 4 =item HDFLoadPath added to hdf.loadpaths. =item HDFFile HDF Dataset files into the current HDF object. =item HDFSetValue set HDF value. =item CSContentType set Content-Type. (default text/html) =back =head1 AUTHOR Jiro Nishiguchi Ejiro@cpan.orgE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L ClearSilver Documentation: L =cut