XAO-Web
view release on metacpan or search on metacpan
use XAO::Web;
my $web=XAO::Web->new(sitename => 'test');
$web->execute(cgi => $cgi,
path => '/index.html');
my $config=$web->config;
$config->clipboard->put(foo => 'bar');
=head1 DESCRIPTION
Please read L<XAO::Web::Intro> for general overview and setup
instructions, and please read L<XAO::DO::Web::Page> for an overview
of the templating system. Check also misc/samplesite for code examples
and a generic site setup.
XAO::Web module provides a frameworks for loading site configuration and
executing objects and templates in the site context. It is used in
=over
=item hash
Hash object is primarily used to keep site configuration parameters. It
is just a XAO::SimpleHash object and most of its methods get embedded -
get, put, getref, delete, defined, exists, keys, values, contains.
=item web
Web configuration embeds methods that allow cookie, clipboard and
cgi manipulations -- add_cookie, cgi, clipboard, cookies, header,
header_args.
=back
After that XAO::Web calls init() method on the Config object which
is supposed to finish configuration set up and usually stuffs some
parameters into 'hash', then connects to a database and embeds database
configuration object into the Config object as well. Refer to
L<XAO::Web::Intro> for an example of site specific Config object and
init() method.
Methods of XAO::Web objects include:
=over
=cut
###############################################################################
sub analyze ($$;$$);
sub clipboard ($);
sub config ($);
sub execute ($%);
sub new ($%);
sub set_current ($);
sub sitename ($);
###############################################################################
=item analyze ($;$$)
objname => 'Default',
path => $path,
patharr => $patharr,
fullpath => $path,
prefix => ''
};
}
###############################################################################
=item clipboard ()
Returns site clipboard object.
=cut
sub clipboard ($) {
my $self=shift;
return $self->config->clipboard;
}
###############################################################################
=item config ()
Returns site configuration object reference.
=cut
if($e->isa('APR::Error')) {
$e=Error::Simple->new("$e");
}
$self->config->header_args(
-Status => '500 Internal Error',
-expires => 'now',
-cache_control => 'no-cache',
);
my $edata=$self->clipboard->get('/internal_error') || { };
my $path=$edata->{'display_path'} || '/internal-error/index.html';
my $pd=$self->analyze($path);
if($pd && $pd->{'type'} eq 'xaoweb' && $pd->{'objname'} ne 'Default') {
eprint "$e";
$edata->{'message'}||="$e";
$edata->{'code'}||='UNKNOWN';
$edata->{'path'}||=$args->{'path'};
$edata->{'pagedesc'}||=$self->clipboard->get('pagedesc');
$self->clipboard->put(internal_error => $edata);
$pagetext=$self->process($args,{
path => $path,
template => undef,
pagedesc => $pd,
});
}
else {
XAO::Utils::set_logprint_handler($old_logprint_handler) if $old_logprint_handler;
throw $e;
sub _expand_list ($$) {
my ($self,$autolist)=@_;
my $content='';
if(!$autolist) {
return '';
}
elsif(ref($autolist) eq 'ARRAY') {
my $clipboard=$self->config->clipboard;
for(my $i=0; $i<@$autolist; $i+=2) {
my ($objname,$objargs)=@{$autolist}[$i,$i+1];
my $obj=XAO::Objects->new(objname => $objname);
$content.=$obj->expand($objargs);
# Not processing any more if there was a final output.
#
last if $clipboard->get('_no_more_output');
}
}
elsif(ref($autolist) eq 'HASH') {
eprint "Using HASH auto-list is deprecated, use an ordered array";
foreach my $objname (keys %{$autolist}) {
my $obj=XAO::Objects->new(objname => $objname);
$content.=$obj->expand($autolist->{$objname});
}
}
else {
-- for normal situations either expand() or execute() methods should be
called.
=cut
sub process ($%) {
my $self=shift;
my $args=get_args(\@_);
my $siteconfig=$self->config;
my $clipboard=$siteconfig->clipboard;
my $sitename=$self->sitename;
# Making sure path starts from a slash
#
my $path=$args->{'path'} || throw XAO::E::Web "process - no 'path' given";
$path='/' . $path;
$path=~s/\/{2,}/\//g;
# Resetting page text stack in case it was terminated abnormally
# before and we're in the same process/memory.
$active_url='http:' . $1;
$active_is_secure=1;
}
else {
dprint "Wrong active URL ($active_url)";
$active_url_secure=$active_url;
}
# Storing active URLs
#
$clipboard->put(active_url => $active_url);
$clipboard->put(active_url_secure => $active_url_secure);
# Checking if we have base_url, assuming active_url if not.
# Ensuring that URL does not end with '/'.
#
if($siteconfig->defined('base_url')) {
my $url=$siteconfig->get('base_url');
$url=~/^http:/i ||
throw XAO::E::Web "- bad base_url ($url) for sitename=$sitename";
my $nu=$url;
chop($nu) while $nu =~ /\/$/;
}
else {
$siteconfig->put(base_url => $active_url);
$siteconfig->put(base_url_secure => $active_url_secure);
dprint "No base_url for sitename '$sitename'; assuming base_url=$active_url, base_url_secure=$active_url_secure";
}
# Checking if we're running under mod_perl
#
my $mod_perl=($apache || $ENV{'MOD_PERL'}) ? 1 : 0;
$clipboard->put(mod_perl => $mod_perl);
$clipboard->put(mod_perl_request => $apache);
# Checking if a charset is known for the site. If it is, setting
# it up for CGI-params decoding and for output.
#
my $charset=$siteconfig->get('charset');
if($charset) {
if($cgi->can('set_param_charset')) {
$cgi->set_param_charset($charset);
}
else {
# Separator for the error_log :)
#
if(XAO::Utils::get_debug() && !$args->{'quieter'}) {
my @d=localtime;
my $date=sprintf("%02u:%02u:%02u %u/%02u/%04u",$d[2],$d[1],$d[0],$d[4]+1,$d[3],$d[5]+1900);
undef(@d);
dprint "============ date=$date, mod_perl=$mod_perl, " .
"path='$path', translated='$pd->{path}'";
}
# Putting path decription into the site clipboard
#
$clipboard->put(pagedesc => $pd);
# Setting expiration time in the page header to immediate
# expiration. If that's not what the page wants -- it can override
# these.
#
$siteconfig->header_args(
-expires => 'now',
-cache_control => 'no-cache',
);
# Do we need to run any objects before executing? A good place to
# turn on debug mode if required using Debug object.
#
my $pageheader=$self->_expand_list($siteconfig->get('auto_before'));
# If the header issued a final output (commonly a redirect), then
# nothing else needs to be done.
#
my $pagebody='';
my $pagefooter='';
if(!$clipboard->get('_no_more_output')) {
# Preparing object arguments out of standard ones, object specific
# once from template paths and supplied hash (in that order of
# preference).
#
my $objargs={
path => $pd->{'path'},
fullpath => $pd->{'fullpath'},
prefix => $pd->{'prefix'},
};
lib/XAO/DO/Context.pm view on Meta::CPAN
use XAO::Objects;
use base XAO::Objects->load(objname => 'Context');
sub method() {
my $self=shift;
my $config=$self->siteconfig;
my $cgi=$self->cgi;
my $clipboard=$self->clipboard;
}
=head1 DESCRIPTION
This is a convenience base class for accessing site configuration,
clipboard, and CGI object.
=over
=cut
###############################################################################
package XAO::DO::Context;
use strict;
use warnings;
use XAO::Projects;
lib/XAO/DO/Context.pm view on Meta::CPAN
=cut
sub cgi ($;@) {
my $self=shift;
return $self->siteconfig->cgi(@_);
}
###############################################################################
=item clipboard ()
Convenience shortcut to site configuration's clipboard() method.
=cut
sub clipboard (@) {
my $self=shift;
$self->siteconfig->clipboard(@_);
}
###############################################################################
=item siteconfig ()
Convenience shortcut to the current site configuration.
=cut
lib/XAO/DO/Web/Clipboard.pm view on Meta::CPAN
=head1 NAME
XAO::DO::Web::Clipboard - clipboard value retrieval object.
=head1 SYNOPSIS
Currently is only useful in XAO::Web site context.
=head1 DESCRIPTION
Clipboard object is based on Action object (see L<XAO::DO::Web::Action>)
and therefor what it does depends on the "mode" argument.
lib/XAO/DO/Web/Clipboard.pm view on Meta::CPAN
use base XAO::Objects->load(objname => 'Web::Action');
our $VERSION='2.001';
sub check_mode ($$) {
my $self = shift;
my $args = get_args(\@_);
my $mode = $args->{mode} || 'show';
if ($mode eq 'set') {
$self->clipboard_set($args);
}
elsif ($mode eq 'show') {
$self->clipboard_show($args);
}
elsif ($mode eq 'array-push') {
$self->clipboard_array_push($args);
}
elsif ($mode eq 'array-size') {
$self->clipboard_array_size($args);
}
elsif ($mode eq 'array-pop') {
$self->clipboard_array_pop($args);
}
elsif ($mode eq 'array-list') {
$self->clipboard_array_list($args);
}
else {
throw XAO::E::DO::Web::Clipboard "check_mode - unknown mode '$mode'";
}
}
###############################################################################
=item 'set' => clipboard_set (%)
Sets a value in the clipboard. Example:
<%Clipboard mode='set' name='foo' value='bar'%>
If there is no 'value' argument it puts 'undef' into the clipboard, but
does not remove the named record.
=cut
sub clipboard_set ($%) {
my $self = shift;
my $args = get_args(\@_);
my $name=$args->{name} ||
throw XAO::E::DO::Web::Clipboard "clipboard_set - no 'name' given";
$self->clipboard->put($name => $args->{value});
}
###############################################################################
=item 'show' => clipboard_show (%)
Displays clipboard parameter with the given "name". Example:
<%Clipboard mode="show" name="username" default="aa@bb.com"%>
Would display whatever is set in the Clipboard for variable
"username" or "aa@bb.com" if it is not set.
=cut
sub clipboard_show ($%) {
my $self = shift;
my $args = get_args(\@_);
my $clipboard = $self->clipboard;
$args->{name} ||
throw XAO::E::DO::Web::Clipboard "clipboard_show - no 'name' given";
my $value = $clipboard->get($args->{name});
$value = $args->{default} if !defined($value) || ref($value);
$self->textout($value) if defined $value;
}
###############################################################################
=item 'array-push' => clipboard_array_push (%)
Push a value into an array with the given "name". Example:
<%Clipboard mode='array-push' name='elements' value='Something'%>
Displays nothing.
=cut
sub clipboard_array_push ($%) {
my $self = shift;
my $args = get_args(\@_);
my $name = $args->{'name'} ||
throw $self "- no 'name' given";
my $clipboard = $self->clipboard;
my $array = $clipboard->get($name);
if(!ref $array || ref $array ne 'ARRAY') {
undef $array;
}
if(!defined $array) {
$array = [];
$clipboard->put($name => $array);
}
push(@$array, $args->{'value'});
}
###############################################################################
=item 'array-pop' => clipboard_array_pop (%)
Output the topmost element of the given array.
<%Clipboard mode='array-pop' name='elements'%>
If there is no array at that location, there is an empty array, or there
is a non-array value, then there is no output.
=cut
sub clipboard_array_pop ($%) {
my $self = shift;
my $args = get_args(\@_);
my $name = $args->{'name'} ||
throw $self "- no 'name' given";
my $array = $self->clipboard->get($name);
if(ref $array && ref $array eq 'ARRAY' && @$array) {
$self->textout(pop @$array);
}
}
###############################################################################
=item 'array-list' => clipboard_array_list (%)
Iterate over all array elements, displaying each element with the given
template or path.
<%Clipboard mode='array-list' name='elements' template='<$VALUE$>'%>
=cut
sub clipboard_array_list ($%) {
my $self = shift;
my $args = get_args(\@_);
my $name = $args->{'name'} ||
throw $self "- no 'name' given";
my $array = $self->clipboard->get($name);
(ref $array && ref $array eq 'ARRAY') ||
return;
my $page=$self->object;
for(my $i=0; $i < @$array; ++$i) {
$page->display($page->pass_args($args->{'pass'}, $args),{
path => $args->{'path'},
template => $args->{'template'},
VALUE => $array->[$i] // '',
INDEX => $i,
SIZE => scalar @$array,
});
}
}
###############################################################################
=item 'array-size' => clipboard_array_size (%)
Output the number of elements in the given array.
<%Clipboard mode='array-size' name='elements'%>
If there is no array at that location or there is a non-array value,
then there is no output.
=cut
sub clipboard_array_size ($%) {
my $self = shift;
my $args = get_args(\@_);
my $name = $args->{'name'} ||
throw $self "- no 'name' given";
my $array = $self->clipboard->get($name);
if(ref $array && ref $array eq 'ARRAY') {
$self->textout(scalar(@$array));
}
}
###############################################################################
1;
__END__
lib/XAO/DO/Web/Condition.pm view on Meta::CPAN
sub display ($;%)
{ my $self=shift;
my %args=%{get_args(\@_) || {}};
my $config=$self->siteconfig;
##
# First going through the list of conditions and checking them.
#
my $name;
foreach my $a (sort keys %args)
{ next unless $a =~ /^(\w+)\.(number|value|arg|cgiparam|length|siteconf|siteconfig|cookie|secure|clipboard)$/;
if($2 eq 'cgiparam')
{ my $param=$args{$a};
my $cname=$1;
my ($target,$targop);
if($param =~ /^\s*(.*?)\s*(=|>|<|\!)\s*(.*?)\s*$/)
{ $param=$1;
$targop=$2;
$target=$3;
}
my $pvalue=$config->cgi->param($param);
lib/XAO/DO/Web/Condition.pm view on Meta::CPAN
{ $name=$1;
last;
}
}
elsif($2 eq 'secure')
{ if($self->is_secure)
{ $name=$1;
last;
}
}
elsif($2 eq 'clipboard')
{ my $param=$args{$a};
my $cname=$1;
my ($target,$targop);
if($param =~ /^\s*(.*?)\s*(=|>|<|\!)\s*(.*?)\s*$/)
{ $param=$1;
$targop=$2;
$target=$3;
}
my $pvalue=$self->clipboard->get($param);
if(check_target($pvalue,$target,$targop))
{ $name=$cname;
last;
}
}
elsif($args{$a}) # value
{ $name=$1;
last;
}
}
lib/XAO/DO/Web/Config.pm view on Meta::CPAN
use base XAO::Objects->load(objname => 'Embeddable');
our $VERSION='2.004'; # Obsolete, but needed by CPAN
# Prototypes
#
sub add_cookie ($@);
sub cgi ($$);
sub cleanup ($);
sub clipboard ($);
sub cookies ($);
sub disable_special_access ($);
sub embeddable_methods ($);
sub enable_special_access ($);
sub force_byte_output ($;$);
sub get_cookie ($$;$);
sub header ($@);
sub header_args ($@);
sub header_array ($);
sub header_normalize ($$);
lib/XAO/DO/Web/Config.pm view on Meta::CPAN
}
throw XAO::E::DO::Web::Config
"cgi - storing new CGI requires enable_special_access()";
}
###############################################################################
=item cleanup ()
Removes CGI object, cleans up clipboard. No need to call manually,
usually is called as part of XAO::DO::Config cleanup().
=cut
sub cleanup ($) {
my $self=shift;
delete $self->{'cgi'};
delete $self->{'clipboard'};
delete $self->{'cookies'};
delete $self->{'header_args'};
delete $self->{'force_byte_output'};
delete $self->{'header_printed'};
delete $self->{'special_access'};
}
###############################################################################
=item clipboard ()
Returns clipboard XAO::SimpleHash object. Useful to keep temporary data
between different XAO::Web objects. Cleaned up for every session.
=cut
sub clipboard ($) {
my $self=shift;
$self->{'clipboard'}=XAO::SimpleHash->new() unless $self->{'clipboard'};
return $self->{'clipboard'};
}
###############################################################################
=item cookies ()
Returns reference to an array of prepared cookies.
=cut
lib/XAO/DO/Web/Config.pm view on Meta::CPAN
sub disable_special_access ($) {
my $self=shift;
delete $self->{special_access};
}
###############################################################################
=item embeddable_methods ()
Used internally by global Config object, returns an array with all
embeddable method names -- add_cookie(), cgi(), clipboard(), cookies(),
force_byte_output(), header(), header_args().
=cut
sub embeddable_methods ($) {
qw(
add_cookie cgi clipboard cookies force_byte_output
header header_args header_array header_remove get_cookie
);
}
###############################################################################
=item enable_special_access ()
Enables use of cgi() method to set a new value. Normally you do
not need this method.
lib/XAO/DO/Web/Default.pm view on Meta::CPAN
/bits/errors/file-not-found template as a FILEPATH argument.
Sets up page headers to show 404 page not found message.
=cut
sub display ($@) {
my $self=shift;
my $args=get_args(\@_);
my $path=$self->clipboard->get('/pagedesc/fullpath') ||
$args->{'path'} ||
'';
$self->siteconfig->header_args(
-Status => '404 File not found',
-expires => 'now',
-cache_control => 'no-cache',
);
$self->object->display(
lib/XAO/DO/Web/FS.pm view on Meta::CPAN
=head1 NAME
XAO::DO::Web::FS - XAO::Web front end object for XAO::FS
=head1 SYNOPSIS
<%FS uri="/Categories/123/description"%>
<%FS mode="show-list"
base.clipboard="cached-list"
base.database="/Foo/test/Bars"
fields="*"
header.path="/bits/foo-list-header"
path="/bits/foo-list-row"
default.path="/bits/foo-list-default"
%>
<%FS mode="search"
uri="/Orders"
index_1="status"
lib/XAO/DO/Web/FS.pm view on Meta::CPAN
use XAO::Errors qw(XAO::DO::Web::FS);
use XAO::Objects;
use base XAO::Objects->load(objname => 'Web::Action');
our $VERSION='2.004';
###############################################################################
=item get_object (%)
Returns an object retrieved from either clipboard or the database.
Accepts the following arguments:
base.clipboard clipboard uri
base.database XAO::FS object uri
uri XAO::FS object URI relative to `base' object
or root if no base.* is given
If both base.clipboard and base.database are set then first attempt is
made to get object from the clipboard and then from the database. If the
object is retrieved from the database then it is stored in clipboard.
Next call with the same arguments will get the object from clipboard.
=cut
sub get_object ($%) {
my $self=shift;
my $args=get_args(\@_);
my $object;
my $cb_base=$args->{'base.clipboard'};
my $db_base=$args->{'base.database'};
$object=$self->clipboard->get($cb_base) if $cb_base;
!$object || ref($object) ||
throw $self "get_object - garbage in clipboard at '$cb_base'";
my $got_from_cb=$object;
$object=$self->odb->fetch($db_base) if $db_base && !$object;
if($cb_base) {
$db_base || $object ||
throw $self "get_object - no object in clipboard and" .
" no base.database to retrieve it";
##
# Caching object in clipboard if we have both base.clipboard and
# base.database.
#
if($object && !$got_from_cb) {
$self->clipboard->put($cb_base => $object);
}
}
my $uri=$args->{uri};
if($object && $uri && $uri !~ /^\//) {
##
# XXX - This should be done in FS
#
foreach my $name (split(/\/+/,$uri)) { $object=$object->get($name); }
lib/XAO/DO/Web/FS.pm view on Meta::CPAN
###############################################################################
=item delete-property => delete_property (%)
Deletes an object or property pointed to by `name' argument.
Example of deleting an entry from Addresses list by ID:
<%FS
mode="delete-property"
base.clipboard="/IdentifyUser/customer/object"
uri="Addresses"
name="<%ID/f%>"
%>
=cut
sub delete_property ($%) {
my $self=shift;
my $args=get_args(\@_);
lib/XAO/DO/Web/IdentifyAgent.pm view on Meta::CPAN
configuration under '/identify_agent':
cb_uri => 'IdentifyAgent', #opt., default is '/IdentifyAgent'
id_cookie => 'id_agent', #optional, default is 'agent_id'
id_cookie_expire => 126230400, #optional, default is 4y
list_uri => '/Browsers', #optional, see below
access_time_prop => 'latest_access', #required if 'list_uri' present
list_expire => 126230400, #opt., default is 'id_cookie_expire'
When a given 'IdentifyAgent' object is instantiated, it first checks the
clipboard to determine if there is an agent id present, indicating that
the agent has already been identified in the current session. If so, the
work here is done.
If the agent has not already been identified, it checks whether there
is a cookie named as 'id_cookie' parameter value ('id_agent' in
example). If there is, the value of this cookie is the agent ID and
saves to the clipboard. Otherwise, cookie is set to a unique agent ID
value. The expiration time is set to 'id_cookie_expire' value if it is
present and to 4 years otherwise.
Once the agent cookie is retrieved or an unique agent ID is generated
for setting a new agent cookie a call is made to an 'IdentifyAgent'
method called 'save_agent_id()'. This method first checks if there is
a 'list_uri' parameter. If 'list_uri' is present then the agent ID
is saved to this list, using agent ID as the list's key unless an
entry for the agent already exists in the list. Otherwise, nothing is
saved. Whenever saving an agent to the list, the access time is also
saved in the database. Saving the access time also happens every time
the agent is identified by a cookie.
Agent object is stored to clipboard under 'object' name if there is a
'list_uri' parameter. Otherwise, agent object remains undefined and only
agent ID is stored under 'name' name.
=head1 METHODS
There are two methods available only. First of them is overriden display
method that displays nothing but identifies user agent. And last of them
is save_agent_id. See description below.
=over
lib/XAO/DO/Web/IdentifyAgent.pm view on Meta::CPAN
=item display (%)
Method displays nothing :-) but identifies user agent
=cut
sub display($){
my $self=shift;
my $config=$self->siteconfig->get('/identify_agent');
my $clipboard_uri=$config->{cb_uri} || "/IdentifyAgent";
# Checking the clipboard to determine if there is an agent id present.
# If so, the work here is done.
#
return if $self->clipboard->get("$clipboard_uri/name");
# Checking cookie named 'id_cookie' and trying to save whatever we
# got. Saving method should be careful to check for valid IDs and so
# on.
#
# On return save methods gives us saved object.
#
my $id_cookie=$config->{id_cookie} || 'agent_id';
my $agent_id=$self->siteconfig->get_cookie($id_cookie);
my $agent_object=$self->save_agent_id($agent_id);
if($agent_object) {
$agent_id=$agent_object->container_key;
}
elsif(!$agent_id) {
$agent_id=generate_key();
}
##
# Storing into clipboard
#
$self->clipboard->put("$clipboard_uri/name" => $agent_id);
$agent_object &&
$self->clipboard->put("$clipboard_uri/object" => $agent_object);
dprint "IdentifyAgent(id=$agent_id, object=$agent_object)";
##
# Setting cookie
#
my $expire=$config->{id_cookie_expire} ? "+$config->{id_cookie_expire}s"
: "+4y";
$self->siteconfig->add_cookie(
-name => $id_cookie,
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
on the computer. And therefore if customer computer is accidentally set
to some future date the cookie might expire immediately and prevent this
customer from logging into the system at all. Most (if not all) versions
of Netscape and Mozilla do not have this problem.
Therefore, when possible we do not trust customer's computer to measure
time for us and do that ourselves.
=item cb_uri
URI of clipboard where IdentifyUser stores identification and
verification information about user and makes it globally available.
=back
=head1 RESULTS
In addition to displaying the correct template, results of user
verification or identification are stored in the clipboard. Base
clipboard location is determined by 'cb_uri' configuration parameter and
defaults to '/IdentifyUser/TYPE', where TYPE is the type of user.
Parameters that are stored into the clipboard are:
=over
=item id
The internal ID of the user object (same as returned by container_key()
method on the object).
=item name
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
=back
Additional information will also be stored if 'user_prop'
refers to deeper objects. For example, if user_prop is equal to
'Nicknames/nickname' then it is assumed that there is a list inside
of user objects called Nicknames and there is a property in that list
called 'nickname'. It is also implied that the 'nickname' is unique
throughout all objects of its class.
Information that gets stored in the clipboard in that case is:
=over
=item list_prop
Name of the list property of the user object that is used in
'user_prop'. In our example it will be 'Nicknames'.
=item Nicknames (only for the example above)
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
throw $self "- no such mode '$mode'";
}
}
##############################################################################
=item check ()
Checks identification/verification status of the user.
To determine identification status, first check clipboard to determine
if there is such object present. If so, then that object identifies the
user.
If not, then depending on 'id_cookie_type' parameter (that defaults to
'name') check whether there is an identification cookie or key cookie
and if so, perform a search for object in database. If this search
yields a positive result, the user's status is 'identified' and an
attempt to verify user is made, otherwise the status is 'anonymous'.
Identification by key only works when keys are stored in a separate list.
Once identity is established, to determine verification status, first
check the clipboard to determine if there is a 'verified' flag set. If
so, then the user's status is 'verified'. If not, check whether the
difference between the current time and the time of the latest visit is
less than vf_expire_time property. If so, the user status considered
'verified', a new time is stored.
If optional 'vf_key_prop' and 'vf_key_cookie' parameters are present in
the configuration then one additional check must be performed before
changing status to 'verified' - the content of the key cookie and
apropriate field in the user profile must match.
=cut
sub check ($@) {
my $self=shift;
my $args=get_args(\@_);
my ($config,$type)=$self->_get_config($args);
my $clipboard=$self->clipboard;
my $cookie_domain=$config->{'domain'};
my $without_cookies=$args->{'without_cookies'};
# These are useful for both verification and identification cookies.
#
my $vf_time_prop=$config->{'vf_time_prop'} ||
throw $self "No 'vf_time_prop' in the configuration";
my $current_time=time;
my $last_vf;
# Checking if we already have user in the clipboard. If not -- checking
# the cookie and trying to load from the database.
#
my $cb_uri=$config->{'cb_uri'} || "/IdentifyUser/$type";
my $id_cookie_type=$config->{'id_cookie_type'} || 'name';
my $key_list_uri=$config->{'key_list_uri'};
my $key_ref_prop=$config->{'key_ref_prop'};
my $data=$clipboard->get($cb_uri);
my $user=$data ? $data->{'object'} : undef;
my $key_object=$data ? $data->{'key_object'} : undef;
if(!$data || !$user) {
$data=undef;
my $id_cookie=$config->{'id_cookie'} ||
throw $self "- no 'id_cookie' in the configuration";
my $cookie_value=$without_cookies
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
}
if(!$data) {
return $self->display_results($args,'anonymous');
}
# This is mostly useful for multi-key logins
#
$data->{'cookie_value'}=$cookie_value;
# Saving identified user to the clipboard
#
$clipboard->put($cb_uri => $data);
$user=$data->{'object'};
# Updating cookie
#
unless($without_cookies) {
my $id_cookie_expire=$config->{'id_cookie_expire'} || 4*365*24*60*60;
$self->siteconfig->add_cookie(
-name => $id_cookie,
-value => $cookie_value,
-path => '/',
-expires => '+' . $id_cookie_expire . 's',
-domain => $cookie_domain,
);
}
}
# Checking clipboard to determine if 'verified' flag is set and
# if so user's status is 'verified'.
#
my $verified=$clipboard->get("$cb_uri/verified");
if(!$verified) {
my $vcookie;
my $vf_key_cookie=$config->{'vf_key_cookie'};
my $key_cookie_value;
if($vf_key_cookie) {
$key_cookie_value=$without_cookies
? $args->{'key_cookie_value'}
: $self->siteconfig->get_cookie($vf_key_cookie);
}
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
if($key_user_id eq $user->container_key) {
$last_vf=$key_last_vf;
}
else {
$key_object=undef;
$last_vf=0;
}
}
$clipboard->put("$cb_uri/key_object" => $key_object);
}
# Checking the difference between the current time and the time
# of last verification
#
my $vf_expire_time=$config->{'vf_expire_time'} ||
throw $self "No 'vf_expire_time' in the configuration";
my $vf_expire_ext_time=$config->{'vf_expire_ext_time'} || 0;
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
# verify that user.
#
if($verified) {
my $errstr=$self->verify_check(
args => $args,
object => $user,
type => $type,
);
if(!$errstr) {
$clipboard->put("$cb_uri/verified" => 1);
$clipboard->put("$cb_uri/key" => $key_cookie_value);
my %user_data;
$user_data{$config->{'vf_time_last_prop'}} = $current_time
if $config->{'vf_time_last_prop'};
if($key_object) {
my $key_expire_prop=$config->{'key_expire_prop'} ||
throw $self "- key_expire_prop required";
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
##############################################################################
=item before_display (%)
Overridable method that gets called just before displaying results after
all checks are done. Parameters it gets are:
status - one of 'anonymous', 'identified', or 'verified'
type - user type
cbdata - reference to clipboard data for the user
config - reference to the config for the user
errstr - error string, only available when called as part of login
Typically the method is used to add some other useful data to the
clipboard on successful checks and logins. By default does nothing.
=cut
sub before_display ($@) {
return;
}
##############################################################################
=item display_results ($$;$)
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
may include the content of 'ERRSTR'.
=cut
sub display_results ($$$;$) {
my ($self,$args,$status,$errstr)=@_;
my ($config,$type)=$self->_get_config($args);
my $cb_uri=$config->{'cb_uri'} || "/IdentifyUser/$type";
my $clipboard=$self->clipboard;
$self->before_display(
type => $type,
config => $config,
cbdata => $clipboard->get($cb_uri) || { },
status => $status,
errstr => $errstr,
);
if($args->{"$status.template"} || $args->{"$status.path"}) {
my $page=$self->object;
$page->display($args,{
path => $args->{"$status.path"},
template => $args->{"$status.template"},
CB_URI => $cb_uri || '',
ERRSTR => $errstr || '',
TYPE => $type,
NAME => $clipboard->get("$cb_uri/name") || '',
VERIFIED => $clipboard->get("$cb_uri/verified") || '',
});
$self->finaltextout('') if $args->{'stop'};
}
}
###############################################################################
sub _get_user_props($$$) {
my ($self,$config,$list)=@_;
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
}
##############################################################################
=item find_user ($$;$)
Searches for the user in the list according to the configuration:
my $data=$self->find_user($config,$username);
Sets the same parameters in the returned hash as stored in the clipboard
except 'verified'.
=cut
sub find_user ($$$;$) {
my ($self,$config,$username,$skip_user_condition)=@_;
my $list_uri=$config->{'list_uri'} ||
throw $self "- no 'list_uri' in the configuration";
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
cbdata => $data,
force => $args->{'force'},
);
}
# We know our fate at this point. Displaying anonymous path and
# bailing out if there were errors.
#
# Also updating the count of failures if available.
#
my $clipboard=$self->clipboard;
my $cb_uri=$config->{'cb_uri'} || "/IdentifyUser/$type";
if($errstr) {
# Anonymous user should not propagate anything identifyable -
# resetting the data
#
$data={
fail_locked => $fail_locked,
};
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
if($fail_max_count) {
$data->{'fail_max_count'}=$fail_max_count;
$data->{'fail_max_count_reached'}=1 if $ud{$fail_count_prop}>$fail_max_count;
}
}
$user->put(\%ud) if %ud;
}
}
$clipboard->put($cb_uri => $data);
# A failure to login resets existing key cookies
#
unless($without_cookies) {
if($id_cookie_type eq 'key') {
$self->siteconfig->add_cookie(
-name => $id_cookie,
-value => '0',
-path => '/',
-expires => '-1d',
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
throw $self "- unsupported id_cookie_type ($id_cookie_type)";
}
}
# Yay! Verified.
#
$data->{'verified'}=1;
$data->{'extended'}=($extended ? 1 : 0);
# Storing values into the clipboard
#
$clipboard->put($cb_uri => $data);
# Displaying results
#
$self->display_results($args,'verified');
}
###############################################################################
sub login_password_encrypt ($@) {
my $self=shift;
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
=item login_check ()
A method that can be overriden in a derived object to check additional
conditions for letting a user in. Gets the following arguments as its
input:
name => name of user object
password => password
object => reference to a database object containing user info
type => user type
cbdata => reference to a hash that will be stored in clipboard on
successful login
This method is called after all standard checks - it is guaranteed that
user object exists and password matches its database record.
Must return empty string on success or suggested error message on
failure. That error message will be passed in ERRSTR argument to the
templates.
=cut
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
Logs the user out.
Resets vf_time_prop if there is no vf_key_prop set as it is our only
proof of authentication in this case. If vf_key_prop is in use, then we
clear the key, but leave the time alone -- helps to see when this user
last logged in.
Clears identification cookie as well for hard logout mode. Sets user
status to 'anonymous' (hard logout mode) or 'identified'.
Will install data into clipboard in soft logout mode just the same way
as mode='check' does.
=cut
sub logout ($@) {
my $self=shift;
my $args=get_args(\@_);
my ($config,$type)=$self->_get_config($args);
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
'identified.path' => undef,
'identified.template' => undef,
'verified.path' => undef,
'verified.template' => undef,
});
}
# Checking if we're currently logged in at all -- either verified or
# identified.
#
my $clipboard=$self->clipboard;
my $cb_uri=$config->{'cb_uri'} || "/IdentifyUser/$type";
my $cb_data=$clipboard->get($cb_uri);
my $user=$cb_data->{'object'};
# If there is no user at all -- then we're already logged out
#
$user || return $self->display_results($args,'anonymous');
# Removing user last verification time only as a last resort --
# it's useful to have it to know when the user last logged in. When
# possible removing either the key from the list, or the key
# property.
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
if($vf_key_prop && $vf_key_cookie) {
$user->put($vf_key_prop => '');
$deleted=1;
}
my $key_object=$cb_data->{'key_object'};
if($key_object) {
$key_object->put($vf_time_prop => 0);
$clipboard->delete("$cb_uri/key_object");
$clipboard->delete("$cb_uri/extended");
$deleted=1;
}
# Up to 1.93 the behavior was to only clear user level vf_time if
# really necessary. The misguided idea was to preserve vf_time_prop
# database value across logouts when the key is enough for security.
# The leads to inconsistent behavior that depends on whether the key
# is present and is deleted.
#
# With the introduction of persistent 'vf_time_last_prop' value, the
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
}
else {
throw $self "- no key and no vf_time_user_prop in logout";
}
}
else {
$user->put($vf_time_prop => 0);
}
}
# Deleting verification status from the clipboard
#
$clipboard->delete("$cb_uri/verified");
$clipboard->delete("$cb_uri/key");
# Not sure, but setting value to an empty string triggered a bug
# somewhere, setting it to '0' instead and expiring it immediately.
#
# This is mainly so the user does not feel paranoid -- if if we were
# to keep this cookie the user won't be in verified status any more
# because last verification time was dropped to zero.
#
if(!$without_cookies && $vf_key_cookie) {
$self->siteconfig->add_cookie(
lib/XAO/DO/Web/IdentifyUser.pm view on Meta::CPAN
-value => '0',
-path => '/',
-expires => '-1d',
-domain => $cookie_domain,
);
}
# Deleting user identification if hard_logout is set.
#
if($args->{'hard_logout'}) {
$clipboard->delete($cb_uri);
if($key_object) {
$key_object->container_object->delete($key_object->container_key);
$clipboard->delete("$cb_uri/key_object");
}
unless($without_cookies) {
my $id_cookie=$config->{'id_cookie'} ||
throw $self "- no 'id_cookie' in the configuration";
$self->siteconfig->add_cookie(
-name => $id_cookie,
-value => '0',
-path => '/',
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
=item *
The page is configured to be cacheable with either an entry in
the configuration under '/xao/page/render_cache_allow' or with a
'xao.cacheable' parameter given (e.g. something like <%Page ...
xao.cacheable%>).
=item *
There is no "/xao/page/render_cache_update" in the clipboard. This can be used
to force cache reload by checking some environmental variable early in
the flow and setting the clipboard to disable all render caches for that
one render. Cached content is not used, but is updated -- so subsequent
cached calls with the same parameters will return new content.
=item *
There is no "/xao/page/render_cache_skip" in the clipboard. This can be used to
skip cache altogether if it is known that pages rendered in this session
are different from cached and the cache does not want to be contaminated
with them.
=back
Properly used render cache can speed up pages significantly, but if
used incorrectly it can also introduce very hard to find issues in the
rendered content.
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
sub parse ($%);
sub siteconfig ($);
sub textout ($%);
sub benchmark_enabled ($);
sub benchmark_enter ($$;$$$);
sub benchmark_leave ($$;$$);
sub benchmark_reset ($);
sub benchmark_start ($;$);
sub benchmark_stats ($;$);
sub benchmark_stop ($);
sub page_clipboard ($);
sub _do_pass_args ($$$);
###############################################################################
sub params_digest ($$;$) {
my ($self,$args,$spec)=@_;
# Dropping non-scalar values from params. They get in by calling
# ::Action::data_... methods for example, and in other scenarios
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
if($itemflag && $itemflag ne 't') {
$text=$obj->expand(\%objargs);
}
else {
$obj->display(\%objargs);
}
# Indicator that we do not need to parse or display anything
# after that point.
#
$stop_after=$self->clipboard->get('_no_more_output');
# Was it something like SetArg object? Merging changes in then.
#
if($self->{'merge_args'}) {
@{$args}{keys %{$self->{'merge_args'}}}=values %{$self->{'merge_args'}};
delete $self->{'merge_args'};
}
}
}
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
my $cache=$self->_render_cache;
$cache->drop_all if $cache;
}
###############################################################################
sub can_cache_render ($$) {
my ($self,$args)=@_;
return 0 if $self->page_clipboard->{'render_cache_skip'};
return 1 if $args->{'xao.cacheable'};
my $path=!defined $args->{'template'} && $args->{'path'};
return 0 unless $path;
my $cache_key='p:' . $path;
my $cache_allow=$self->{'cache_allow'};
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
if($self->debug_check('render-cache-get')) {
dprint "RENDER_CACHE_GET: $cache_key / $params_json";
}
# Building the content. Real arguments for displaying are in
# $self->{'args'}.
#
my $content=$cache->get($self,{
cache_key => $cache_key,
force_update => ($self->page_clipboard->{'render_cache_update'} || $args->{'xao.uncached'}),
});
$self->textout($content);
return;
}
}
# We get here if the page cannot be cached
#
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
Used in Redirect object to break execution immediately for example.
Accepts the same arguments as textout() method.
=cut
sub finaltextout ($%) {
my $self=shift;
$self->textout(@_);
$self->clipboard->put(_no_more_output => 1);
}
###############################################################################
=item dbh ()
Returns current database handler or throws an error if it is not
available.
Example:
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
=cut
sub cgi ($) {
my $self=shift;
$self->siteconfig->cgi;
}
###############################################################################
=item clipboard ()
Returns clipboard object, which inherets XAO::SimpleHash methods. Use
this object to pass data between various objects that work together to
produce a page. Clipboard is cleaned before starting every new session.
=cut
sub clipboard ($) {
my $self=shift;
my $clipboard=$self->{'clipboard'};
if(!$clipboard) {
$clipboard=$self->{'clipboard'}=$self->siteconfig->clipboard;
}
return $clipboard;
}
###############################################################################
=item siteconfig ()
Returns site configuration reference. Be careful with your changes to
configuration, try not to change configuration -- use clipboard to pass
data between objects. See L<XAO::Projects> for more details.
=cut
sub siteconfig ($) {
my $self=shift;
my $siteconfig=$self->{'siteconfig'};
if(!$siteconfig) {
$siteconfig=$self->{'siteconfig'}=
$self->{'sitename'} ? get_project($self->{'sitename'})
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
my $self=shift;
my $args=get_args(\@_);
my $secure=$args->{secure};
$secure=$self->is_secure unless defined $secure;
my $active=$args->{active};
my $url;
if($secure) {
$url=$active ? $self->clipboard->get('active_url_secure')
: $self->siteconfig->get('base_url_secure');
} else {
$url=$active ? $self->clipboard->get('active_url')
: $self->siteconfig->get('base_url');
}
return $url;
}
###############################################################################
=item is_secure ()
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
=item pageurl (%)
Returns full URL of current page without parameters. Accepts the same
arguments as base_url() method.
=cut
sub pageurl ($;%) {
my $self=shift;
my $pagedesc=$self->clipboard->get('pagedesc') ||
throw $self "- no Web context, needs clipboard->'pagedesc'";
my $url=$self->base_url(@_);
# This works in both CGI and PSGI environments, but simply
# requesting $cgi->url(-absolute => 1) does not work for PSGI
# because it sets PATH_INFO and REQUEST_URI to the same value,
# making them cancel each other.
#
my $uri=$self->cgi->request_uri();
$uri =~ s/\?.*$//s;
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
# This is it, merging with the arguments given to us and returning
#
return merge_refs($hash,$args);
}
###############################################################################
sub benchmark_enabled ($) {
my $self=shift;
$self->clipboard->get('_page_benchmark_enabled') || 0;
}
###############################################################################
sub _benchmark_hash ($) {
my $self=shift;
my $stats=$self->{'benchmark_stats'};
if(!$stats) {
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
Start automatic system-wide page rendering benchmarking.
By default only 'path' based rendering is benchmarked. If an optional
single argument is set to '2' then templates are also benchmarked (this
may demand a lot of extra memory!).
=cut
sub benchmark_start ($;$) {
my ($self,$level)=@_;
$self->clipboard->put('_page_benchmark_enabled' => ($level || 1));
}
###############################################################################
=item benchmark_stop()
Stop automatic system-wide rendering benchmarking.
=cut
sub benchmark_stop ($) {
my $self=shift;
$self->clipboard->put('_page_benchmark_enabled' => 0);
}
###############################################################################
=item benchmark_stats
Return a hash with accumulated benchmark statistics.
=cut
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
foreach my $tag (keys %$stats) {
my $d=$stats->{$tag};
next unless $d->{'count'};
next if $desired_tag && $tag ne $desired_tag;
$d->{'average'}=$d->{'total'} / $d->{'count'};
$d->{'median'}=$d->{'last'}->[scalar(@{$d->{'last'}})/2];
# The page is cacheable if the content only depends on
# parameters and not on clipboard, cookies, CGI, time, or other
# environment.
#
$d->{'cacheable'}=scalar(grep {
scalar(keys %{$d->{'runs'}->{$_}->{'content'}}) != 1
} keys %{$d->{'runs'}}) ? 0 : 1;
# Current cacheable flag, if it's shared across all runs
#
$d->{'cache_flag'}=scalar(grep {
! $d->{'runs'}->{$_}->{'cache_flag'}
lib/XAO/DO/Web/Page.pm view on Meta::CPAN
sub debug_check ($$) {
my ($self,$type)=@_;
# This is a speed up (makes the parsing more than twice faster when a
# local parsing cache is also used).
#
# 8 wallclock secs ( 8.78 usr + 0.01 sys = 8.79 CPU) @ 113765.64/s (n=1000000)
# 19 wallclock secs (18.97 usr + 0.00 sys = 18.97 CPU) @ 52714.81/s (n=1000000)
#
### return $self->clipboard->get("debug/Web/Page/$type");
my $debug_hash=$self->{'debug_hash'};
if(!$debug_hash) {
$debug_hash=$self->clipboard->get('/debug/Web/Page');
if($debug_hash) {
$self->{'debug_hash'}=$debug_hash;
}
else {
$self->{'debug_hash'}=$debug_hash={ };
$self->clipboard->put('/debug/Web/Page' => $debug_hash);
}
}
return $debug_hash->{$type};
}
###############################################################################
sub debug_set ($%) {
my $self=shift;
my $args=get_args(\@_);
foreach my $type (keys %$args) {
$self->clipboard->put("/debug/Web/Page/$type",$args->{$type} ? 1 : 0);
}
}
###############################################################################
sub page_clipboard ($) {
my $self=shift;
my $cb_hash=$self->{'page_clipboard'};
if(!$cb_hash) {
$cb_hash=$self->clipboard->get('/xao/page');
if($cb_hash) {
$self->{'page_clipboard'}=$cb_hash;
}
else {
$self->{'page_clipboard'}=$cb_hash={ };
$self->clipboard->put('/xao/page' => $cb_hash);
}
}
return $cb_hash;
}
###############################################################################
1;
__END__
lib/XAO/DO/Web/TextTable.pm view on Meta::CPAN
Final step is to use 'render' mode to actually draw the table. One
optional argument is 'width' -- the final width of the table. Default
width is 75 characters.
<%TextTable mode="render"%>
=back
Tables can be nested as long as there is a 'render' for each 'start'.
Internally Web::TextTable uses clipboard variable located at
'/var/TextTable'.
B<Note:> You need to be careful with extra spaces and newlines. One
way of dealing with it is to enclose table preparation into an unused
variable brackets to just throw away extra space:
<%SetArg name="UNUSED" value={
<%TextTable ....%>
<%TextTable ....%>
<%TextTable ....%>
lib/XAO/DO/Web/TextTable.pm view on Meta::CPAN
my $tstack=$self->get_tstack;
$tstack->[0] ||
throw $self "table_render - no current table (start/render mismatch)";
$self->textout(shift(@$tstack)->render($args->{width} || 75));
}
sub get_tstack ($) {
my $self=shift;
my $tstack=$self->clipboard->get('/var/TextTable');
if(!$tstack) {
$tstack=[];
$self->clipboard->put('/var/TextTable' => $tstack);
}
return $tstack;
}
sub generate_row ($%) {
my $self=shift;
my $args=get_args(\@_);
my %params;
lib/XAO/DO/Web/Utility.pm view on Meta::CPAN
Displays value of pagedesc structure (see L<XAO::Web>) with the given
"name". Default name is "fullpath". Useful for processing tree-to-object
mapped documents.
=cut
sub show_pagedesc ($) {
my $self=shift;
my $args=get_args(\@_);
my $name=$args->{name} || 'fullpath';
$self->textout($self->clipboard->get('pagedesc')->{$name} || '');
}
###############################################################################
=item 'select-time-range' => select_time_range(%)
Displays a list of <OPTION ...> tags for the given time range.
Exact output depends on "type" argument that can be:
t/testcases/Web/WebBenchmark.pm view on Meta::CPAN
"Benchmarking is not enabled after 'benchmark-start' (2)");
$page->expand(template => 'blah');
$benchmark->expand('mode' => 'enter', tag => 'test');
for(1..10) {
$page->expand(path => '/bits/system-test', 'xao.cacheable' => 1, TEST => 'foo', RUN => ($_ <= 5 ? $_ : 'X'));
$page->expand(path => '/bits/complex-template', RUN => ($_ <= 5 ? $_ : 'X'));
$page->expand(path => '/bits/test-recurring', RUN => ($_ <= 5 ? $_ : 'X'));
$page->clipboard->put('test_clipboard' => $_ * 10);
$page->expand(path => '/bits/test-non-cacheable', FOO => ($_ <= 5 ? 'A' : 'B'));
}
for(1..20) {
$page->expand(path => '/bits/complex-template');
}
$benchmark2->expand('mode' => 'leave', tag => 'test');
my $stats=$page->benchmark_stats();
t/testcases/Web/WebClipboard.pm view on Meta::CPAN
}
}
sub test_show {
my $self=shift;
my $page=XAO::Objects->new(objname => 'Web::Page');
$self->assert(ref($page),
"Can't load Page object");
$page->clipboard->put('foo' => 'bar');
$page->clipboard->put('/fu/foo' => 'fubar');
my $template='<%Clipboard name="<%NAME/f%>" default="DFLT"%>';
my %matrix=(
t1 => {
args => {
NAME => 'nothing',
},
result => 'DFLT',
},
t/testcases/Web/WebClipboard.pm view on Meta::CPAN
}
}
sub test_set {
my $self=shift;
my $page=XAO::Objects->new(objname => 'Web::Page');
$self->assert(ref($page),
"Can't load Page object");
$page->clipboard->put('foo' => 'bar');
$page->clipboard->put('/fu/foo' => 'fubar');
my %matrix=(
t1 => {
template => '<%Clipboard mode="set" name="foo" value="bar"%>',
result => {
foo => 'bar',
}
},
t2 => {
template => '<%Clipboard mode="set" name="foo" value=""%>',
t/testcases/Web/WebClipboard.pm view on Meta::CPAN
},
);
foreach my $test (keys %matrix) {
my $template=$matrix{$test}->{template};
my $got=$page->expand(template => $template);
$self->assert($got eq '',
"Test $test returned '$got' instead of ''");
my $cbhash=$matrix{$test}->{result};
foreach my $k (keys %$cbhash) {
$self->assert($page->clipboard->exists($k),
"$test - $k should exist");
my $expect=$cbhash->{$k};
$got=$page->clipboard->get($k);
if(defined $expect) {
$self->assert(defined $got && $got eq $expect,
"$test - expected '$expect', got '$got'");
}
else {
$self->assert(!defined($got),
"$test - expected nothing, got '".($got || '')."'");
}
}
}
t/testcases/Web/WebCondition.pm view on Meta::CPAN
sub test_all {
my $self=shift;
$ENV{'HTTP_COOKIE'}='cookie1=cvalue1; cookie2=cvalue2';
my $page=XAO::Objects->new(objname => 'Web::Page');
$self->assert(ref($page),
"Can't load Page object");
$page->clipboard->put('cb_foo' => 'bar');
$page->clipboard->put('cb_zero' => 0);
my $template=<<'EOT';
<%Condition
v1.value="<%V1%>"
v1.template="GOT-V1"
v2.arg="V2"
v2.path="/bits/WebCondition/text-v2"
default.template={<%Page/f path="/bits/WebCondition/text-default"%>}
%><%End%>
EOT
t/testcases/Web/WebCondition.pm view on Meta::CPAN
result => 'OK',
},
t10 => {
args => {
template => q(<%Condition a.cookie='cookie2=fubar' a.template='BAD' default.template='OK'%>),
},
result => 'OK',
},
t11 => {
args => {
template => q(<%Condition a.clipboard='cb_zero' a.template='BAD' default.template='OK'%>),
},
result => 'OK',
},
t12 => {
args => {
template => q(<%Condition a.clipboard='cb_foo' a.template='OK' default.template='BAD'%>),
},
result => 'OK',
},
t13 => {
args => {
template => q(<%Condition a.clipboard='cb_foo=bar' a.template='OK' default.template='BAD'%>),
},
result => 'OK',
},
t14 => {
args => {
template => q(<%Condition a.clipboard='cb_foo=baz' a.template='BAD' default.template='OK'%>),
},
result => 'OK',
},
t15 => {
args => {
template => q(<%Condition a.clipboard='cb_zero=0' a.template='OK' default.template='BAD'%>),
},
result => 'OK',
},
t20 => {
args => {
template => q(<%Condition a.siteconf='base_url' a.template='OK' default.template='ERR'%>),
},
result => 'OK',
},
t21 => {
t/testcases/Web/WebConfig.pm view on Meta::CPAN
use XAO::Projects;
use XAO::Utils;
use Data::Dumper;
use base qw(XAO::testcases::Web::base);
sub test_all {
my $self=shift;
my $config=XAO::Projects::get_current_project();
$config->clipboard->put('test' => 'foo');
$self->assert($config->clipboard->get('test') eq 'foo',
"Clipboard does not work");
# Making sure that get returns the actual stored hash, not its copy.
#
$config->put('/test/count' => 123);
$self->assert($config->get('/test/count') == 123,
"Failed to get stored value (1)");
$self->assert($config->get('/test')->{'count'} == 123,
"Failed to get stored value (2)");
$self->assert($config->get('test')->{'count'} == 123,
t/testcases/Web/WebConfig.pm view on Meta::CPAN
$self->assert($config->get('test')->{'count'} == 124,
"Failed to get incremented value (3)");
### use Data::Dumper;
### print Dumper($config->get('test'));
$config->cleanup();
### print Dumper($config->get('test'));
$self->assert(!defined($config->clipboard->get('test')),
"Cleanup does not work");
}
###############################################################################
sub test_header_args ($) {
my $self=shift;
my $config=XAO::Projects::get_current_project();
t/testcases/Web/WebFS.pm view on Meta::CPAN
template => '<%FS base.database="/project"%>',
expect => 'foo',
},
t4 => {
template => '<%FS base.database="/List/l1" uri="num"%>',
expect => '123',
},
t5 => {
template => '<%FS mode="show-list"' .
' base.database="/"' .
' base.clipboard="fs_cache/test_fs"' .
' uri="List"' .
' fields="*"' .
' header.path="/bits/WebFS/list-header"' .
' path="/bits/WebFS/list-row"' .
'%>',
expect => '[2]{l1-2-ttt-123}{l2-2-kkk-321}',
},
t6 => {
template => '<%FS mode="show-list"' .
' base.clipboard="fs_cache/test_fs"' .
' uri="List"' .
' fields="*"' .
' path="/bits/WebFS/list-row"' .
' footer.path="/bits/WebFS/list-header"' .
'%>',
expect => '{l1-2-ttt-123}{l2-2-kkk-321}[2]',
},
t7 => {
template => '<%FS mode="show-hash"' .
' base.clipboard="fs_cache/test_fs"' .
' uri="List/l2"' .
' fields="*"' .
' path="/bits/WebFS/hash"' .
'%>',
expect => '{l2-kkk-321}',
},
);
foreach my $tn (sort keys %matrix) {
my $page=XAO::Objects->new(objname => 'Web::Page');
t/testcases/Web/WebFS.pm view on Meta::CPAN
$list->put(l2 => $l2);
my $l3=$list->get_new();
$l3->put(mCaSe => 'xyz3');
$l3->put(num => '3');
$list->put(l3 => $l3);
my %matrix=(
t1 => {
template => '<%FS mode="search"' .
' base.database="/"' .
' base.clipboard="fs_cache/test_fs"' .
' uri="List"' .
' index_1="lcase"' .
' compare_1="eq"' .
' value_1="xyz1"' .
' fields="*"' .
' template="found"' .
' default.template="not found"' .
'%>',
expect => 'found',
},
t2 => {
template => '<%FS mode="search"' .
' base.database="/"' .
' base.clipboard="fs_cache/test_fs"' .
' uri="List"' .
' index_1="UCASE"' .
' compare_1="eq"' .
' value_1="xyz2"' .
' fields="*"' .
' template="found"' .
' default.template="not found"' .
'%>',
expect => 'found',
},
t3 => {
template => '<%FS mode="search"' .
' base.database="/"' .
' base.clipboard="fs_cache/test_fs"' .
' uri="List"' .
' index_1="mCaSe"' .
' compare_1="eq"' .
' value_1="xyz3"' .
' index_2="mCaSe"' .
' compare_2="eq"' .
' value_2="xyz3"' .
' expression="1 and 2"' .
' template="found"' .
' default.template="not found"' .
'%>',
expect => 'found',
},
t4 => {
template => '<%FS mode="search"' .
' base.database="/"' .
' base.clipboard="fs_cache/test_fs"' .
' uri="List"' .
' index_1="mCaSe"' .
' compare_1="eq"' .
' value_1="xyz!"' .
' index_2="mCaSe"' .
' compare_2="eq"' .
' value_2="xyz3"' .
' expression="1 and 2"' .
' template="found"' .
' default.template="not found"' .
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
},
t02 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => 'WRONG',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_count' => 1,
'/IdentifyUser/member/fail_max_count' => 3,
'/IdentifyUser/member/fail_max_count_reached' => undef,
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'A',
},
},
t03 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => 'WRONG',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_count' => 2,
'/IdentifyUser/member/fail_max_count' => 3,
'/IdentifyUser/member/fail_max_count_reached' => undef,
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'A',
},
},
t04 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => 'WRONG',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_count' => 3,
'/IdentifyUser/member/fail_max_count' => 3,
'/IdentifyUser/member/fail_max_count_reached' => undef,
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'A',
},
},
t05 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => 'WRONG',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_count' => 4,
'/IdentifyUser/member/fail_max_count' => 3,
'/IdentifyUser/member/fail_max_count_reached' => 1,
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'A',
},
},
t06 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => 'WRONG',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_count' => 4,
'/IdentifyUser/member/fail_max_count' => 3,
'/IdentifyUser/member/fail_max_count_reached' => 1,
'/IdentifyUser/member/fail_locked' => 1,
},
text => 'A',
},
},
t07 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => '12345',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_locked' => 1,
},
text => 'A',
},
},
# Success after failures expire
t08 => {
sub_pre => sub { sleep(4) },
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => '12345',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'V',
},
},
# Failing again, to see if counter drops to zero after success
t09 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => 'WRONG',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_count' => 1,
'/IdentifyUser/member/fail_max_count' => 3,
'/IdentifyUser/member/fail_max_count_reached' => undef,
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'A',
},
},
# Success after single failure
t10 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => '12345',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'V',
},
},
# failures, then success at the last moment
t11 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => 'WRONG',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_count' => 1,
'/IdentifyUser/member/fail_max_count' => 3,
'/IdentifyUser/member/fail_max_count_reached' => undef,
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'A',
},
},
t12 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => 'WRONG',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_count' => 2,
'/IdentifyUser/member/fail_max_count' => 3,
'/IdentifyUser/member/fail_max_count_reached' => undef,
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'A',
},
},
t13 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => 'WRONG',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_count' => 3,
'/IdentifyUser/member/fail_max_count' => 3,
'/IdentifyUser/member/fail_max_count_reached' => undef,
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'A',
},
},
t14 => {
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => '12345',
},
results => {
clipboard => {
'/IdentifyUser/member/fail_locked' => undef,
},
text => 'V',
},
},
);
$self->run_matrix(\%matrix,\%cjar);
}
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'check',
type => 'member',
'identified.template' => '<$CB_URI$>|<$ERRSTR$>|<$TYPE$>|<$NAME$>|<$VERIFIED$>',
},
results => {
cookies => {
member_id => 'm001',
},
text => '/IdentifyUser/member||member|m001|',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/verified' => undef,
},
},
},
#
# Checking case translation
#
t21 => {
args => {
mode => 'login',
type => 'member',
username => 'M001',
password => '12345',
},
results => {
cookies => {
member_id => 'm001',
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/name' => 'm001',
},
text => 'V',
},
},
t22 => {
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
member_id => 'm001',
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/name' => 'm001',
},
text => 'V',
},
},
);
$self->run_matrix(\%matrix,\%cjar);
}
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'logout',
type => 'member',
},
results => {
cookies => {
member_id => 'm001',
member_key => undef,
},
text => 'I',
clipboard => {
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/key' => $cjar{'member_key_1'},
},
},
},
t07 => {
sub_pre => sub {
$cjar{member_key}=$cjar{member_key_1};
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'login',
type => 'member',
username => 'N3', # Will break if collation is case-sensitive
password => '12345',
},
results => {
cookies => {
member_id => 'n3',
},
clipboard => {
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/name' => 'n3',
},
text => 'V',
},
},
t06 => {
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
member_id => 'n3',
},
clipboard => {
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/name' => 'n3',
},
text => 'V',
},
},
);
$self->run_matrix(\%matrix,\%cjar);
}
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
$config->put('/identify_user/member/id_cookie_type' => 'name');
$config->put('/identify_user/member/user_condition' => [ 'acc_type','eq','web' ]);
},
args => {
mode => 'login',
type => 'member',
username => 'TWO@bar.org',
password => '12345',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'two@bar.org',
'/IdentifyUser/member/id' => 'm002web',
},
cookies => {
member_id => 'two@bar.org',
},
text => 'V',
},
},
t18b => {
args => {
mode => 'check',
type => 'member',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'two@bar.org',
'/IdentifyUser/member/id' => 'm002web',
},
cookies => {
member_id => 'two@bar.org',
},
text => 'V',
},
},
#
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
$config->put('/identify_user/member/id_cookie_type' => 'id');
$config->put('/identify_user/member/user_condition' => [ 'acc_type','eq','web' ]);
},
args => {
mode => 'login',
type => 'member',
username => 'two@BAR.ORG',
password => '12345',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'two@bar.org',
'/IdentifyUser/member/id' => 'm002web',
},
cookies => {
member_id => 'm002web',
},
text => 'V',
},
},
t19b => {
args => {
mode => 'check',
type => 'member',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'two@bar.org',
'/IdentifyUser/member/id' => 'm002web',
},
cookies => {
member_id => 'm002web',
},
text => 'V',
},
},
#
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'login',
type => 'member',
username => 'm002web',
password => '12345',
},
results => {
cookies => {
member_id => 'm002web',
},
clipboard => {
'/IdentifyUser/member/name' => 'm002web',
'/IdentifyUser/member/id' => 'm002web',
},
text => 'V',
},
},
t20b => {
args => {
mode => 'check',
type => 'member',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'm002web',
'/IdentifyUser/member/id' => 'm002web',
},
cookies => {
member_id => 'm002web',
},
text => 'V',
},
},
#
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
member_id => undef,
});
},
args => {
mode => 'login',
type => 'member',
username => 'two@BAR.ORG',
password => '12345',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'two@bar.org',
'/IdentifyUser/member/id' => 'm002web',
},
cookies => {
member_id => 'two@bar.org',
},
text => 'V',
},
},
t23b => {
args => {
mode => 'check',
type => 'member',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'two@bar.org',
'/IdentifyUser/member/id' => 'm002web',
},
cookies => {
member_id => 'two@bar.org',
},
text => 'V', # identification from previous login
},
},
t23c => { # failure
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
member_id => undef,
});
},
args => {
mode => 'login',
type => 'member',
username => 'm002web',
password => '12345',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'm002web',
'/IdentifyUser/member/id' => 'm002web',
},
cookies => {
member_id => 'm002web',
},
text => 'V',
},
},
t23e => {
args => {
mode => 'check',
type => 'member',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'm002web',
'/IdentifyUser/member/id' => 'm002web',
},
cookies => {
member_id => 'm002web',
},
text => 'V', # identification from previous login
},
},
t23f => { # failure
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
member_id => undef,
});
},
args => {
mode => 'login',
type => 'member',
username => 'm002foo',
password => '12345',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'm002foo',
'/IdentifyUser/member/id' => 'm002foo',
},
cookies => {
member_id => 'm002foo',
},
text => 'V',
},
},
t23h => {
args => {
mode => 'check',
type => 'member',
},
results => {
clipboard => {
'/IdentifyUser/member/name' => 'm002foo',
'/IdentifyUser/member/id' => 'm002foo',
},
cookies => {
member_id => 'm002foo',
},
text => 'V', # identification from previous login
},
},
t23i => { # failure
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
type => 'member',
username => 'm001',
password => '12345',
},
results => {
cookies => {
mid => 3, # ++mkey
mkey => 2, # from the previous test
},
text => 'V',
clipboard => {
'/IdentifyUser/member/cookie_value' => '3',
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => 1,
},
},
},
t05a => {
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => 3, # from the previous test
mkey => 2, # from the previous test
},
text => 'V',
clipboard => {
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/cookie_value' => '3',
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => 1,
},
},
},
t05b => { # second call in the same session
sub_post_cleanup => sub {
my $user=$config->odb->fetch('/Members/m001');
my $key=$config->odb->fetch('/MemberKeys/3');
$config->clipboard->put('/IdentifyUser/member/object' => $user);
$config->clipboard->put('/IdentifyUser/member/key_object' => $key);
},
args => {
mode => 'check',
type => 'member',
},
results => {
text => 'V',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => 1,
},
cookies => {
mid => 3, # from the previous test
mkey => 2, # from the previous test
},
},
},
t06 => {
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => 3, # from the previous test
mkey => 2, # from the previous test
},
text => 'V',
clipboard => {
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/cookie_value' => '3', # mkey
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => 1,
},
},
},
t07 => {
cookies => {
mid => 2,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'check',
type => 'member',
},
results => {
text => 'V',
cookies => {
mid => 2,
mkey => 123, # from what's given
},
clipboard => {
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/cookie_value' => '2',
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => 1,
},
},
},
t08 => { # Providing invalid key
cookies => {
mid => 4,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => '4',
mkey => 'FOO',
},
text => 'A',
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/verified' => undef,
},
},
},
t09 => { # Second user login
cookies => {
mid => 7,
mkey => 'FOO',
},
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
type => 'member',
username => 'm002',
password => '23456',
},
results => {
cookies => {
mid => 4,
mkey => 'FOO', # Not changed because id_cookie_type==key
},
text => 'V',
clipboard => {
'/IdentifyUser/member/cookie_value' => '4',
},
},
},
t10 => {
cookies => {
mid => 1,
},
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => '1',
},
text => 'V',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/cookie_value' => 1,
'/IdentifyUser/member/id' => 'm001',
},
},
},
t11 => {
cookies => {
mid => 4,
},
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => '4',
},
text => 'V',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 4,
'/IdentifyUser/member/id' => 'm002',
},
},
},
#
# Logging out, but should stay identified as it was previously
# logged in and verified.
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
args => {
mode => 'logout',
type => 'member',
},
results => {
cookies => {
mid => '2',
},
text => 'I',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 2,
'/IdentifyUser/member/id' => 'm001',
},
fs => {
'/Members/m001/uvf_time' => '~NOW',
},
},
},
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => '1',
},
text => 'V',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 1,
'/IdentifyUser/member/id' => 'm001',
},
},
},
#
# Checking that it is still identified after soft logout
#
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => '2',
},
text => 'I',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 2,
'/IdentifyUser/member/id' => 'm001',
},
},
},
#
# Checking hard logout
#
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'logout',
type => 'member',
hard_logout => 1,
},
results => {
cookies => {
mid => undef,
},
text => 'A',
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/id' => undef,
},
fs => {
'/MemberKeys/1' => undef,
'/Members/m001/uvf_time' => '~NOW', # When no vf_time_last_prop set
},
},
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => '3',
},
text => 'V',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 3,
'/IdentifyUser/member/id' => 'm001',
},
},
},
#
# Checking timing out of sessions
#
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => '3',
},
text => 'I',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 3,
'/IdentifyUser/member/id' => 'm001',
},
},
},
#
# Switching back to name mode and checking expiration again. It
# should keep verification key by default and with
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => 'm002',
mkey => '5',
},
text => 'I',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm002',
},
},
},
t18c => {
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => 'm002',
mkey => '5',
},
text => 'I',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm002',
},
},
},
t18d => {
args => {
mode => 'login',
type => 'member',
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => 'm002',
mkey => undef,
},
text => 'I',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm002',
},
},
},
t18f => {
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => 'm002',
mkey => undef,
},
text => 'I',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm002',
},
},
},
t18g => {
args => {
mode => 'login',
type => 'member',
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mid => undef,
mkey => '6',
},
text => 'I',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => '7',
},
},
},
t19c => {
args => {
mode => 'check',
type => 'member',
},
results => {
cookies => {
mkey => '6',
},
text => 'A',
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
},
},
},
#
# Checking extended expiration
#
t20a => { # Non-extended login
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '8',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/8/verify_time' => '~NOW',
'/MemberKeys/8/expire_time' => '~NOW+2',
'/MemberKeys/8/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t20b => { # Extended login
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '9',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/9/verify_time' => '~NOW',
'/MemberKeys/9/expire_time' => '~NOW+6',
'/MemberKeys/9/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 1,
},
},
},
t21a => { # Make sure 'extended' is still OFF after 'check'ing.
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '8',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/8/verify_time' => '~NOW',
'/MemberKeys/8/expire_time' => '~NOW+2',
'/MemberKeys/8/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t21b => { # Make sure 'extended' is still ON after 'check'ing.
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '9',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/9/verify_time' => '~NOW',
'/MemberKeys/9/expire_time' => '~NOW+6',
'/MemberKeys/9/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 1,
},
},
},
t22a => { # Timing out non-extended key
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
cookies => {
mid => 'm001',
},
text => 'I',
fs => {
'/Members/m001/uvf_time' => '~NOW-3',
'/MemberKeys/8/verify_time' => '~NOW-3',
'/MemberKeys/8/expire_time' => '~NOW-1',
'/MemberKeys/8/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t22b => { # Extended should not time out in 3 seconds
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '9',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/9/verify_time' => '~NOW',
'/MemberKeys/9/expire_time' => '~NOW+6',
'/MemberKeys/9/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 1,
},
},
},
t23a => { # No change, just rechecking non-extended key
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '8', # depends on expire_mode=keep
},
text => 'I',
fs => {
'/Members/m001/uvf_time' => '~NOW', # from t22b
'/MemberKeys/8/verify_time' => '~NOW-3',
'/MemberKeys/8/expire_time' => '~NOW-1',
'/MemberKeys/8/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t23b => { # Expiring extended key
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '9',
},
text => 'I',
fs => {
'/Members/m001/uvf_time' => '~NOW-7',
'/MemberKeys/9/verify_time' => '~NOW-7',
'/MemberKeys/9/expire_time' => '~NOW-1',
'/MemberKeys/9/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 1,
},
},
},
t24a => { # No change, just rechecking non-extended key
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '8',
},
text => 'I',
fs => {
'/Members/m001/uvf_time' => '~NOW-7', # from t22b
'/MemberKeys/8/verify_time' => '~NOW-10',
'/MemberKeys/8/expire_time' => '~NOW-8',
'/MemberKeys/8/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t24b => { # No change, just rechecking
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '9',
},
text => 'I',
fs => {
'/Members/m001/uvf_time' => '~NOW-7',
'/MemberKeys/9/verify_time' => '~NOW-7',
'/MemberKeys/9/expire_time' => '~NOW-1',
'/MemberKeys/9/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 1,
},
},
},
t25a => { # "Soft" logout
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => undef,
},
text => 'I',
fs => {
'/Members/m001/uvf_time' => '~NOW-7', # from t22b
'/MemberKeys/8/verify_time' => 0,
'/MemberKeys/8/expire_time' => '~NOW-8',
'/MemberKeys/8/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => undef,
},
},
},
t25b => { # No change, just rechecking
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => undef,
},
text => 'I',
fs => {
'/Members/m001/uvf_time' => '~NOW-7',
'/MemberKeys/9/verify_time' => 0,
'/MemberKeys/9/expire_time' => '~NOW-1',
'/MemberKeys/9/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => undef,
},
},
},
t26a => { # Checking after logging out
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => undef,
},
text => 'I',
fs => {
'/Members/m001/uvf_time' => '~NOW-7', # from t22b
'/MemberKeys/8/verify_time' => 0,
'/MemberKeys/8/expire_time' => '~NOW-8',
'/MemberKeys/8/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => undef,
},
},
},
t26b => { # No change, just rechecking
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => undef,
},
text => 'I',
fs => {
'/Members/m001/uvf_time' => '~NOW-7',
'/MemberKeys/9/verify_time' => 0,
'/MemberKeys/9/expire_time' => '~NOW-1',
'/MemberKeys/9/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => undef,
},
},
},
t27a => { # Hard logout
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
results => {
cookies => {
mid => undef,
mkey => undef,
},
text => 'A',
fs => {
'/Members/m001/uvf_time' => '~NOW-7', # from t22a
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/extended' => undef,
},
},
},
t27b => { # No change, just rechecking
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
results => {
cookies => {
mid => undef,
mkey => undef,
},
text => 'A',
fs => {
'/Members/m001/uvf_time' => '~NOW-7',
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/extended' => undef,
},
},
},
t28a => { # Check after hard logout
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
results => {
cookies => {
mid => undef,
mkey => undef,
},
text => 'A',
fs => {
'/Members/m001/uvf_time' => '~NOW-7', # from t22a
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/extended' => undef,
},
},
},
t28b => { # No change, just rechecking
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
results => {
cookies => {
mid => undef,
mkey => undef,
},
text => 'A',
fs => {
'/Members/m001/uvf_time' => '~NOW-7',
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/extended' => undef,
},
},
},
t29a => { # Login after hard logout
sub_pre => sub {
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '10',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/10/verify_time'=> '~NOW',
'/MemberKeys/10/expire_time'=> '~NOW+2',
'/MemberKeys/10/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t29b => { # Extended login
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '11',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/11/verify_time'=> '~NOW',
'/MemberKeys/11/expire_time'=> '~NOW+6',
'/MemberKeys/11/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 1,
},
},
},
t30a => { # Hard logout
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
results => {
cookies => {
mid => undef,
mkey => undef,
},
text => 'A',
fs => {
'/Members/m001/uvf_time' => '~NOW', # from t29a
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/extended' => undef,
},
},
},
t30b => { # No change, just rechecking
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
results => {
cookies => {
mid => undef,
mkey => undef,
},
text => 'A',
fs => {
'/Members/m001/uvf_time' => '~NOW', # from t29b
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/extended' => undef,
},
},
},
t31a => { # Check after hard logout
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
results => {
cookies => {
mid => undef,
mkey => undef,
},
text => 'A',
fs => {
'/Members/m001/uvf_time' => '~NOW', # from t29a
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/extended' => undef,
},
},
},
t31b => { # No change, just rechecking
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
},
results => {
cookies => {
mid => undef,
mkey => undef,
},
text => 'A',
fs => {
'/Members/m001/uvf_time' => '~NOW', # from t29b
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/verified' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/extended' => undef,
},
},
},
t32a => { # Login for rolling check() testing
sub_pre => sub {
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '12',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/12/verify_time'=> '~NOW',
'/MemberKeys/12/expire_time'=> '~NOW+2',
'/MemberKeys/12/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t32c => { # Checks after "user browsing"
cookie_jar => \%cjar_a,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '12',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/12/verify_time' => '~NOW',
'/MemberKeys/12/expire_time' => '~NOW+2',
'/MemberKeys/12/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t33b => { # Extended login for rolling check() testing
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '13',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/13/verify_time'=> '~NOW',
'/MemberKeys/13/expire_time'=> '~NOW+6',
'/MemberKeys/13/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 1,
},
},
},
t33d => { # Checks after "user browsing"
cookie_jar => \%cjar_b,
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '13',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/13/verify_time' => '~NOW',
'/MemberKeys/13/expire_time' => '~NOW+6',
'/MemberKeys/13/extended' => 1,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 1,
},
},
},
t40a => { # Forced login without a password
sub_pre => sub {
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '14',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/14/verify_time'=> '~NOW',
'/MemberKeys/14/expire_time'=> '~NOW+2',
'/MemberKeys/14/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t41a => { # Sequential login without password, reuse the key
sub_pre => sub {
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '14',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/14/verify_time'=> '~NOW',
'/MemberKeys/14/expire_time'=> '~NOW+2',
'/MemberKeys/14/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
t42a => { # Sequential login with password, reuse the key
sub_pre => sub {
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mid => 'm001',
mkey => '14',
},
text => 'V',
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/MemberKeys/14/verify_time'=> '~NOW',
'/MemberKeys/14/expire_time'=> '~NOW+2',
'/MemberKeys/14/extended' => 0,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/extended' => 0,
},
},
},
#
# key_renew_mode replace/update
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
username => 'm002',
password => '23456',
without_cookies => 1,
},
results => {
text => 'V',
cookies => {
mid => 'm002',
mkey => '16',
},
clipboard => {
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm002',
'/IdentifyUser/member/id' => 'm002',
'/IdentifyUser/member/key' => '17',
},
},
},
t51b => {
sub_pre => sub {
$config->put('/identify_user/member/id_cookie_type' => 'id');
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
username => 'm001',
password => '12345',
without_cookies => 1,
},
results => {
text => 'V',
cookies => {
mid => 'm002',
mkey => '16',
},
clipboard => {
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/key' => '18',
},
},
},
t51c => {
args => {
mode => 'check',
type => 'member',
without_cookies => 1,
},
results => {
text => 'A',
cookies => {
mid => 'm002',
mkey => '16',
},
clipboard => {
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/id' => undef,
'/IdentifyUser/member/key' => undef,
},
},
},
t51d => {
args => {
mode => 'check',
type => 'member',
without_cookies => 1,
id_cookie_value => 'm001',
},
results => {
text => 'I',
cookies => {
mid => 'm002',
mkey => '16',
},
clipboard => {
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/key' => undef,
},
},
},
t51e => {
args => {
mode => 'check',
type => 'member',
without_cookies => 1,
id_cookie_value => 'm001',
key_cookie_value=> 18,
},
results => {
text => 'V',
cookies => {
mid => 'm002',
mkey => '16',
},
clipboard => {
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/key' => '18',
},
},
},
t51f => {
args => {
mode => 'check',
type => 'member',
},
results => {
text => 'V',
cookies => {
mid => 'm002',
mkey => '16',
},
clipboard => {
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm002',
'/IdentifyUser/member/id' => 'm002',
'/IdentifyUser/member/key' => '16',
},
},
},
t51g => {
args => {
mode => 'logout',
type => 'member',
without_cookies => 1,
},
results => {
text => 'A',
cookies => {
mid => 'm002',
mkey => '16',
},
clipboard => {
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/id' => undef,
'/IdentifyUser/member/key' => undef,
},
},
},
t51h => {
args => {
mode => 'logout',
type => 'member',
without_cookies => 1,
id_cookie_value => 'm001',
key_cookie_value=> 18,
},
results => {
text => 'I',
cookies => {
mid => 'm002',
mkey => '16',
},
clipboard => {
'/IdentifyUser/member/object' => { },
#'/IdentifyUser/member/key_object' => { },
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/key' => undef,
},
},
},
t51i => {
args => {
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
id_cookie_value => 'm001',
key_cookie_value=> 18,
hard_logout => 1,
},
results => {
text => 'A',
cookies => {
mid => 'm002',
mkey => '16',
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/id' => undef,
'/IdentifyUser/member/key' => undef,
},
},
},
t51j => {
args => {
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
type => 'member',
id_cookie_value => 'm001',
key_cookie_value=> 18,
},
results => {
text => 'I',
cookies => {
mid => 'm002',
mkey => undef,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/key_object' => undef,
'/IdentifyUser/member/name' => 'm002',
'/IdentifyUser/member/id' => 'm002',
'/IdentifyUser/member/key' => undef,
},
},
},
t51k => {
args => {
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
without_cookies => 1,
id_cookie_value => 'm001',
key_cookie_value=> 18,
},
results => {
text => 'I',
cookies => {
mid => 'm002',
mkey => undef,
},
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/key' => undef,
},
},
},
#
# Persistent 'last-login' time in 'vf_time_last_prop', not
# cleared in logout.
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
$config->put('/identify_user/member/vf_time_last_prop' => 'lvf_time');
},
args => {
mode => 'login',
type => 'member',
username => 'm001',
password => '12345',
},
results => {
text => 'V',
clipboard => {
'/IdentifyUser/member/verified' => 1,
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/id' => 'm001',
'/IdentifyUser/member/key' => '19',
},
fs => {
'/Members/m001/uvf_time' => '~NOW',
'/Members/m001/lvf_time' => '~NOW',
},
},
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
args => {
mode => 'logout',
type => 'member',
},
cookies => {
mid => 'm001',
mkey => '19',
},
results => {
text => 'I',
clipboard => {
'/IdentifyUser/member/object' => { },
'/IdentifyUser/member/name' => 'm001',
'/IdentifyUser/member/id' => 'm001',
},
fs => {
'/Members/m001/uvf_time' => 0,
'/Members/m001/lvf_time' => '~NOW',
},
},
},
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
cookies => {
mid => 'm001',
mkey => '19',
},
results => {
text => 'A',
cookies => {
mid => undef,
mkey => undef,
},
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/id' => undef,
},
fs => {
'/Members/m001/uvf_time' => 0,
'/Members/m001/lvf_time' => '~NOW',
},
},
},
t52d => {
args => {
mode => 'check',
type => 'member',
},
cookies => {
},
results => {
text => 'A',
clipboard => {
'/IdentifyUser/member/object' => undef,
'/IdentifyUser/member/name' => undef,
'/IdentifyUser/member/id' => undef,
},
fs => {
'/Members/m001/uvf_time' => 0,
'/Members/m001/lvf_time' => '~NOW',
},
},
},
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
mode => 'login',
type => $type,
username => $email,
password => $pwplain,
},
results => {
cookies => {
member_id => $email,
},
text => 'V',
clipboard => {
"/IdentifyUser/$type/object" => { },
"/IdentifyUser/$type/name" => $email,
"/IdentifyUser/$type/verified" => 1,
},
},
},
sprintf('t%02u_b_%s_%s',$tnum,$code,$type) => {
args => {
mode => 'check',
type => $type,
},
results => {
cookies => {
member_id => $email,
},
text => 'V',
clipboard => {
"/IdentifyUser/$type/object" => { },
"/IdentifyUser/$type/name" => $email,
"/IdentifyUser/$type/verified" => 1,
},
},
},
sprintf('t%02u_c_%s_%s',$tnum,$code,$type) => {
args => {
mode => 'login',
type => $type,
username => $email,
password => substr($password,0,-1),
},
results => {
clipboard => {
"/IdentifyUser/$type/object" => undef,
"/IdentifyUser/$type/name" => undef,
"/IdentifyUser/$type/verified" => undef,
},
},
},
sprintf('t%02u_d_%s_%s',$tnum,$code,$type) => {
args => {
mode => 'check',
type => $type,
},
results => {
clipboard => {
"/IdentifyUser/$type/object" => { },
"/IdentifyUser/$type/name" => $email,
"/IdentifyUser/$type/verified" => undef,
},
text => 'I',
},
},
) } @$types;
} (
[ 'md5_bare', $password, $md5_bare, [qw(member member_md5_sha1 member_pepper)] ],
t/testcases/Web/WebIdentifyUser.pm view on Meta::CPAN
$self->assert($wcjar->{$cname} eq $expect,
"$tname - cookie=$cname, expected $expect, got $wcjar->{$cname}");
}
else {
$self->assert(!defined($wcjar->{$cname}),
"$tname - cookie=$cname, expected nothing, got ".($wcjar->{$cname} || ''));
}
}
}
if(exists $results->{clipboard}) {
my $cb=$config->clipboard;
foreach my $cname (keys %{$results->{clipboard}}) {
my $expect=$results->{clipboard}->{$cname};
my $got=$cb->get($cname);
if(defined $expect) {
$self->assert(defined($got),
"$tname - clipboard=$cname, expected $expect, got nothing");
if(ref($expect)) {
$self->assert(ref($got),
"$tname - clipboard=$cname, expected a ref, got $got");
}
else {
$self->assert($got eq $expect,
"$tname - clipboard=$cname, expected $expect, got $got");
}
}
else {
$self->assert(!defined($got),
"$tname - clipboard=$cname, expected nothing, got ".($got || ''));
}
}
}
my $parseval=sub($) {
my $t=shift;
if ($t=~/^NOW\+(\d+)$/) { return time+$1; }
elsif($t=~/^NOW-(\d+)$/) { return time-$1; }
elsif($t=~/^NOW$/) { return time; }
elsif($t=~/^\d+$/) { return $t; }
t/xao/templates/bits/test-non-cacheable view on Meta::CPAN
<!-- This won't get cached because of external clipboard dependence
-->[<%Clipboard name='test_clipboard'%>]<%End%>
( run in 2.833 seconds using v1.01-cache-2.11-cpan-81fc1098f69 )