ClearPress::decorator - HTML site-wide header & footer handling

  my $sValue = $oDecorator->defaults($sKey);

  my @aFields = $oDecorator->fields();

  $oDecorator->cookie(@aCookies);
  my @aCookies = $oDecorator->cookie();

  my $sHTTPHeaders = $oDecorator->http_header();

  Subclass and extend this method to provide consistent site-branding

  my $sHTMLHeader = $oDecorator->site_header();

  my $sHTMLFooter = $oDecorator->site_footer

  my $sUsername = $oDecorator->username();

  $oDecorator->cgi($oCGI);

  my $oCGI = $oDecorator->cgi();

  my $hrSession = $oDecorator->session();

 This will not do any session handling until subclassed and overridden for a specific environment/service.

 This will not do any session handling until subclassed and overridden for a specific environment/service.

#########
# Author:        rmp
# Maintainer:    $Author: zerojinx $
# Created:       2007-06-07
# Last Modified: $Date: 2011-01-28 14:14:01 +0000 (Fri, 28 Jan 2011) $
# Id:            $Id: decorator.pm 399 2011-01-28 14:14:01Z zerojinx $
# Source:        $Source: /cvsroot/clearpress/clearpress/lib/ClearPress/decorator.pm,v $
# $HeadURL: https://clearpress.svn.sourceforge.net/svnroot/clearpress/trunk/lib/ClearPress/decorator.pm $
#
package ClearPress::decorator;
use strict;
use warnings;
use CGI qw(param);
use base qw(Class::Accessor);
use Readonly;

our $VERSION  = do { my ($r) = q$LastChangedRevision: 399 $ =~ /(\d+)/smx; $r; };
our $DEFAULTS = {
		 'meta_content_type' => 'text/html',
		 'meta_version'      => '0.1',
		 'meta_description'  => q[],
		 'meta_author'       => q$Author: zerojinx $,
		 'meta_keywords'     => q[clearpress],
		 'username'          => q[],
		 'charset'           => q[iso8859-1],
		};

Readonly::Scalar our $PROCESS_COMMA_YES => 1;
Readonly::Scalar our $PROCESS_COMMA_NO  => 2;
our $ARRAY_FIELDS = {
		     'jsfile'     => $PROCESS_COMMA_YES,
		     'rss'        => $PROCESS_COMMA_YES,
		     'atom'       => $PROCESS_COMMA_YES,
		     'stylesheet' => $PROCESS_COMMA_YES,
		     'script'     => $PROCESS_COMMA_NO,
		    };
__PACKAGE__->mk_accessors(__PACKAGE__->fields());

sub fields {
  return qw(title stylesheet style jsfile script atom rss
            meta_keywords meta_description meta_author meta_version
            meta_refresh meta_cookie meta_content_type meta_expires
            onload onunload onresize username charset);
}

sub get {
  my ($self, $field) = @_;

  if($ARRAY_FIELDS->{$field}) {
    my $val = $self->{$field} || $DEFAULTS->{$field} || [];
    if(!ref $val) {
      $val = [$val];
    }

    if($ARRAY_FIELDS->{$field} == $PROCESS_COMMA_YES) {
      return [map { split /,/smx, $_ } @{$val}];
    } else {
      return $val;
    }


  } else {
    return $self->{$field} || $DEFAULTS->{$field};
  }
}

sub defaults {
  my ($self, $key) = @_;
  return $DEFAULTS->{$key};
}

sub new {
  my ($class, $ref) = @_;
  if(!$ref) {
    $ref = {};
  }
  bless $ref, $class;
  return $ref;
}

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

  return $self->http_header() . $self->site_header();
}

sub cookie {
  my ($self, @cookies) = @_;

  if(scalar @cookies) {
    $self->{'cookie'} = \@cookies;
  }

  return @{$self->{'cookie'}||[]};
}

sub http_header {
  my $self    = shift;
  my @cookies = grep { $_ } ($self->cookie());
  my $charset = $self->charset;
  my @headers = (qq[Content-type: text/html; charset=$charset],
                 map {
                   "Set-Cookie: $_";
                 } @cookies);
  return join "\n", @headers, "\n";
}

sub site_header {
  my ($self) = @_;
  my $cgi    = $self->cgi();

  my $ss = qq(@{[map {
        qq(    <link rel="stylesheet" type="text/css" href="$_" />);
    } grep { $_ } @{$self->stylesheet()}]});

  if($self->style()) {
    $ss .= q(<style type="text/css">). $self->style() .q(</style>);
  }

  my $rss = qq(@{[map {
        qq(    <link rel="alternate" type="application/rss+xml" title="RSS" href="$_" />\n);
    } grep { $_ } @{$self->rss()}]});

  my $atom = qq(@{[map {
        qq(    <link rel="alternate" type="application/atom+xml" title="ATOM" href="$_" />\n);
    } grep { $_ } @{$self->atom()}]});

  my $js = qq(@{[map {
        qq(    <script type="text/javascript" src="@{[$cgi->escapeHTML($_)]}"></script>\n);
    } grep { $_ } @{$self->jsfile()}]});

  my $script = qq(@{[map {
        qq(    <script type="text/javascript">$_</script>\n);
    } grep { $_ } @{$self->script()}]});

  my $onload   = (scalar $self->onload())   ? qq( onload="@{[  join q(;), $self->onload()]}")   : q[];
  my $onunload = (scalar $self->onunload()) ? qq( onunload="@{[join q(;), $self->onunload()]}") : q[];
  my $onresize = (scalar $self->onresize()) ? qq( onresize="@{[join q(;), $self->onresize()]}") : q[];
  return qq(<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en-gb">
    <head>
        <meta http-equiv="Content-Type" content="@{[$self->meta_content_type() || $self->defaults('meta_content_type')]}" />
@{[(scalar $self->meta_cookie())?(map { qq( <meta http-equiv="Set-Cookie" content="$_" />\n) } $self->meta_cookie()):q[]]}@{[$self->meta_refresh()?qq(<meta http-equiv="Refresh" content="@{[$self->meta_refresh()]}" />):q[]]}@{[$self->meta_expires()?qq(<meta http-equiv="Expires" content="@{[$self->meta_expires()]}" />):q[]]}    <meta name="author"      content="@{[$self->meta_author()      || $self->defaults('meta_author')]}" />
        <meta name="version"     content="@{[$self->meta_version()     || $self->defaults('meta_version')]}" />
        <meta name="description" content="@{[$self->meta_description() || $self->defaults('meta_description')]}" />
        <meta name="keywords"    content="@{[$self->meta_keywords()    || $self->defaults('meta_keywords')]}" />
        <title>@{[$self->title || 'ClearPress Application']}</title>
$ss$rss$atom$js$script  </head>
    <body$onload$onunload$onresize>\n);
}

sub footer {
  return q(  </body>
</html>);
}

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

  if($cgi) {
    $self->{cgi} = $cgi;

  } elsif(!$self->{cgi}) {
    $self->{cgi} = CGI->new();
  }

  return $self->{cgi};
}

sub session {
  return {};
}

sub save_session {
  return;
}

1;
__END__