Ron Savage

use strict;
use warnings;

use DBIx::Connector;

use Local::Config;
use Local::Logger;

use Moose;

has config =>
(
default => sub{ return Local::Config -> new(module_name => 'Local::Wines') -> get_config },
is => 'rw',
isa => 'HashRef',
required => 0,
);

has connector =>
(
is => 'rw',
isa => 'Any',
required => 0,
);

has logger =>
(
is => 'rw',
isa => 'Local::Logger',
required => 0,
);

use namespace::autoclean;

our $VERSION = '1.19';

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

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 -> connector
(
DBIx::Connector -> new($$config{dsn}, $$config{username}, $$config{password}, $attr)
);

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

$self -> logger
(
Local::Logger -> new(config => $config)
);

} # End of BUILD.

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

__PACKAGE__ -> meta -> make_immutable;

use strict;
use warnings;

use DBIx::Admin::CreateTable;

use Moose;

extends 'Local::Wines::Base';

has creator =>
(
is => 'rw',
isa => 'DBIx::Admin::CreateTable',
required => 0,
);

has engine =>
(
is => 'rw',
isa => 'Str',
required => 0,
);

has time_option =>
(
is => 'rw',
isa => 'Str',
required => 0,
);

use namespace::autoclean;

our $VERSION = '1.19';

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

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

$self -> creator
(
DBIx::Admin::CreateTable -> new
(
dbh => $self -> connector -> dbh,
verbose => 0,
)
);

$self -> engine
(
$self -> creator -> db_vendor =~ /(?:Mysql)/i ? 'engine=innodb' : ''
);

$self -> time_option
(
$self -> creator -> db_vendor =~ /(?:MySQL|Postgres)/i ? '(0) without time zone' : ''
);

} # End of BUILD.

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

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

# Warning: The order is important.

my($method);
my($table_name);

for $table_name (qw/
log
sessions
grapes
styles
vineyards
wine_makers
wines
/)
{
$method = "create_${table_name}_table";

$self -> $method;
}

return 0;

} # End of create_all_tables.

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

sub create_grapes_table
{
my($self) = @_;
my($table_name) = 'grapes';
my($primary_key) = $self -> creator -> generate_primary_key_sql($table_name);
my($engine) = $self -> engine;
my($result) = $self -> creator -> create_table(< create table $table_name
(
id $primary_key,
name varchar(255) not null,
upper_name varchar(255) not null
) $engine
SQL
$self -> report($table_name, 'created', $result);

} # End of create_grapes_table.

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

sub create_log_table
{
my($self) = @_;
my($table_name) = 'log';
my($primary_key) = $self -> creator -> generate_primary_key_sql($table_name);
my($engine) = $self -> engine;
my($time_option) = $self -> time_option;
my($result) = $self -> creator -> create_table(< create table $table_name
(
id $primary_key,
level varchar(9) not null,
message varchar(255) not null,
timestamp timestamp $time_option not null default current_timestamp
) $engine
SQL
$self -> report($table_name, 'created', $result);

} # End of create_log_table.

# Etc, etc.

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

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

my($table_name);

for $table_name (qw/
wines
wine_makers
vineyards
styles
grapes
sessions
log
/)
{
$self -> drop_table($table_name);
}

return 0;

} # End of drop_all_tables.

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

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

$self -> creator -> drop_table($table_name);

} # End of drop_table.

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

sub report
{
my($self, $table_name, $message, $result) = @_;

if ($result)
{
die "Table '$table_name' $result. \n";
}
else
{
$self -> logger -> log(debug => "Table '$table_name' $message");
}

} # End of report.

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

__PACKAGE__ -> meta -> make_immutable;

use strict;
use warnings;

use DBIx::Class::Schema::Loader 'make_schema_at';

use Local::Config;

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

my($config) = Local::Config -> new(module_name => 'Local::Wines') -> get_config;

use strict;
use warnings;

use Local::Wines::Database;
use Local::Wines::Schema;

use Moose;

extends 'Local::Wines::Base';

has db =>
(
is => 'rw',
isa => 'Local::Wines::Database',
required => 0,
);

has schema =>
(
is => 'rw',
isa => 'Local::Wines::Schema',
required => 0,
);

use namespace::autoclean;

our $VERSION = '1.19';

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

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

$self -> schema
(
Local::Wines::Schema -> connect(sub{return $self -> connector -> dbh})
);

} # End of BUILD.

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

__PACKAGE__ -> meta -> make_immutable;

use Moose;

extends 'Local::Wines::Database::Base';

use strict;
use warnings;

use Local::Wines::Database::Export;

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

use CGI;

use Local::Wines::Database;

use Moose;

use Text::CSV_XS;

use Text::Xslate;

extends 'Local::Wines::Database::Base';

has whole_page =>
(
default => 0,
is => 'rw',
isa => 'Any',
required => 0,
);

use namespace::autoclean;

our $VERSION = '1.19';

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

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

$self -> db
(
Local::Wines::Database -> new
(
query => CGI -> new,
)
);

} # End of BUILD.

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

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

my(@row);

push @row,
[
'wine_maker', 'vineyard', 'style', 'grape', 'comment', 'vintage', 'rating', 'review_date',
];

for my $wine (@{$self -> read_wines_table})
{
push @row,
[
$$wine{wine_maker},
$$wine{vineyard},
$$wine{style},
$$wine{grape},
$$wine{comment},
$$wine{vintage},
$$wine{rating},
$$wine{review_date},
];
}

for (@row)
{
print '"', join('","', @$_), '"', "\n";
}

} # End of as_csv.

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

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

my(@row);

push @row,
[
{td => 'Wine maker'},
{td => 'Vineyard'},
{td => 'Style'},
{td => 'Grape'},
{td => 'Comment'},
{td => 'Vintage'},
{td => 'Rating'},
{td => 'Reviewed'},
];

my($wine);

for $wine (@{$self -> read_wines_table})
{
push @row,
[
{td => $$wine{wine_maker} },
{td => $$wine{vineyard} },
{td => $$wine{style} },
{td => $$wine{grape} },
{td => $$wine{comment} },
{td => $$wine{vintage} },
{td => $$wine{rating} },
{td => $$wine{review_date} },
];
}

push @row,
[
{td => 'Wine maker'},
{td => 'Vineyard'},
{td => 'Style'},
{td => 'Grape'},
{td => 'Comment'},
{td => 'Vintage'},
{td => 'Rating'},
{td => 'Reviewed'},
];

my($tx) = Text::Xslate -> new
(
input_layer => '',
path => ${$self -> config}{template_path},
);

return $tx -> render
(
$self -> whole_page ? 'whole.page.tx' : 'basic.table.tx',
{
row => \@row
}
);

} # End of as_html.

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

sub read_wines_table
{
my($self) = @_;
my($rs) = $self -> schema -> resultset('Wine');

my($date);
my(@wine);

while (my $result = $rs -> next)
{
$date = substr($result -> review_date, 0, 10);

push @wine,
{
comment => $result -> comment || '',
grape => $result -> grape -> name,
rating => $result -> rating,
review_date => $date eq '1900-01-01' ? '-' : $date,
style => $result -> style -> name || '',
vineyard => $result -> vineyard -> name,
vintage => $result -> vintage,
wine_maker => $result -> wine_maker -> name,
};
}

return [sort{$$a{wine_maker} cmp $$b{wine_maker} || $$a{style} cmp $$b{style} || $$a{grape} cmp $$b{grape} } @wine];

} # End of read_wines_table.

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

__PACKAGE__ -> meta -> make_immutable;