view release on metacpan or  search on metacpan

lib/Apache/JAF.pm  view on Meta::CPAN

    $dir =~ s/\.pm$/\/pages\//;
    undef $dir unless -d $dir;
  } else {
    $dir .= '/' if $dir !~ /\/$/;
  }  

  if (defined $dir && -d $dir) {
    local %HANDLERS = ();
    File::Find::find({ wanted => \&_process_as_handler, no_chdir => 1 }, $dir);

    local $PACKAGE = qq{package $package; use strict;\n};
    my $line = 2;
    foreach my $file (keys %HANDLERS) {
      my $lines = $HANDLERS{ $file }{TEXT} =~ s/(\n)/$1/sg;
      $HANDLERS{ $file }{START} = $line;
      $HANDLERS{ $file }{END} = $line += $lines + 1;
      $PACKAGE .= $HANDLERS{ $file }{TEXT} . "\n";
    }
    $PACKAGE .= qq{\nour \$HANDLERS_LOADED=1;\n};

    $self && $self->warn(9, "Loading handlers for $package:\n $PACKAGE");
    eval $PACKAGE;

    if ($@) {
      (my $error = $@) =~ s/\(eval\s+\d+\)(\s+line\s+)(\d+)/
      do {
        my $replace = q{(can't find where...)};
        foreach my $file (keys %HANDLERS) {
          if ($HANDLERS{ $file }{START} <= $2 && $2 < $HANDLERS{ $file }{END}) {
            $replace = "($file)$1" . ($2 - $HANDLERS{ $file }{START} + 1);
            last;
          }
        }
        $replace;
      }
      /egx;

      $self && $self->warn(0, $error) || die $error;
    }
  }
}

# Load templates
################################################################################
our ($TEMPLATES, $PARSER);

sub _process_as_template {
  if (exists $TEMPLATES->{$_} && 
     (stat)[9] <= $TEMPLATES->{$_}{mtime} && 
     !$TEMPLATES->{$_}{error}) {
    return
  }

  if (-f && -r) {
    open IN, $_;
    my $text = do { local $/; <IN> };
    close IN;
    unless ($TEMPLATES->{$_}{code} = Template::Document->new( $PARSER->parse($text) )) {
      $TEMPLATES->{$_}{error} = $PARSER->error();
    } else {
      $TEMPLATES->{$_}{mtime} = (stat(_))[9];
    }
  }
}

sub load_templates {
  my ($self, $package, $dir, $reload) = @_;

  local $TEMPLATES = {};
  local $PARSER = Template::Parser->new();

  if ($reload) {
    no strict 'refs';
    $TEMPLATES = { %${ "${package}::TEMPLATES" } };
  }

  $dir ||= $self->{templates} if $self;
  if ($dir eq 'auto') {
    $dir = $INC{ do { (my $dummy = $package) =~ s/::/\//g; "$dummy.pm"; } };
    $dir =~ s/modules\/.*$/templates\//;
  }

  File::Find::find({ wanted => \&_process_as_template, no_chdir => 1 }, split $RX, $dir);

  { no strict 'refs';
    ${ "${package}::SELF_PROVIDER" } ||= 1;
    ${ "${package}::TEMPLATES" } = { ${ "${package}::TEMPLATES" } ? %${ "${package}::TEMPLATES" } : (), %${ 'TEMPLATES' } };
  }
}

sub fetch {
  my ($self, $name) = @_;
  my $ref;
  my $t = "${\( ref $self )}::TEMPLATES";
  { no strict 'refs';
    $ref = $$t;
  }
  foreach my $p (@{$self->paths()}) {
    my $full_name = "$p/$name";
    if (exists $ref->{$full_name}) {
      if ((stat($full_name))[9] > $ref->{$full_name}{mtime}) {
        load_templates(undef, ref $self, $p);
        no strict 'refs';
        $ref = $$t;
      }
      return wantarray ? ($ref->{$full_name}{code}, $ref->{$full_name}{error}) : $ref->{$full_name}{code};
    }
  }
  return (undef, undef);
}

# ABSTRACT: setup_handler must be implemented in derived 
# class to provide $self->{handler} property mandatory
################################################################################
sub setup_handler { $_[0]->warn(0, 'Abstract method call!') }

# Last modified
################################################################################
sub last_modified { time() }

# Cache
################################################################################
sub cache { undef }

# Log errors and warnings
################################################################################
sub warn { 
  my ($self, $level, $message) = @_;
  my $method = $level ? 'warn' : 'log_error';
  #
  # server_name included in warning string to distinguish different servers in
  # overall error log... (default behavior) 
  #
  $self->{r}->$method('[' . $self->{r}->get_server_name() . '] ' . $message) if $self->{debug_level} >= $level;
}

# Check template existance
################################################################################
sub _exists {
  my ($self, $dir, $name, $self_provider) = @_;
      
  return 0 unless $self_provider ? do { 
    no strict 'refs';
    my $t = "${\( ref $self )}::TEMPLATES";
    exists $$t->{"$dir/$name"};
  } : -f $dir . "/$name";

  $self->warn(1, 'Template: /' . $name);
  $self->{template} = $name;
  return 1
}

# Process template
################################################################################
sub process_template {
  my ($self) = @_;

  my $self_provider;
  { no strict 'refs'; $self_provider = ${ "${\( ref $self )}::SELF_PROVIDER" }; }
  local $Template::Config::PROVIDER = ref $self if $self_provider;
  local $Template::Config::STASH = 'Template::Stash::XS';