package XAS::Model::DBM;

our $VERSION = '0.01';

use XAS::Class
  version => $VERSION,
  base    => 'XAS::Base',
  mixins  => 'create find search search_like find_or_create update_or_create
              update_or_new count populate read_record create_record 
              delete_record update_record load_records',
;

# ---------------------------------------------------------------------
# Database usability mixin functions
# ---------------------------------------------------------------------

sub create {
    my $class  = shift;
    my $schema = shift;

    return $schema->resultset( $class->table_name )->create( @_ );

}

sub find {
    my $class  = shift;
    my $schema = shift;

    return $schema->resultset( $class->table_name )->find( @_ );

}

sub search {
    my $class  = shift;
    my $schema = shift;

    return $schema->resultset( $class->table_name )->search( @_ );

}

sub search_like {
    my $class  = shift;
    my $schema = shift;

    return $schema->resultset( $class->table_name )->search_like( @_ );

}

sub find_or_create {
    my $class  = shift;
    my $schema = shift;

    return $schema->resultset( $class->table_name )->find_or_create( @_ );

}

sub update_or_create {
    my $class  = shift;
    my $schema = shift;

    return $schema->resultset( $class->table_name )->update_or_create( @_ );

}

sub update_or_new {
    my $class  = shift;
    my $schema = shift;

    return $schema->resultset( $class->table_name )->update_or_new( @_ );

}

sub count {
    my $class  = shift;
    my $schema = shift;

    return $schema->resultset( $class->table_name )->count( @_ );

}

sub populate {
    my $class  = shift;
    my $schema = shift;

    return $schema->resultset( $class->table_name )->populate( @_ );

}

sub load_records {
    my $class    = shift;
    my $schema   = shift;

    my @datum;
    my @columns = $class->columns;

    # find the records

    if (my $rs = $class->search($schema, @_ )) {

        # transfer the data

        while (my $row = $rs->next) {

            my $data;

            foreach my $column (@columns) {

                my $info = $class->column_info($column);

                if ($info->{data_type} =~ m/^(datetime | timestamp)/x ) {

                    my $dt = '';

                    if ($row->$column) {

                        $dt = sprintf("%s", $row->$column);
                        $dt =~ s/T/ /;

                    }

                    $data->{$column} = $dt;

                } else {

                    $data->{$column} = $row->$column;

                }

            }

            push(@datum, $data);

        }

    }

    return \@datum;

}

sub read_record {
    my $class    = shift;
    my $schema   = shift;

    my $data = undef;
    my @columns = $class->columns;

    # find the record

    if (my $row = $class->find($schema, @_ )) {

        # transfer the data

        foreach my $column (@columns) {

            my $info = $class->column_info($column);

            if ($info->{data_type} =~ m/^(datetime | timestamp)/x ) {

                my $dt = '';

                if ($row->$column) {

                    $dt = sprintf("%s", $row->$column);
                    $dt =~ s/T/ /;

                }

                $data->{$column} = $dt;

            } else {

                $data->{$column} = $row->$column;

            }

        }

    }

    return $data;

}

sub create_record {
    my $class  = shift;
    my $schema = shift;
    my $record = shift;

    my $rec = undef;
    my $data = undef;
    my @columns = $class->columns;

    # transfer and filter the data

    $schema->txn_do(sub {

        foreach my $column (@columns) {

            my $info = $class->column_info($column);

            if (defined($record->{$column})) {

                next if ((defined($info->{auto_nextval}) ||
                         (defined($info->{is_auto_increment}))));

                $data->{$column} = $record->{$column};

            }

        }

        # create the record

        $class->create($schema, $data);

        while (my ($key, $value) = each(%$record)) {

            $rec->{$key} = $value;

        }

    });

    return $rec;

}

sub delete_record {
    my $class  = shift;
    my $schema = shift;
    my $record = shift;

    my $data = undef;
    my $criteria = {
        id => $record->{id}
    };

    $schema->txn_do(sub { 

        if (my $row = $class->find($schema, $criteria)) {

            $row->delete();

            while (my ($key, $value) = each(%$record)) {

                $data->{$key} = $value;

            }

        }

    });

    return $data;

}

sub update_record {
    my $class  = shift;
    my $schema = shift;
    my $record = shift;

    my $data = undef;
    my @columns = $class->columns;
    my $criteria = {
        id => $record->{id}
    };

    # retrieve the record

    $schema->txn_do(sub {

        if (my $row = $class->find($schema, $criteria)) {

            # transfer the data

            foreach my $column (@columns) {

                my $info = $class->column_info($column);

                if (defined($record->{$column})) {

                    next if ((defined($info->{auto_nextval}) ||
                             (defined($info->{is_auto_increment}))));

                    $row->$column($record->{$column});

                }

            }

            # update the record

            $row->update();

            while (my ($key, $value) = each(%$record)) {

                $data->{$key} = $value;

            }

        }

    });

    return $data;

}

1;

__END__

=head1 NAME

XAS::Model::DBM - Defines helper functions to DBIx::Class methods

=head1 SYNOPSIS

  use XAS::Model::DBM;

=head1 DESCRIPTION

This module is not usually included directly by user level code. It's 
primiary purpose is to be used as a mixin to a model. This module 
provides several shortcut methods that make database queries easier. To 
learn how they work, please consult the DBIx::Class documentation.

You can use this methods in the following fashion.

 use XAS::Model::Database 'Tablename';

 my $schema = XAS::Model::Database->opendb();

 ... DBIx::Class version

 my @rows = $schema->resultset('Tablename')->search();

 ... as compared to

 my @rows = Tablename->search($schema);

The shortcut require less typing and is slightly more intuitive. Neither 
approach is "more correct" then the other and sometimes they can be
intermixed, especially when searching in related tables.

=head1 METHODS

=head2 create($class, $schema, ...)

This method is a shortcut for creating records. It takes two or more
parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<...>

Other parameters that are passed directly to the DBIx::Class create() method.

=back

=head2 find($class, $schema, ...)

This method is a shortcut for finding a single record. It takes two or more
parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<...>

Other parameters that are passed directly to the DBIx::Class find() method.

=back

=head2 search($class, $schena, ...)

This method is a shortcut for record searches. It takes two or more
parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<...>

Other parameters that are passed directly to the DBIx::Class search() method.

=back

=head2 search_like($class, $schema, ...)

This method is a shortcut for record searches. It takes two or more
parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<...>

Other parameters that are passed directly to the DBIx::Class search_like() method.

=back

=head2 count($class, $schema)

This method is returns count of the record in a table. It takes two parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=back

=head2 find_or_create($class, $schema, ...)

This method is a shortcut to find or create a record. It takes two or more
parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<...>

Other parameters that are passed directly to the DBIx::Class find_or_create() 
method.

=back

=head2 update_or_create($class, $schema, ...)

This method is a shortcut for updating or creating a new record. It takes 
two or more parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<...>

Other parameters that are passed directly to the DBIx::Class update_or_create() 
method.

=back

=head2 populate($class, $schena, ...)

This method will load a hash of records into a table. It takes two or more
parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<...>

Other parameters that are passed directly to the DBIx::Class populate() method.

=back

=head2 load_records($class, $schema, ...)

This method will load records into an array of hashes based on passed 
criteria. Any data conversion is done automatically. The array is suitable 
for the ExtJS 4.1 data model. It takes two or more parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<...>

Other parameters that are passed directly to the search() method.

=back

=head2 read_record($class, $schema, ...)

This method will find a single record which is returned as a hash with 
any data conversion already done. This hash is suitable for
the ExtJS 4.1 data model. It takes two or more parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<...>

Other parameters that are passed directly to the find() method.

=back

=head2 create_record($class, $schema, $record)

This method will create a single record from a hash. This is done within 
a transaction and any data conversion is done automatically. Only hash 
items that match actual fields within the table are stored. It returns 
a hash that is suitable for the ExtJS 4.1 data model. It takes
three parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<$record>

The record used to create the table entry.

=back

=head2 delete_record($class, $schema, $record)

This method will delete a single record from the database. This is done 
within a transaction. It returns a hash that is suitable for the ExtJS 4.1 
data model. It takes three parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<$record>

The record used to delete the table entry.

=back

=head2 update_record($class, $schema, $record)

This method will update a single record in the database. This is done within a 
transaction. Only hash items that match actual fields within the table are 
updated. It returns a hash that is suitable for the ExtJS 4.1 data model. 
It takes three parameters:

=over 4

=item B<$class>

The DBIx::Class model name. Usually a constant defined within XAS::Model::Database.

=item B<$schema> 

The DBIx::Class schema handle returned from opendb() in XAS::Model::Database.

=item B<$record>

The record used to update the table entry. 

=back

=head1 SEE ALSO

 DBIx::Class

L<XAS|XAS>

=head1 AUTHOR

Kevin L. Esteb, E<lt>kevin@kesteb.usE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 by Kevin L. Esteb

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut
