view release on metacpan or  search on metacpan

lib/Apache/iNcom/Request.pm  view on Meta::CPAN

An object is automatically initialized on each request by the
Apache::iNcom framework. It is accessible through the $Request global
variable in Apache::iNcom pages.

=cut

sub new {
    my $proto	= shift;
    my $class	= ref $proto || $proto;

    my $req_rec = shift;
    my $package = shift;

    my $self = { req_rec => $req_rec,
		 package => $package,
	       };
    bless $self, $class;

    $self->{session}	     = $req_rec->pnotes( "INCOM_SESSION" );
    $self->{dbh}	     = $req_rec->pnotes( "INCOM_DBH" );

    my $root		    = $req_rec->dir_config( "INCOM_ROOT" );
    $root		    = $req_rec->server_root_relative( $root );
    my ($current)	    = $req_rec->filename =~ m!^$root/*(.*)!;
    $self->{current_page}   = $current;
    $self->{last_page}	    = $self->{session}{_incom_last_page};

    # Save current for next session
    $self->{session}{_incom_last_page} = $current;

    # Setup the database object
    my $sql_profile = $req_rec->dir_config( "INCOM_SEARCH_PROFILE" )
      || "conf/search_profiles.pl";
    unless ( $sql_profile eq "NONE" ) {
	$sql_profile = $req_rec->server_root_relative( $sql_profile );
	$self->{database} = new DBIx::SearchProfiles( $self->{dbh},
						      $sql_profile );

	# Setup the UserDB object
	my $userdb_tmpl = $req_rec->dir_config( "INCOM_USERDB_PROFILE" );
	unless ( $userdb_tmpl eq "NONE" ) {
	    $self->{userdb} = new DBIx::UserDB( $self->{database}, 
						$userdb_tmpl,
						$req_rec->dir_config( "INCOM_GROUPDB_PROFILE" ) );

	    my $scramble = $req_rec->dir_config( "INCOM_SCRAMBLE_PASSWORD" );
	    if ( defined $scramble ) {
		$scramble = $scramble =~ /t(rue)?|1|on|y(es)?/i;
		$self->{userdb}->scramble_password( $scramble );
	    }

	    # Load it if the user has logged into this session
	    if ( exists $self->{session}{_incom_logged_in} ) {
		$self->{user} =
		  $self->{userdb}->user_get( $self->{session}{_incom_logged_in} );
	    }
	}
    }

    # Setup validator object
    my $input_profile = $req_rec->dir_config( "INCOM_INPUT_PROFILE" )
      || "conf/input_profiles.pl";
    unless ( $input_profile eq "NONE" ) {
	$input_profile = $req_rec->server_root_relative( $input_profile );

	$self->{validator} = new HTML::FormValidator( $input_profile );
    }

    # Setup the cart object
    my $price_profile = $req_rec->dir_config( "INCOM_PRICING_PROFILE" )
      ||  "conf/pricing_profile.pl";
    unless ( $price_profile eq "NONE" ) {
	$price_profile = $req_rec->server_root_relative( $price_profile );
	$self->{cart} = new Apache::iNcom::CartManager( $self->{session}{_incom_cart},
							$package,
							$price_profile );

	# Make sure the session contains the cart references
	# (In case it wasn't present)
	$self->{session}{_incom_cart} = $self->{cart}->cart();
    }

    # Setup order manager object
    my $order_profile = $req_rec->dir_config( "INCOM_ORDER_PROFILE" )
      ||  "conf/order_profiles.pl";
    unless ( $order_profile eq "NONE" ) {
	$order_profile = $req_rec->server_root_relative( $order_profile );
	$self->{order} = new Apache::iNcom::OrderManager( $self->{database},
							  $order_profile,
							  $self,
							);

    }

    $self;
}

=pod

=head2 logged_in

Returns true if the request is associated with a UserDB's user.

=cut

sub logged_in {
    # Throw an exception if the UserDB feature was turn off.
    croak "logged_in called when INCOM_USERDB_PROFILE set to NONE"
      unless $_[0]->{userdb};
    return defined $_[0]->{user};
}

=pod

=head2 user

Returns the UserDB's user associated with the current request.

=cut

sub user {