inc.pm

一个论文管理系统

# $Id: Inc.pm,v 1.11 2005/10/19 21:39:53 martin Exp $
#
# Copyright 2005 Nature Publishing Group
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# The Bibliotech::Component::Inc class provides the mechanism for include
# files to be called from templates.

package Bibliotech::Component::Inc;
use strict;
use base 'Bibliotech::Component';
use IO::File;
use Apache::Const qw(:common :http);

sub last_updated_basis {
  shift->operative_filename;
}

sub filename {
  my ($self, $r) = @_;
  die 'must pass in Apache::RequestRec object' unless UNIVERSAL::isa($r, 'Apache::RequestRec');
  return $r->filename.$r->path_info.'.inc';
}

sub check_filename {
  my ($self, $r) = @_;
  my $filename = $self->filename($r);
  return NOT_FOUND unless -e $filename;
  return FORBIDDEN unless -r $filename;
  return OK;
}

sub option_filename {
  my ($self, $filename) = @_;
  if ($filename =~ m|^//|) {
    $filename =~ s|^//|/|;
  }
  elsif ($filename =~ m|^/|) {
    $filename =~ s|^/||;
    $filename = $self->bibliotech->docroot.$filename.'.inc';
  }
  else {
    my $r = $self->bibliotech->request;
    (my $path = $r->filename.$r->path_info) =~ s|/([^/]*)$|/${filename}.inc|;
    $filename = $path;
  }
  return $filename;
}

sub operative_filename {
  my ($self) = @_;
  my $options = $self->options || {};
  my $filename = $self->option_filename($options->{filename}) if $options->{filename};
  $filename ||= $self->filename($self->bibliotech->request);
  return $filename;
}

sub html_content {
  my ($self, $class, $verbose, $main) = @_;

  my $bibliotech = $self->bibliotech;
  my $user = $bibliotech->user;
  my $user_id = $user ? $user->user_id : undef;
  my $filename = $self->operative_filename;

  my $cached = $self->memcache_check(class => __PACKAGE__, method => 'html_content', user => $user_id || 'visitor', id => $filename);
  return $cached if defined $cached;

  my $options = $self->options || {};
  my $doc;
  my $fh = new IO::File ($filename) or return Bibliotech::Page::HTML_Content->blank;
  { local $/ = undef; $doc = <$fh>; }
  $fh->close;
  my $inc = $bibliotech->replace_text_variables([$doc], $user, $options->{variables}, $options->{variables_code_obj})->[0];

  return $self->memcache_save(Bibliotech::Page::HTML_Content->simple($inc));
}

1;
__END__