# Copyright (C) 2008-2009, Sebastian Riedel.

package Mojo::Base;

use strict;
use warnings;

# No imports because we get subclassed, a lot!
require Carp;
require Scalar::Util;

# Kids, you tried your best and you failed miserably.
# The lesson is, never try.
sub new {
    my $class = shift;

    # Instantiate
    return bless
      exists $_[0] ? exists $_[1] ? {@_} : $_[0] : {},
      ref $class || $class;
}

# Performance is very important for something as often used as accessors,
# so we optimize them by compiling our own code, don't be scared, we have
# tests for every single case
sub attr {
    my $class = shift;
    my $attrs = shift;

    # Shortcut
    return unless $class && $attrs;

    # Check arguments
    my $args;
    if (exists $_[1]) {
        my %args = (@_);
        $args = \%args;
    }
    else { $args = $_[0] }
    $args ||= {};

    my $chained = exists $args->{chained} ? delete $args->{chained} : 1;
    my $default = delete $args->{default};
    my $weak    = delete $args->{weak};

    undef $args;

    # Check default
    Carp::croak('Default has to be a code reference or constant value')
      if ref $default && ref $default ne 'CODE';

    # Allow symbolic references
    no strict 'refs';

    # Create attributes
    $attrs = ref $attrs eq 'ARRAY' ? $attrs : [$attrs];
    my $ws = '    ';
    for my $attr (@$attrs) {

        Carp::croak("Attribute '$attr' invalid")
          unless $attr =~ /^[a-zA-Z_]\w*$/;

        # Header
        my $code = "sub {\n";

        # Warning gets optimized away
        unless ($ENV{MOJO_BASE_OPTIMIZE}) {

            # Check invocant
            $code .= "${ws}Carp::confess(q[";
            $code
              .= qq/Attribute "$attr" has to be called on an object, not a class/;
            $code .= "])\n  ${ws}unless ref \$_[0];\n";
        }

        # No value
        $code .= "${ws}if (\@_ == 1) {\n";
        unless (defined $default) {

            # Return value
            $code .= "$ws${ws}return \$_[0]->{'$attr'};\n";
        }
        else {

            # Return value
            $code .= "$ws${ws}return \$_[0]->{'$attr'} ";
            $code .= "if exists \$_[0]->{'$attr'};\n";

            # Return default value
            $code .= "$ws${ws}return \$_[0]->{'$attr'} = ";
            $code .=
              ref $default eq 'CODE'
              ? '$default->($_[0])'
              : '$default';
            $code .= ";\n";
        }
        $code .= "$ws}\n";


        # Store argument optimized
        if (!$weak && !$chained) {
            $code .= "${ws}return \$_[0]->{'$attr'} = \$_[1];\n";
        }

        # Store argument the old way
        else {
            $code .= "$ws\$_[0]->{'$attr'} = \$_[1];\n";
        }

        # Weaken
        $code .= "${ws}Scalar::Util::weaken(\$_[0]->{'$attr'});\n" if $weak;

        # Return value or instance for chained/weak
        if ($chained || $weak) {
            $code .= "${ws}return ";
            $code .= $chained ? '$_[0]' : "\$_[0]->{'$attr'}";
            $code .= ";\n";
        }

        # Footer
        $code .= '};';

        # We compile custom attribute code for speed
        *{"${class}::$attr"} = eval $code;

        # This should never happen (hopefully)
        Carp::croak("Mojo::Base compiler error: \n$code\n$@\n") if $@;

        # Debug mode
        if ($ENV{MOJO_BASE_DEBUG}) {
            warn "\nATTRIBUTE: $class->$attr\n";
            warn "$code\n\n";
        }
    }
}

1;
__END__

=head1 NAME

Mojo::Base - Minimal Object System For Mojo Related Projects

=head1 SYNOPSIS

    package Car;
    use base 'Mojo::Base';

    __PACKAGE__->attr('driver');
    __PACKAGE__->attr('doors', default => 2);
    __PACKAGE__->attr([qw/passengers seats/],
        chained => 0,
        default => sub { 2 }
    );
    __PACKAGE__->attr('trailer', weak => 1);

    package main;
    use Car;

    my $bmw = Car->new;
    print $bmw->doors;
    print $bmw->passengers(5)->doors;

    my $mercedes = Car->new(driver => 'Sebastian');
    print $mercedes->passengers(7)->passengers;

    $mercedes->trailer(Trailer->new);

=head1 DESCRIPTION

L<Mojo::Base> is a base class containing a simple and fast object system
for Perl objects.
Main design goals are minimalism and staying out of your way.
The syntax is a bit like Ruby and the performance better than
L<Class::Accessor::Fast>.

Note that this is just an accessor generator, look at L<Moose> if you want
a more comprehensive object system.

For debugging you can set the C<MOJO_BASE_DEBUG> environment variable.

=head1 METHODS

=head2 C<new>

    my $instance = BaseSubClass->new;
    my $instance = BaseSubClass->new(name => 'value');
    my $instance = BaseSubClass->new({name => 'value'});

This class provides a standard object constructor.
You can pass arguments to it either as a hash or as a hashref, and they will
be set in the object's internal hash reference.

=head2 C<attr>

    __PACKAGE__->attr('name');
    __PACKAGE__->attr([qw/name1 name2 name3/]);
    __PACKAGE__->attr('name', chained => 0, default => 'foo');
    __PACKAGE__->attr(name => (chained => 0, default => 'foo'));
    __PACKAGE__->attr('name', {chained => 0, default => 'foo'});
    __PACKAGE__->attr([qw/name1 name2 name3/] => {
        chained => 0,
        default => 'foo'}
    );

The C<attr> method generates one or more accessors, depending on the number
of arguments, which work as both getters and setters.
You can modify the accessor behavior by passing arguments to C<attr> either
as a hash or a hashref.

Currently there are three options supported.

    chained: Whenever you call an attribute with arguments the instance
             is returned instead of the value. (This will be activated by
             default and can be deactivated by setting chained to false)
    default: Default value for the attribute, can be a coderef or constant
             value. (Not a normal reference!)
             Note that the default value is "lazy", which means it only
             gets assigned to the instance when the attribute has been
             called.
    weak:    Weakens the attribute value, use to avoid memory leaks with
             circular references.

=cut
