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 = $Sesse::pr0n::Config::template_base;
  22
  23         for my $dir (<$base/*>) {
  24                 next unless -d $dir;
  25                 $dir =~ m#/([^/]+)$#;
  26
  27                 warn "Templates exist for '$1'";
  28                 $dirs{$1} = {};
  29         }
  30 }
  31
  32 sub r_to_dir {
  33         my $r = shift;
  34
  35         if (scalar(keys %dirs) == 0) {
  36                 update_dirs($r);
  37         }
  38
  39         my $site = Sesse::pr0n::Common::get_server_name($r);
  40         if (defined($dirs{$site})) {
  41                 return $site;
  42         } else {
  43                 return "default";
  44         }
  45 }
  46
  47 sub fetch_template {
  48         my ($r, $template) = @_;
  49
  50         my $dir = r_to_dir($r);
  51         my $cache = $dirs{$dir}{$template};
  52         if (defined($cache) && time - $cache->{'time'} <= 300) {
  53                 return $cache->{'contents'};
  54         }
  55
  56         my $newcache = {};
  57
  58         my $base = $Sesse::pr0n::Config::template_base;
  59         open TEMPLATE, "<:utf8", "$base/$dir/$template"
  60                 or ($dir ne 'default' and open TEMPLATE, "<$base/default/$template")
  61                 or Sesse::pr0n::Common::error($r, "Couldn't open $dir/$template: $!");
  62
  63         local $/;
  64         $newcache->{'contents'} = <TEMPLATE>;
  65
  66         close TEMPLATE;
  67
  68         $newcache->{'time'} = time;
  69         $dirs{$dir}{$template} = $newcache;
  70         return $newcache->{'contents'};
  71 }
  72
  73 sub process_template {
  74         my ($r, $template, $args) = @_;
  75         my $text = fetch_template($r, $template);
  76
  77         # do substitutions
  78         while (my ($key, $value) = each (%$args)) {
  79                 $key = "%" . uc($key) . "%";
  80                 $text =~ s/$key/$value/g;
  81         }
  82
  83         return $text;
  84 }
  85
  86 sub print_template {
  87         my ($r, $io, $template, $args) = @_;
  88         $io->print(Encode::encode_utf8(process_template($r, $template, $args)));
  89 }
  90
  91 1;
  92