view release on metacpan or  search on metacpan

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

use Apache::Util ();
use Compress::Zlib ();
use File::Find ();
use HTML::FillInForm ();
use HTML::Parser ();
use HTML::Entities ();
use HTML::Template ();
use Text::Iconv ();
use XML::LibXML ();

$| = 1;

# PageKit modules
use Apache::PageKit::Param ();
use Apache::PageKit::View ();
use Apache::PageKit::Content ();
use Apache::PageKit::Model ();
use Apache::PageKit::Config ();
use Apache::PageKit::Edit ();

use Apache::Constants qw(OK DONE REDIRECT DECLINED HTTP_NOT_MODIFIED);

use vars qw($VERSION);
$VERSION = '1.18';

%Apache::PageKit::DefaultMediaMap = (
				     pdf => 'application/pdf',
				     wml => 'text/vnd.wap.wml',
				     xml => 'application/xml');

# in httpd.conf file
sub startup {
  my ($class, $pkit_root, $server) = @_;

  my $s = Apache->server;

  if ( defined $mod_perl::VERSION && $mod_perl::VERSION >= 1.26 ) {
    $pkit_root ||= $s->dir_config('PKIT_ROOT')   || die "PKIT_ROOT is not defined! Put PerlSetVar PKIT_ROOT /your/root/path in your httpd.conf";
    $server    ||= $s->dir_config('PKIT_SERVER') || die "PKIT_SERVER is not defined! Put PerlSetVar PKIT_SERVER servername in your httpd.conf";
  } else {
    $pkit_root || die 'must specify $pkit_root variable in startup.  Usage: Apache::PageKit->startup($pkit_root, $server)';
    $server    || die 'must specify $server variable in startup.  Usage: Apache::PageKit->startup($pkit_root, $server)';
  }

  # get user and group as specified by User and Group directives
  my $uid = $s->uid;
  my $gid = $s->gid;

  # include user defined classes (Model) in perl search path
  unshift(@INC,"$pkit_root/Model");

  my $config_dir = $pkit_root . '/Config';

  my $config = Apache::PageKit::Config->new(config_dir => $config_dir,
					    server => $server);
  $config->parse_xml;

  die "No config data for your server '$server' maybe you mistyped something?"
    unless exists $Apache::PageKit::Config::server_attr->{$config_dir}->{$server};
    
  my $upload_tmp_dir = $config->get_global_attr('upload_tmp_dir');
  if ( $upload_tmp_dir && !-d $upload_tmp_dir ) {
    die "your upload_tmp_dir ($upload_tmp_dir) did not exists";
  }

  my $cache_dir = $config->get_global_attr('cache_dir');
  my $view_cache_dir = $cache_dir ? $cache_dir . '/pkit_cache' :
    $pkit_root . '/View/pkit_cache';

  unless(-e "$view_cache_dir"){
    mkdir $view_cache_dir, 0755;
  }

  # User defined base model class
  my $model_base_class = $config->get_global_attr('model_base_class') || "MyPageKit::Common";
  eval "require $model_base_class";
  if($@){
    die "Failed to load $model_base_class ($@)";
  }

  # User defined session class
  for ( qw /session_class page_session_class/ ) {
    my $user_session_class = $config->get_global_attr($_) || next;
    eval "require $user_session_class";
    $@ && die "Failed to load $user_session_class ($@)";
  }

  # User defined template toolkit class
  my $template_class = $config->get_global_attr('template_class');
  if ( $template_class ) {
    eval "require $template_class";
    $@ && die "Failed to load $template_class ($@)";
  }

  # delete all cache files, since some of them might be stale
  # and might not be checked for freshness, if reload is off
  # even if reload is on, PageKit might change, so it should be refreshed
  my $unlink_sub = sub {
    -f && unlink;
  };
  File::Find::find($unlink_sub,$view_cache_dir);

  # init gettext
  if (($config->get_global_attr('use_locale') || 'no') eq 'yes') {
    eval { require Locale::gettext };

    unless ($@) {

      # check for broken locale settings
      delete @ENV{qw/LANG LANGUAGE LC_ALL/};

      $ENV{LC_MESSAGES} = $config->get_global_attr('default_lang') || 'en';

      # ( my $textdomain ) = $config->get_global_attr('model_base_class') =~ m/^([^:]+)/;
      my $textdomain = 'PageKit';
      Locale::gettext::bindtextdomain($textdomain, $pkit_root . '/locale');
      Locale::gettext::textdomain($textdomain);
    }
    else {
      warn "Locale::gettext not installed ($@)";
    }
  }

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

  # call output filter, if applicable
  $model->pkit_output_filter($output_ref)
    if $model->can('pkit_output_filter');

  my ( $converted_data, $retcharset );
  if ($output_media eq 'text/html'){
    my $data;
    while (@charsets){
      $retcharset = (shift @charsets)->[0];
      last if ($retcharset eq $default_output_charset);
      eval {
        my $converter = Text::Iconv->new($default_output_charset, $retcharset);
        $converted_data = $converter->convert($$output_ref);
      };
      last if ($converted_data);
      $retcharset = undef;
    }

    ## here no action is needed, if we did not convert the data to anything usefull.
    ## we deliver in our default_output_charset.

    # correct the header
    $apr->content_type("text/html; charset=$retcharset") if ($retcharset);
    $apr->content_type("text/html; charset=$default_output_charset")    unless ($retcharset);
  }

  # only pages with propper $retcharset are tranfered gzipped.
  # this can maybe changed!? Needs some tests
  my $send_gzipped = ( $retcharset && $pk->{use_gzip} eq 'all' );
  $apr->content_encoding('gzip') if ($send_gzipped);

  $apr->send_http_header if $apr->is_main;


  if ($send_gzipped) {
    $apr->print(Compress::Zlib::memGzip($converted_data || $$output_ref));
  } else {
    $apr->print($converted_data || $$output_ref);
  }
}

sub new {
  my $class = shift;

  my $r = Apache->request;
  my $self = {@_};

  bless $self, $class;

  # set up contained objects
  my $pkit_root = $r->dir_config('PKIT_ROOT');
  die "Must specify PerlSetVar PKIT_ROOT in httpd.conf file" unless $pkit_root;
  my $config_dir = $pkit_root . '/Config';
  my $content_dir = $pkit_root . '/Content';
  my $view_dir = $pkit_root . '/View';
  my $server = $r->dir_config('PKIT_SERVER');
  die "Must specify PerlSetVar PKIT_SERVER in httpd.conf file" unless $server;
  my $config = $self->{config} = Apache::PageKit::Config->new(config_dir => $config_dir,
                                                              server => $server);
  my $post_max = $self->{config}->get_global_attr('post_max') || 100_000_000;
  my $upload_tmp_dir = $self->{config}->get_global_attr('upload_tmp_dir');

  # the TEMP_DIR option is only avail since version 1.0 of libapreq
  # so we set it only on request.
  my @apr_params = ();
  push @apr_params, TEMP_DIR => $upload_tmp_dir if $upload_tmp_dir;
  my $request_class = $self->{config}->get_global_attr('request_class') || "Apache::Request::PageKit";
  my $apr = $self->{apr} = $request_class->new($r, POST_MAX => $post_max, @apr_params);
  my $model_base_class = $self->{config}->get_global_attr('model_base_class') || "MyPageKit::Common";

  $self->_check_gzip;
  
  my $model;
  eval {$model = $self->{model} = $model_base_class->new(pkit_pk => $self)};
  if($@){
    unless($model_base_class){
      die "model_base_class not specified";
    } else {
      die "Model class $model_base_class has no new method ($@)";
    }
  }

  $self->{dbh} = $model->pkit_dbi_connect if $model->can('pkit_dbi_connect');

  my $default_lang = $config->get_global_attr('default_lang') || 'en';
  my $default_input_charset = $config->get_global_attr('default_input_charset') || 'ISO-8859-1';
  my $default_output_charset = $config->get_global_attr('default_output_charset') || 'ISO-8859-1';
  my $html_clean_level = $config->get_server_attr('html_clean_level') || 0;
  my $can_edit = $config->get_server_attr('can_edit') || 'no';
  my $reload = $config->get_server_attr('reload') || 'no';

  my $cache_dir = $config->get_global_attr('cache_dir');
  my $view_cache_dir = $cache_dir ? $cache_dir . '/pkit_cache' : $pkit_root . '/View/pkit_cache';
  my $relaxed_parser = $config->get_global_attr('relaxed_parser') || 'no';
  my $errorspan_begin_tag = $config->get_global_attr('errorspan_begin_tag') || q{<font color="<PKIT_ERRORSTR>">};
  my $errorspan_end_tag   = $config->get_global_attr('errorspan_end_tag')   || q{</font>};
  my $default_errorstr   = $config->get_global_attr('default_errorstr')   || '#ff0000';
  
  my $uri_prefix = $config->get_global_attr('uri_prefix') || '';

  my $template_class = $config->get_global_attr('template_class')
    || 'HTML::Template';
  my $view_class = $template_class =~ /^HTML::Template/ ? 'Apache::PageKit::View' : 'Apache::PageKit::View::TT2';
  $self->{view} = $view_class->new(
  					     root_dir => $pkit_root,
					     view_dir => "$pkit_root/View",
					     content_dir => "$pkit_root/Content",
					     cache_dir => $view_cache_dir,
					     default_lang => $default_lang,
					     default_input_charset => $default_input_charset,
					     default_output_charset => $default_output_charset,
					     reload => $reload,
					     html_clean_level => $html_clean_level,
					     input_param_object => $apr,
					     output_param_object => $self->{output_param_object},
					     can_edit => $can_edit,
                                             relaxed_parser => $relaxed_parser,
                                             errorspan_begin_tag => $errorspan_begin_tag,
                                             errorspan_end_tag => $errorspan_end_tag,
                                             default_errorstr => $default_errorstr,
                                             template_class => $template_class,

					     uri_prefix => $uri_prefix,

					     # used only to set browser_cache = '..' maybe another
					     # way to set browser_cache is better to leave the View