git.sesse.net Git - pr0n/blob - perl/Sesse/pr0n/Templates.pm

   1 package Sesse::pr0n::Templates;
   2 use strict;
   3 use warnings;
   4
   5 use Sesse::pr0n::Common qw(error dberror);
   6
   7 BEGIN {
   8         use Exporter ();
   9         our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  10
  11         $VERSION     = 1.00;
  12         @ISA         = qw(Exporter);
  13         @EXPORT      = qw();
  14         %EXPORT_TAGS = qw();
  15         @EXPORT_OK   = qw();
  16 }
  17 our %dirs;
  18
  19 sub update_dirs {
  20         my $r = shift;
  21         my $base = $r->dir_config('TemplateBase');
  22         %dirs = ();
  23
  24         for my $dir (<$base/*>) {
  25                 next unless -d $dir;
  26                 $dir =~ m#/([^/]+)$#;
  27
  28                 warn "Templates exist for '$1'";
  29                 $dirs{$1} = {};
  30         }
  31 }
  32
  33 sub r_to_dir {
  34         my $r = shift;
  35
  36         if (!defined(%dirs)) {
  37                 update_dirs($r);
  38         }
  39
  40         my $site = $r->get_server_name();
  41         if (defined($dirs{$site})) {
  42                 return $site;
  43         } else {
  44                 return "default";
  45         }
  46 }
  47
  48 sub fetch_template {
  49         my ($r, $template) = @_;
  50
  51         my $dir = r_to_dir($r);
  52         my $cache = $dirs{$dir}{$template};
  53         if (defined($cache) && time - $cache->{'time'} <= 300) {
  54                 return $cache->{'contents'};
  55         }
  56
  57         my $newcache = {};
  58
  59         my $base = $r->dir_config('TemplateBase');
  60         open TEMPLATE, "<$base/$dir/$template"
  61                 or ($dir ne 'default' and open TEMPLATE, "<$base/default/$template")
  62                 or Sesse::pr0n::Common::error($r, "Couldn't open $dir/$template: $!");
  63
  64         local $/;
  65         $newcache->{'contents'} = <TEMPLATE>;
  66
  67         close TEMPLATE;
  68
  69         $newcache->{'time'} = time;
  70         $dirs{$dir}{$template} = $newcache;
  71         return $newcache->{'contents'};
  72 }
  73
  74 sub process_template {
  75         my ($r, $template, $args) = @_;
  76         my $text = fetch_template($r, $template);
  77
  78         # do substitutions
  79         while (my ($key, $value) = each (%$args)) {
  80                 $key = "%" . uc($key) . "%";
  81                 $text =~ s/$key/$value/g;
  82         }
  83
  84         return $text;
  85 }
  86
  87 sub print_template {
  88         my ($r, $template, $args) = @_;
  89         $r->print(process_template($r, $template, $args));
  90 }
  91
  92 1;
  93