The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package App::Office::CMS::Database;

use Any::Moose;
use common::sense;

use App::Office::CMS::Database::Asset;
use App::Office::CMS::Database::Content;
use App::Office::CMS::Database::Design;
use App::Office::CMS::Database::Event;
use App::Office::CMS::Database::Menu;
use App::Office::CMS::Database::Page;
use App::Office::CMS::Database::Site;
use App::Office::CMS::Util::Config;
use App::Office::CMS::Util::Logger;

use DBI;

use DBIx::Admin::CreateTable;

use DBIx::Simple;

use File::Slurp; # For read_file.

use Try::Tiny;

has asset =>
(
	is  => 'rw',
	isa => 'App::Office::CMS::Database::Asset',
);

has config =>
(
	is  => 'rw',
	isa => 'HashRef',
);

has content =>
(
	is  => 'rw',
	isa => 'App::Office::CMS::Database::Content',
);

has dbh =>
(
	is  => 'rw',
	isa => 'Any',
);

has design =>
(
	is  => 'rw',
	isa => 'App::Office::CMS::Database::Design',
);

has event =>
(
	is  => 'rw',
	isa => 'App::Office::CMS::Database::Event',
);

has event_type_name2id_map =>
(
 is  => 'rw',
 isa => 'HashRef',
);

has logger =>
(
	is  => 'rw',
	isa => 'Any',
);

has menu =>
(
	is  => 'rw',
	isa => 'App::Office::CMS::Database::Menu',
);

has page =>
(
	is  => 'rw',
	isa => 'App::Office::CMS::Database::Page',
);

has session =>
(
	is  => 'rw',
	isa => 'Any',
);

has simple =>
(
	is  => 'rw',
	isa => 'Any',
);

has site =>
(
	is  => 'rw',
	isa => 'App::Office::CMS::Database::Site',
);

# If Moose...
#use namespace::autoclean;

our $VERSION = '0.92';

# -----------------------------------------------

sub BUILD
{
	my($self)   = @_;
	my($config) = $self -> config;
	my($attr)   =
	{
		AutoCommit => $$config{AutoCommit},
		RaiseError => $$config{RaiseError},
	};

	if ( ($$config{dsn} =~ /SQLite/i) && $$config{sqlite_unicode})
	{
		$$attr{sqlite_unicode} = 1;
	}

	$self -> dbh(DBI -> connect($$config{dsn}, $$config{username}, $$config{password}, $attr) );

=pod

use Modern::Perl;
use DBI;
use Exception::Class::DBI;

my $dbh = DBI->connect('DBI:mysql:test', 'user', pass, {
PrintError => 0,
RaiseError => 0,
HandleError => Exception::Class::DBI->handler,
});


eval {
$dbh->do('insert into non_extistent_table values(1)')
};

if (my $e = Exception::Class->caught('Exception::Class::DBI')) {
say $e->err;
say $e->errstr;
} else {
# Check for other exceptions as required
}

=cut

	if ($$config{dsn} =~ /SQLite/i)
	{
		$self -> dbh -> do('PRAGMA foreign_keys = ON');
	}

	$self -> asset(App::Office::CMS::Database::Asset -> new(db => $self) );
	$self -> content(App::Office::CMS::Database::Content -> new(db => $self) );
	$self -> design(App::Office::CMS::Database::Design -> new(db => $self) );
	$self -> event(App::Office::CMS::Database::Event -> new(db => $self) );
	$self -> logger(App::Office::CMS::Util::Logger -> new(db => $self) );
	$self -> menu(App::Office::CMS::Database::Menu -> new(db => $self) );
	$self -> page(App::Office::CMS::Database::Page -> new(db => $self) );
	$self -> simple(DBIx::Simple -> new($self -> dbh) );
	$self -> site(App::Office::CMS::Database::Site -> new(db => $self) );

	return $self;

}	# End of BUILD.

# --------------------------------------------------

sub build_context
{
	my($self, $site_id, $design_id) = @_;

	$self -> log(debug => "build_context($site_id, $design_id)");

	return "$site_id/$design_id";

} # End of build_context.

# --------------------------------------------------

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

	$self -> log(debug => 'build_default_asset()');

	my($home_asset) = ${$self -> config}{homepage_template};
	my($asset_type) = $self -> asset -> get_asset_types;
	$asset_type     = [grep{$$_{file_name} =~ /$home_asset/} @$asset_type];

	if ($#$asset_type != 0)
	{
		die "Error: asset_types table must have precisely one template called '$home_asset'";
	}

	# Note: Hide $asset_path from user.

	try
	{
		my($asset_path) = ${$self -> config}{page_template_path} . "/$home_asset";
		my($asset)      = read_file($asset_path);
	}
	catch
	{
		die "Error: Homepage template file '$home_asset' is missing";
	};

	return
	{
		asset_type_id => $$asset_type[0]{id},
		design_id     => $$page{design_id},
		page_id       => $$page{id}, # For a default page, this is undef.
		site_id       => $$page{site_id},
	};

} # End of build_default_asset.

# --------------------------------------------------

sub build_default_content
{
	my($self, $site_id, $design_id, $page_id) = @_;

	$self -> log(debug => "build_default_content($site_id, $design_id, $page_id)");

	return
	{
		body_text => '',
		design_id => $design_id,
		head_text => '',
		page_id   => $page_id,
		site_id   => $site_id,
	};

} # End of build_default_content.

# --------------------------------------------------

sub build_default_design
{
	my($self, $site_id, $name, $menu_orientation_id, $os_type_id, $output_directory, $output_doc_root) = @_;

	$self -> log(debug => "build_default_design($site_id, $name, ...)");

	return
	{
		menu_orientation_id => $menu_orientation_id,
		os_type_id          => $os_type_id,
		output_directory    => $output_directory,
		output_doc_root     => $output_doc_root,
		name                => $name,
		site_id             => $site_id,
	};

} # End of build_default_design.

# --------------------------------------------------

sub build_default_page
{
	my($self, $site, $design, $name) = @_;

	$self -> log(debug => "build_default_page($$site{name}, $$design{name}, $name)");

	return
	{
		context      => '', # Filled in by Database::Page.add() or .update().
		design_id    => $$design{id},
		design_name  => $$design{name},
		homepage     => 'No',
		name         => $name,
		site_id      => $$site{id},
		site_name    => $$site{name},
	};

} # End of build_default_page.

# --------------------------------------------------

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

	$self -> log(debug => "build_default_site($name)");

	return
	{
		name => $name,
	};

} # End of build_default_site.

# --------------------------------------------------

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

	$self -> event_type_name2id_map($self -> get_name2id_map('event_types') );

} # End of build_event_type_name_map.

# --------------------------------------------------
# Copied from File::Spec.

sub get_default_os_type_id
{
	my($self)        = @_;
	my($name2id_map) = $self -> get_name2id_map('os_types');
	my(%type)        =
		(
		 MacOS   => 'Mac',
		 MSWin32 => 'Win32',
		 os2     => 'OS2',
		 VMS     => 'VMS',
		 epoc    => 'Epoc',
		 NetWare => 'Win32', # Yes, File::Spec::Win32 works on NetWare.
		 symbian => 'Win32', # Yes, File::Spec::Win32 works on symbian.
		 dos     => 'OS2',   # Yes, File::Spec::OS2 works on DJGPP.
		 cygwin  => 'Cygwin',
		);

	return $$name2id_map{$type{$^O} || 'Unix'};

} # End of get_default_os_type_id.

# --------------------------------------------------

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

	return $self -> simple -> query('select count(*) from designs') -> list;

} # End of get_design_count.

# --------------------------------------------------

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

	return $self -> select_map("select id, name from $table_name");

} # End of get_id2name_map.

# --------------------------------------------------

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

	return [$self -> simple -> query('select * from menu_orientations') -> hashes];

} # End of get_menu_orientations.

# --------------------------------------------------

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

	return $self -> select_map("select name, id from $table_name");

} # End of get_name2id_map.

# --------------------------------------------------

sub get_os_type
{
	my($self, $os_type_id) = @_;
	my($id2name_map) = $self -> get_id2name_map('os_types');

	return $$id2name_map{$os_type_id};

} # End of get_os_type.

# --------------------------------------------------

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

	return $self -> simple -> query('select count(*) from designs') -> list;

} # End of get_page_count.

# --------------------------------------------------

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

	return $self -> simple -> query('select count(*) from sites') -> list;

} # End of get_site_count.

# -----------------------------------------------

sub insert_hash
{
	my($self, $table_name, $field_values) = @_;

	$self -> log(debug => "insert_hash($table_name)");

	my(@fields) = sort keys %$field_values;
	my(@values) = @{$field_values}{@fields};
	my($sql)    = sprintf 'insert into %s (%s) values (%s)', $table_name, join(',', @fields), join(',', ('?') x @fields);

	$self -> dbh -> do($sql, {}, @values);

	$self -> log(debug => 'Record inserted');

} # End of insert_hash.

# -----------------------------------------------

sub insert_hash_get_id
{
	my($self, $table_name, $field_values) = @_;

	$self -> log(debug => "insert_hash_get_id($table_name)");

	$self -> insert_hash($table_name, $field_values);
	$self -> last_insert_id($table_name);

} # End of insert_hash_get_id.

# -----------------------------------------------

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

	return $self -> dbh -> last_insert_id(undef, undef, $table_name, undef);

} # End of last_insert_id.

# --------------------------------------------------

sub log
{
	my($self, $level, $s) = @_;

	$self -> logger -> log($level, $s);

} # End of log;

# -----------------------------------------------

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

	return {@{$self -> dbh -> selectcol_arrayref($sql, {Columns=>[1, 2]}) } };

} # End of select_map.

# -----------------------------------------------

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

	$self -> session($session);

} # End of set_session.

# --------------------------------------------------

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

	$self -> log(debug => 'validate_asset_type()');

	my($id) = $self -> dbh -> selectrow_hashref('select id from asset_types where id = ?', {}, $value);

	return $id ? $$id{id} : 0;

} # End of validate_asset_type.

# --------------------------------------------------

sub validate_id
{
	my($self, $class_name, $id) = @_;

	$self -> log(debug => "validate_id($class_name, $id)");

	my(@row) = $self -> simple -> map({id => $id});

	return $#row < 0 ? 0 : 1;

} # End of validate_id.

# --------------------------------------------------

no Any::Moose;

# If Moose...
#__PACKAGE__ -> meta -> make_immutable;

1;