package DBICx::Modeler::Generator::Path;


# ****************************************************************
# pragma(s)
# ****************************************************************

# Moose turns strict/warnings pragmas on,
# however, kwalitee scorer can not detect such mechanism.
# (Perl::Critic can it, with equivalent_modules parameter)
use strict;
use warnings;


# ****************************************************************
# MOP dependency(-ies)
# ****************************************************************

use Moose;
use MooseX::Orochi;
use MooseX::Types::Path::Class qw(File Dir);


# ****************************************************************
# namespace cleaner
# ****************************************************************

use namespace::clean -except => [qw(meta)];


# ****************************************************************
# dependency injection
# ****************************************************************

bind_constructor '/DBICx/Modeler/Generator/Path' => (
    args => {
        class
            => bind_value '/DBICx/Modeler/Generator/Class',
        creation_script
            => bind_value '/DBICx/Modeler/Generator/Path/creation_script',
        module_extension
            => bind_value '/DBICx/Modeler/Generator/Path/module_extension',
        script_extension
            => bind_value '/DBICx/Modeler/Generator/Path/script_extension',
        root
            => bind_value '/DBICx/Modeler/Generator/Path/root',
        tree
            => bind_value '/DBICx/Modeler/Generator/Tree',
    },
);


# ****************************************************************
# attribute(s)
# ****************************************************************

has 'class' => (
    is          => 'ro',
    does        => 'DBICx::Modeler::Generator::ClassLike',
    required    => 1,
);

has 'tree' => (
    is          => 'ro',
    does        => 'DBICx::Modeler::Generator::TreeLike',
    required    => 1,
);

has 'root' => (
    is          => 'ro',
    isa         => Dir,
    coerce      => 1,
    required    => 1,
);

has [qw(source_library target_library)] => (
    is          => 'ro',
    isa         => Dir,
    init_arg    => undef,
    coerce      => 1,
    lazy_build  => 1,
);

has [qw(
    source_model source_schema
    target_model target_schema
)] => (
    is          => 'ro',
    isa         => File,
    init_arg    => undef,
    lazy_build  => 1,
);

has [qw(
    source_models source_schemata
    target_models target_schemata
)] => (
    is          => 'ro',
    isa         => Dir,
    init_arg    => undef,
    lazy_build  => 1,
);

has 'creation_script' => (
    is          => 'ro',
    isa         => File,
    coerce      => 1,
    lazy_build  => 1,
);

has [qw(module_extension script_extension)] => (
    is          => 'ro',
    isa         => 'Str',
    lazy_build  => 1,
);


# ****************************************************************
# hook(s) on construction
# ****************************************************************

around BUILDARGS => sub {
    my ($next, $class, @args) = @_;

    my $args = $class->$next(@args);

    foreach my $attribute (qw(
        module_extension script_extension creation_script
    )) {
        delete $args->{$attribute}
            unless defined $args->{$attribute};
    }

    return $args;
};


# ****************************************************************
# builder(s)
# ****************************************************************

sub _build_source_library {
    my $self = shift;

    return $self->root->subdir($self->tree->route_to_source_library);
}

sub _build_target_library {
    my $self = shift;

    return $self->root->subdir($self->tree->route_to_target_library);
}

sub _build_creation_script {
    my $self = shift;

    return $self->get_full_path(
        $self->tree->route_to_source,
        $self->tree->application,
        $self->script_extension,
    );
}

sub _build_module_extension {
    return '.pm';
}

sub _build_script_extension {
    return '.sql';
}

sub _build_source_model {
    my $self = shift;

    return $self->get_full_path(
        $self->tree->route_to_source_model,
        $self->module_extension,
    );
}

sub _build_target_model {
    my $self = shift;

    return $self->get_full_path(
        $self->tree->route_to_target_model,
        $self->module_extension,
    );
}

sub _build_source_schema {
    my $self = shift;

    return $self->get_full_path(
        $self->tree->route_to_source_schema,
        $self->module_extension,
    );
}

sub _build_target_schema {
    my $self = shift;

    return $self->get_full_path(
        $self->tree->route_to_target_schema,
        $self->module_extension,
    );
}

sub _build_source_models {
    my $self = shift;

    return $self->root->subdir($self->tree->route_to_source_model);
}

sub _build_target_models {
    my $self = shift;

    return $self->root->subdir($self->tree->route_to_target_model);
}

sub _build_source_schemata {
    my $self = shift;

    return $self->root->subdir($self->tree->route_to_source_schema);
}

sub _build_target_schemata {
    my $self = shift;

    return $self->root->subdir($self->tree->route_to_target_schema);
}


# ****************************************************************
# public method(s)
# ****************************************************************

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

    my ($file, $directory) = @$path_attribute{qw(file directory)};

    $self->$file->remove;
    $self->$directory->rmtree;

    return;
}

sub add_source_library {
    my $self = shift;

    unshift @INC, $self->source_library->stringify;

    return;
}

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

    confess 'Could not get full path with @routes because: '
          . '@routes should have 2 (for basename, extension) or more elements.'
        if scalar @routes < 2;
    my $file = join q{}, splice(@routes, -2, 2);    # basename.extension

    return $self->root->file(@routes, $file);
}


# ****************************************************************
# consuming role(s)
# ****************************************************************

with qw(
    DBICx::Modeler::Generator::PathLike
);


# ****************************************************************
# compile-time process(es)
# ****************************************************************

__PACKAGE__->meta->make_immutable;


# ****************************************************************
# return true
# ****************************************************************

1;
__END__


# ****************************************************************
# POD
# ****************************************************************

=pod

=head1 NAME

DBICx::Modeler::Generator::Path - Implement class for DBICx::Modeler::Generator::PathLike

=head1 SYNOPSIS

    use DBICx::Modeler::Generator::Path;

=head1 DESCRIPTION

This class is an implement class for
L<DBICx::Modeler::Generator::PathLike|DBICx::Modeler::Generator::PathLike>.

=head1 METHODS

=head2 Remover

=head3 C<< $self->remove_path({ file => $file_attribute, directory => $directory_attribute }) >>

Removes file and directory tree.

=head2 Utilities

=head3 C<< $full_path = $self->get_full_path(@directories, $file, $extension) >>

Returns L<Path::Class::File|Path::Class::File> object
which corresponds with specified arguments.

=head3 C<< $self->add_source_library() >>

Added source directory into library path (which is C<@INC>).

=head1 AUTHOR

=over 4

=item MORIYA Masaki, alias Gardejo

C<< <moriya at cpan dot org> >>,
L<http://gardejo.org/>

=back

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2009-2010 MORIYA Masaki, alias Gardejo

This module is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>.

The full text of the license can be found in the F<LICENSE> file
included with this distribution.

=cut