view release on metacpan or  search on metacpan

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

  return $href if ( $section =~ /^(?:PAGE|VIEW|SECTION)S$/ );
  
  if ( $section =~ /^(?:PAGE|VIEW|SECTION)$/ ) {
    return undef unless $page_or_view_id;
    unless ( exists $href->{$page_or_view_id} ) {
      $href->{$page_or_view_id} = {};
    }
    $href = $href->{$page_or_view_id};
  } else {
    $key = $page_or_view_id;
  }
  return ( $key and $href ) ? $href->{$key} : $href;
}

sub pkit_get_session_id {
  my $model = shift;
  my $obj = tied(%{$model->{pkit_pk}->{session}});
  return $obj ? $obj->getid : undef;
}

sub pkit_get_page_session_id {
  my $model = shift;
  my $page_session = $model->{pkit_pk}->{page_session};
  return tied(%$page_session)->getid if $page_session;
}

# returns value of PerlSetVar PKIT_SERVER from httpd.conf
sub pkit_get_server_id {
  my $model = shift;
  my $apr = $model->{pkit_pk}->{apr};
  return $apr->dir_config('PKIT_SERVER') if $apr;
}

sub pkit_root {
  my $model = shift;
  my $apr = $model->{pkit_pk}->{apr};
  return $apr->dir_config('PKIT_ROOT') if $apr;
}

sub pkit_get_orig_uri {
  my $model = shift;
  return $model->{pkit_pk}->{apr}->notes('orig_uri');
}

sub pkit_get_page_id {
  my $model = shift;
  return $model->{pkit_pk}->{page_id};
}

sub pkit_lang {
  my $model = shift;
  return $model->{pkit_pk}->{lang};
}

sub pkit_user {
  my $model = shift;
  return $model->{pkit_pk}->{apr}->connection->user;
}

sub pkit_set_errorfont {
  my ( $model, $field, $color_str) = @_;
  $color_str ||= $model->pkit_get_config_attr( GLOBAL => 'default_errorstr' ) || "#ff0000";
  my $begin_name = "PKIT_ERRORSPAN_BEGIN_$field";
  my $begin_value = $model->pkit_get_config_attr( GLOBAL => 'errorspan_begin_tag' ) || qq{<font color="$color_str">};
  $begin_value =~ s/<(!--)?\s*PKIT_ERRORSTR\s*(?(1)--)>/$color_str/gi;
  my $end_name = "PKIT_ERRORSPAN_END_$field";
  my $end_value = $model->pkit_get_config_attr( GLOBAL => 'errorspan_end_tag' ) || q{</font>};
  
  $model->output($begin_name => $begin_value);
  $model->output($end_name => $end_value);
}

# for now both are the same this may change.
# but only pkit_set_errorspan should change.
*pkit_set_errorspan = \&pkit_set_errorfont;

sub pkit_validate_input {
  my ($model, $input_profile) = @_;

  my $messages = delete $input_profile->{messages};

  my $validator = Data::FormValidator->new({default => $input_profile});

  # put the data from input into a %fdat hash so Data::FormValidator can read it
  my $input_hashref = $model->pkit_input_hashref;

  # put derived Model object in pkit_model
  # so form validation can access $dbh, etc
  # this is used, for example, to see if a login already exists
  $input_hashref->{'pkit_model'} = $model;

  my ($valids, $missings, $invalids, $unknowns) = $validator->validate($input_hashref, 'default');
  
  # put our messages back into the hash...  
  $input_profile->{messages} = $messages if defined $messages;

  # used to change apply changes from filter to apr
  while (my ($key, $value) = each %$valids){
    # if multiple request param, don't set, since formvalidator doesn't deal
    # with them yet
    $model->input($key,$value) unless ref($input_hashref->{$key}) eq 'ARRAY';
  }

  # used to change undef values to "", in case db field is defined as NOT NULL
  for my $field (keys %$input_hashref){
    $valids->{$field} ||= "";
  }

  for my $field (@$missings, @$invalids){
    $model->pkit_set_errorspan($field);
  }
  if(@$invalids || @$missings){
    if(@$invalids){
      foreach my $field (@$invalids){
	next unless exists $messages->{$field};
	my $value = $input_hashref->{$field};
	# gets error message for that field which was filled in incorrectly
	my $msg = $messages->{$field};

        $msg = $model->pkit_gettext($msg);

	# substitutes the value the user entered in the error message
	$msg =~ s/\%\%VALUE\%\%/$value/g;
	$model->pkit_message($msg, is_error => 1);
      }
      $model->pkit_gettext_message('Please try again.', is_error => 1);
    } else {
      # no invalid data, just missing fields
      $model->pkit_gettext_message(qq{You did not fill out all the required fields. Please fill the <font color="<PKIT_ERRORSTR>">red</font> fields.});
    }
    return;
  }
  if ($valids){
    return 1;
  }
}

sub pkit_component_params_hashref {
  return $_[0]->{pkit_pk}->{component_params_hashref};
}

sub pkit_input_hashref {
  my $model = shift;
  return $model->{pkit_input_hashref} if
    exists $model->{pkit_input_hashref};
  my $input_hashref = {};
  for my $key ($model->input){
    # we expect param to return an array if there are multiple values
    my @v = $model->input($key);
    $input_hashref->{$key} = scalar(@v)>1 ? \@v : $v[0];
  }
  $model->{pkit_input_hashref} = $input_hashref;
}

sub pkit_message {
  my $model = shift;
  my $message = shift;

  my $options = {@_};

  # translate from default_input_charset to default_output_charset if needed
  my $view = $model->{pkit_pk}->{view};
  my $input_charset = $view->{default_input_charset};
  my $default_output_charset = $view->{default_output_charset};
  if ($input_charset ne $default_output_charset) {
    my $converter = eval { Text::Iconv->new($input_charset, $default_output_charset) };
    if ($@) {
      die "Charset $input_charset or $default_output_charset not supported by Text::Iconv";
    }
    $message = $converter->convert($message) || die "Can not convert page from $input_charset to $default_output_charset" if $message;
  }

  my $default_error_str = $model->pkit_get_config_attr( GLOBAL => 'default_errorstr' ) || "#ff0000";
  $message  =~ s/<(!--)?\s*PKIT_ERRORSTR\s*(?(1)--)>/$default_error_str/gi;

  my $array_ref = $model->output('pkit_messages') || [];
  push @$array_ref, {pkit_message  => $message,
		    pkit_is_error  => $options->{'is_error'}};

  $model->output('pkit_messages',$array_ref);
}

sub pkit_internal_redirect {
  my ($model, $page_id) = @_;

  for ( $page_id ) {
    s!^\w+://+[^/]+!!; # strip proto and host
    s!\?.*$!!;         # strip parameters
    s!^/+!!;           # and leading /'s