view release on metacpan or  search on metacpan

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

=head1 DESCRIPTION

This module is responsible for managing the environment in which the
Apache::iNcom page will execute. It setups all the objects that will
be accessible to the pages through globals and also provides the
page with a bunch of utility functions. It also provides a bunch
of methods for managing the information associated with the request.


=head1 INITIALIZATION

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};

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

Returns the name of the current page relative to INCOM_PREFIX.

=cut

sub current {
    return $_[0]->{current_page};
}

=pod

=head2 previous

Returns the name of the previous page fetched by the user.

=cut

sub previous {
    return $_[0]->{last_page};
}

=pod

=head2 browser

Returns the user agent string sent by the user's browser.

=cut

sub browser {
    return $_[0]->{req_rec}->header_in( "User-Agent" );
}

=pod

=head2 remote_host

Returns the hostname of the user. This can be an IP address is
hostname resolution is turn off.

=cut

sub remote_host {
    return $_[0]->{req_rec}->connection->remote_host;

}

=pod

=head2 remote_ip

Returns the ip address of the user.

=cut

sub remote_ip {
    return $_[0]->{req_rec}->connection->remote_ip;
}

=pod

=head2 login ( $username, $password )

Invokes the C<login> methods of the UserDB and if the login succeeded,
the user will be associated with the current Session, and its informations
will be available on each subsequent requests until the user logout.

=cut

sub login {
    my ($self,$username,$password) = @_;

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

    my $user;
    if ( $user = $self->{userdb}->user_login( $username, $password ) ) {
	# The login succeeded
	# Update the session and save the user
	$self->{session}{_incom_logged_in} = $user->{uid};

	$user->{last_login} = time;
	$user->{last_host}  = $self->remote_host || $self->remote_ip;
	$user->{visits} ||= 0;
	$user->{visits}++;

	$self->{userdb}->user_update( $user );

	# Create the user session
	$self->{session}{_incom_user_session} = {};
	$self->{user} = $user;
    }

    return $user;
}

=pod

=head2 logout

Removes the association between the user and the request.

=cut

sub logout {
    my $self	    = shift;

    # Throw an exception if the UserDB feature was turn off.
    croak "logout called when INCOM_USERDB_PROFILE set to NONE"
      unless $self->{userdb};

    my $save_cart   = shift;
    if ( exists $self->{user} ) {
	delete $self->{user};
	delete $self->{session}{_incom_logged_in};
	delete $self->{session}{_incom_user_session};
    }
}

# We need to use globals for the magic 
# symbol table manipulation, because
# Include files remember the state 
# of lexical variable -> closure.
use vars qw( $DB %Session %UserSession $package $Cart $Request $UserDB
	     $Validator $Order $Locale $Localizer ); #)

BEGIN {
    push @EXPORT_OK, qw( $package );
    $EXPORT_TAGS{globals} = [ qw( $DB %Session %UserSession $Cart $Request 
				  $UserDB $Validator $Order $Locale
				  $Localizer ) ];
    $EXPORT_TAGS{functions} = [ qw( Localize Currency Include
				     TextInclude QueryArgs ) ];

    Exporter::export_ok_tags( 'globals' );
    Exporter::export_ok_tags( 'functions' );
}