view release on metacpan or  search on metacpan

Wyrd/Site/Page.pm  view on Meta::CPAN

	} else {
		#We don't know the state.  Read it off of the defaults
		$self->{'_state'}->[$self->{'_state_counter'}] = $self->_read_widget_state($widget);
	}
	$self->{'_state_counter'}++;
}

=pod

=item (void) C<_read_widget_state> (void)

The function by which each widget is assigned widget controls and records which values those widget
controls have.  Additionally, what encoding the widget controls will pass as CGI variables in order
to manipulate their respective widget's state are generated during this attribute/value permutation
count.

=cut

sub _read_widget_state {
	my ($self, $widget) = @_;
	my @state = ();
	my %attr = ();
	my %this_attr = ();
	my $attr_counter = 1;
	#Go through each child (Apache::Wyrd::Site::WidgetControl) of the widget
	foreach my $child (@{$widget->{'_children'}}) {
		#keep track of which attribute number it is, since this will need to be translated
		unless ($attr{$child->{'attribute'}}) {
			$attr{$child->{'attribute'}} = $attr_counter++;
		}
		#If the attribute value is not yet initialized, use the value of the widget control
		$widget->{$child->{'attribute'}} ||= $child->{'value'};
		#If one child is the "default", i.e. flagged default, that value overrides the first-value-found above
		$widget->{$child->{'attribute'}} = $child->{'value'} if ($child->_flags->default);
		#if the current value of the attribute matches the value of the widget control, the state of the
		#widget control is set to "on".
		if ($widget->{$child->{'attribute'}} eq $child->{'value'}) {
			$state[$attr{$child->{'attribute'}} - 1] = $this_attr{$child->{'attribute'}};
			$child->{'_on'} = 1;
		}
		#give the child a "name" it passes via link to a newly loaded page.  The name is the encoding of the
		#current state plus the new encoding for the value to be changed.  At this point, the page state is not
		#built, so the placemarker for the page is used for the first portion (up to the :) of the link.
		$child->{'_switch'} =  $self->{'_state_counter'}
							 . ':'
							 . $self->_state_symbol($attr{$child->{'attribute'}} - 1)
							 . $self->_state_symbol($this_attr{$child->{'attribute'}});
		#and increment the attribute counter for the next widgetcontrol.
		$this_attr{$child->{'attribute'}}++;
	};
	return \@state
}

=item (scalar) C<_check_auth> (void)

Examine the allow/deny state of the page and determine whether the user has the
clearance to view the page.  These interact with Apache::Wyrd::User-derived
objects using the Apache::Wyrd::Services::Auth conventions to determine the
user's current authorization levels.  If the page is forbidden to the public, it
will use the dir_config value "UnauthURL" to direct them to an "unauthorized
page", presumably to be prompted to log in, or failing the existence of that,
simply return an error message.

=cut


sub _check_auth {
	my ($self) = @_;
	#warn 'here, authorizing with an allow of ' . $self->{'allow'};
	if ($self->{'allow'}) {
		return undef if($self->_override_auth_conditions);
		unless ($self->dbl->user->username) {
			#warn 'here, about to ask for a redirect';
			my $hash = $self->_auth_hash;
			while (my ($key, $value) = each %$hash) {
				$self->dbl->req->dir_config->add($key, $value);
			}
			#$self->dbl->req->dir_config->add('AuthLevel', $self->{'allow'});
			$self->abort('request authorization');
			die "abort failed.";
		}
		if ($self->dbl->user->auth($self->{'allow'}, $self->{'deny'})) {
			return;
		}
		my $redirect = $self->dbl->req->dir_config('UnauthURL');
		if ($redirect) {
			$self->abort($redirect);
			die "abort failed.";
		}
		$self->_data($self->_unauthorized_text);
	}
	#warn 'here about tor return from check_auth';
	return;
}

=item (scalar) C<_override_auth_conditions> (void)

Override the default authorization behavior.  The default behavior is to check
the id against the dir_config values for "trusted_ipaddrs", a
whitespace-separated list.

=cut

sub _override_auth_conditions {
	my ($self) = @_;
	my $addrs = $self->dbl->req->dir_config('trusted_ipaddrs');
	return 0 unless ($addrs);
	my @trusted_ips = split /\s+/, $addrs;
	my $ip = $self->dbl->req->connection->remote_addr;
	return 1 if (grep {$_ eq $ip} @trusted_ips);
	return 0;
}

=item (scalar) C<_unauthorized_text> (void)

The error message to be returned when no UnauthURL is set.

=cut

sub _unauthorized_text {
	my ($self) = @_;