view release on metacpan or  search on metacpan

lib/Apache2/PageKit/Model.pm  view on Meta::CPAN

sub pnotes {
  my $model = shift;
  my $apr = $model->{pkit_pk}->{apr};
  if($apr->can('pnotes')){
    $apr->pnotes(@_);
  } else {
    # if running outside of mod_perl
    return $model->{pkit_pk}->{pnotes_param_object}->param(@_);
  }
}

# put here so that it can be overriden in derived classes
sub pkit_get_default_page {
  return shift->{pkit_pk}->{config}->get_global_attr('default_page') || 'index';
}

sub create {
  my ($model, $class) = @_;
  my $create_model = $class->new(pkit_pk => $model->{pkit_pk});
  return $create_model;
}

# this is experimental and subject to change
sub dispatch {
  warn "dispatch is depreciated - use create instead";
  my ($model, $class, $method, @args) = @_;
  my $dispatch_model = $class->new(pkit_pk => $model->{pkit_pk});
#  $dispatch_model->{pkit_pk} = $model->{pkit_pk} if exists $model->{pkit_pk};
  no strict 'refs';
  return &{$class . '::' . $method}($dispatch_model, @args);
}

sub dbh {
  my $model = shift;
  if (exists $model->{pkit_pk}->{dbh}){
    return $model->{pkit_pk}->{dbh};
  } else {
    unless ( defined($Apache2::PageKit::Model::dbh) && $Apache2::PageKit::Model::dbh->ping ) {
      $Apache2::PageKit::Model::dbh = $model->pkit_dbi_connect if $model->can('pkit_dbi_connect');
    }
    return $Apache2::PageKit::Model::dbh;
  }
}

sub apr {return shift->{pkit_pk}->{apr};}
# undocumented
sub config {return shift->{pkit_pk}->{config};}
sub session {return shift->{pkit_pk}->{session};}
sub page_session { return shift->{pkit_pk}->{page_session}; }

sub pkit_redirect {
  my ($model, $url) = @_;
  my $pk = $model->{pkit_pk};
  my $apr = $pk->{apr};
  
  # we may have created a new session. Add a cookie header if needed
  $pk->set_session_cookie;
  
  if(my $pkit_messages = $model->output('pkit_messages')){
    my $add_url = join("", map { "&pkit_" . ($_->{pkit_is_error} ? "error_" : "") . "messages=" . Apache2::Util::escape_path( $_->{pkit_message}, $apr->pool ) } @$pkit_messages);
    $add_url =~ s!^&!?! unless $url =~ m/\?/;
    $url .= $add_url;
  }
  $apr->headers_out->set(Location => $url);
  $pk->{status_code} = REDIRECT;
}

sub pkit_merge_sessions {
  my ($model, $old_session, $new_session) = @_;
  while(my ($k, $v) = each %$old_session){
    next if $k eq '_session_id';
    $new_session->{$k} = $v unless exists $new_session->{$k};
  }
}

sub pkit_gettext_message {
  my ( $model, $text ) = splice(@_, 0, 2);
  return $model->pkit_message($model->pkit_gettext($text), @_);
}

sub pkit_gettext {
  my ( $model, $text ) = @_;
  my $config = $model->config;
  my $use_locale = $config->get_global_attr('use_locale') || 'no';
  return $text if ( !exists &Locale::gettext::gettext || $use_locale ne 'yes' );
  unless ( $model->pnotes('pkit_env_lang_is_set') ) {
    $model->pnotes('pkit_env_lang_is_set' => 1);
    $ENV{LC_MESSAGES} = $model->{pkit_pk}->{lang} || 'en';

    # notice changes in the .mo file if reload eq 'yes'
    my $reload = $config->get_server_attr('reload') || 'no';
    if ( $reload eq 'yes' ) {
      #my ( $textdomain ) = $config->get_global_attr('model_base_class') =~ m/^([^:]+)/;
      my $textdomain = 'PageKit';
      Locale::gettext::textdomain($textdomain);
    }
  }
  return Locale::gettext::gettext($text);
}

sub pkit_query {
  my ($model, @p) = @_;
  my $pk = $model->{pkit_pk};
  my $view = $pk->{view};

  # will need to change once Template-Toolkit is supported
  unless(exists $view->{record}){
    $pk->open_view;
  }

  return $view->{record}->{html_template}->query(@p);
}

# $media_type and $content_encoding is optional
# $ref_or_fname can be a ref to a filenhandle, a ref to a scalar or a scalar,
# that holds the filename
sub pkit_send {
  my ($model, $ref_or_fname, $media_type, $content_encoding) = @_;

  my $type = ref $ref_or_fname;