#!/usr/bin/perl -w
use strict;
use Cwd qw/abs_path/;
use CGI::Carp qw(fatalsToBrowser);
use CGI::Simple;
use File::Slurp;
use Data::Dumper;
use Text::Iconv;
use lib '../lib';
use WebPAC::DB;
use WebPAC::Output::TT;
my $abs_path = abs_path($0);
$abs_path =~ s#/[^/]*$#/../#;
my $db_path = $abs_path . '/db/';
my $template = 'html_ffzg.tt';
my $iconv_utf8 = new Text::Iconv('ISO-8859-2', 'UTF-8');
my $iconv_loc = new Text::Iconv('UTF-8', 'ISO-8859-2');
my $db = new WebPAC::DB(
path => $db_path,
read_only => 1,
debug => 1,
);
my $out = new WebPAC::Output::TT(
include_path => "$abs_path/conf/output/tt",
filters => { foo => sub { shift } },
);
my $q = new CGI::Simple;
my $self = $q->url( '-path_info'=>1, '-query'=>0, '-full'=>0 );
my $rec = $q->param('rec') || 1;
print $q->header( -charset => 'utf-8' );
if ($q->path_info =~ m#xml#) {
my @ds = $db->load_ds($rec);
if (@ds && $#ds > 0) {
print qq{
}, $iconv_utf8->convert( $out->apply(
template => $template,
data => \@ds,
) ), qq{
};
exit;
} else {
print qq{
Record $rec not found!
};
exit;
}
} elsif ($q->path_info =~ m#template#) {
my @actions;
if ($q->param('save_template')) {
my $tmpl = $iconv_loc->convert( $q->param('tt_template') ) || die "no template?";
sub _conv_js {
my $t = shift || return;
return $iconv_loc->convert(chr(hex($t)));
}
$tmpl =~ s/%u([a-fA-F0-9]{4})/_conv_js($1)/gex;
my $tmpl_file = $out->{'include_path'} . '/' . $template;
write_file($tmpl_file . '.new', $tmpl) || die "can't save $tmpl_file: $!";
rename $tmpl_file . '.new', $tmpl_file || die "can't rename to $tmpl_file: $!";
print qq{
$template saved
};
exit;
}
my $tmpl = read_file($out->{'include_path'} . '/' . $template) || die "can't read template $template: $!";
$tmpl = $q->escapeHTML($iconv_utf8->convert($tmpl));
print qq{
}, Dumper($q->Vars), qq{
};
exit;
} else {
print qq{
WebPAC simple browse interface
db_path = $db_path
template = $template
no template loaded yet.
no record loaded yet.
};
};