view release on metacpan or  search on metacpan

lib/XAO/DO/Web/Config.pm  view on Meta::CPAN

=head1 NAME

XAO::DO::Web::Config - XAO::Web site configuration object

=head1 SYNOPSIS

 sub init {
     my $self=shift;

     my $webconfig=XAO::Objects->new(objname => 'Web::Config');

     $self->embed(web => $webconfig);
 }

=head1 DESCRIPTION

This object provides methods specifically for XAO::Web objects. It is
supposed to be embedded into XAO::DO::Config object by a web server
handler when site is initialized.

=cut

###############################################################################
package XAO::DO::Web::Config;
use warnings;
use strict;
use CGI::Cookie;
use POSIX qw(mktime);
use XAO::Cache;
use XAO::Errors qw(XAO::DO::Web::Config);
use XAO::Objects;
use XAO::Utils;

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 ($$);
sub header_printed ($);
sub header_remove ($@);
sub new ($@);

###############################################################################

=head1 METHODS

=over

=cut

###############################################################################

sub _cookie_config ($$) {
    my ($self,$cookie_name)=@_;

    my $defaults;

    my $base_config=$self->base_config;
    if($base_config && $base_config->can('get')) {
        if(my $cookie_config=$base_config->get('/xao/cookie')) {
            foreach my $cf ($cookie_config->{'common'}, (exists $cookie_config->{$cookie_name} ? ($cookie_config->{$cookie_name}) : ())) {
                $cf || next;

                foreach my $n (keys %$cf) {
                    my $nn=$n =~ /^-/ ? $n : '-'.lc($n);
                    $defaults->{$nn}=$cf->{$n};
                }
            }
        }
    }

    return $defaults;
}

###############################################################################

=item add_cookie (@)

Adds an HTTP cookie into the internal list. Parameters are a hash in the
same format as for CGI->cookie() method (see L<CGI>).

If a cookie with the same name, path (and domain if set) is already in
the list from a previous call to add_cookie() then it gets replaced.

Think of it as if you are adding cookies to you final HTTP response as
XAO::Web handler will get all the cookies collected during template
processing and send them out for you.

lib/XAO/DO/Web/Config.pm  view on Meta::CPAN

            next unless
                $cnew->name() eq $cstored->name() &&
                $cnew->path() eq $cstored->path() &&
                ((!defined($dnew) && !defined($dstored)) || (defined($dnew) && defined($dstored) && $dnew eq $dstored));

            ### dprint "....override!";

            $self->{'cookies'}->[$i]=$cookie;

            return $cookie;
        }
    }

    push(@{$self->{'cookies'}},$cookie);

    return $cookie;
}

###############################################################################

=item cgi (;$)

Returns or sets standard CGI object (see L<CGI>). In future versions this
would probably be converted to CGI::Lite or something similar, so do not
rely to much on the functionality of CGI.

Obviously you should not call this method to set CGI object unless you
are 100% sure you know what you're doing. And even in that case you have
to call enable_special_access() in advance.

Example:

 my $cgi=$self->cgi;
 my $name=$cgi->param('name');

Or just:

 my $name=$self->cgi->param('name');

=cut

sub cgi ($$) {
    my ($self,$newcgi)=@_;

    return $self->{'cgi'} unless $newcgi;

    if($self->{'special_access'}) {
        $self->{'cgi'}=$newcgi;
        return $newcgi;
    }

    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

sub cookies ($) {
    my $self=shift;

    my @baked;
    foreach my $c (@{$self->{'cookies'}}) {
        if(ref($c) && ref($c) eq 'HASH') {
            push @baked,CGI::Cookie->new(%{$c});
        }
        else {
            push @baked,$c;
        }
    }

    return \@baked;
}

###############################################################################

=item disable_special_access ()

Disables use of cgi() method to set a new value.

=cut

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.

Example:

 $config->enable_special_access();
 $config->cgi(CGI->new());
 $config->disable_special_access();

=cut

sub enable_special_access ($) {
    my $self=shift;
    $self->{special_access}=1;
}

###############################################################################

=item force_byte_output ()

If the site is configured to run in character mode it might still be
necessary to output some content as is, without character processing
(e.g. for generated images or spreadsheets).

This method is called automatically when content type is set to a
non-text value, so normally there is no need to call it directly.

=cut

sub force_byte_output ($;$) {
    my ($self,$value)=@_;
    if(defined $value) {
        $self->{'force_byte_output'}=$value;
    }
    return $self->{'force_byte_output'};
}

###############################################################################

=item header (@)

Returns HTTP header. The same as $cgi->header and accepts the same
parameters. Cookies added before by add_cookie() method are also
included in the header.

Returns header only once, on subsequent calls returns undef.

B<NOTE:> In mod_perl environment CGI will send the header itself and
return empty string. Be carefull to check the result for
C<if(defined($header))> instead of just C<if($header)>!

As with the most of Web::Config methods you do not need this method