# Copyright (C) 2010, Sascha Kiefer.

package Class::Properties;
use strict;
use warnings;

require Carp;

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    return bless exists $_[0] ? exists $_[1] ? {@_} : { %{ $_[0] } } : {},
      $class;
}

sub property {
    my $class = shift;

    my ( $idx, $len ) = ( 0, scalar @_ );
    while ( $idx < $len ) {

        my $key = $_[ $idx++ ];
        my $val = $idx < $len ? $_[ $idx++ ] : undef;

        my @names = ref $key eq 'ARRAY' ? @$key : ($key);
        foreach my $name (@names) {
            Carp::croak(qq/Property "$name" is invalid./)
              unless $name =~ /^[a-zA-Z_]\w*$/;

            no strict 'refs';
            *{"${class}::$name"} = sub {
                my $self = shift;
                if (@_) {
                    $self->{$name} = @_ == 1 ? $_[0] : [@_];
                    return $self;
                }
                else {
                    $self->{$name} = $val
                      unless exists $self->{$name};
                    return $self->{$name};
                }
            };
        }
    }
}

1;

#!/usr/bin/perl

# Copyright (C) 2010, Sascha Kiefer.

package MyBase;
use base 'Class::Properties';

__PACKAGE__->property( language => 'perl', 'desc' );
__PACKAGE__->property( first => 'larry', last => 'wall' );
__PACKAGE__->property( [qw/minor major/] => 0, revision => 1 );

package main;

use strict;
use warnings;

use Test::More tests => 404;

use_ok('Class::Properties');

my $objs = [];
for my $i ( 1 .. 50 ) {
    $objs->[$i] = MyBase->new;
    $objs->[$i]->desc($i);
    is( $objs->[$i]->desc, $i, 'right attribute value' );
}
for my $i ( 51 .. 100 ) {
    $objs->[$i] = MyBase->new( desc => $i );
    is( $objs->[$i]->desc, $i, 'right attribute value' );
}

my $o = $objs->[1];
ok( defined( $o->major ), 'attribute defined' );
is( $o->major, 0, 'right attribute value' );
$o->major(42);
is( $o->major, 42, 'right attribute value' );

my $y = 1;
for my $i ( 101 .. 150 ) {
    $y = !$y;
    $objs->[$i] = MyBase->new;
    is( ref $objs->[$i]->last('window'),
        'MyBase', 'attribute value has right class' );
    $objs->[$i]->revision(101) if $y;
    $y
      ? is( $objs->[$i]->revision, 101, 'right attribute value' )
      : is( $objs->[$i]->revision, 1,   'right attribute default value' );
}

for my $i ( 151 .. 200 ) {
    $objs->[$i] = MyBase->new;
    is( $objs->[$i]->minor,           0, 'right attribute value' );
    is( $objs->[$i]->minor(6)->minor, 6, 'right chained attribute value' );
    is( $objs->[$i]->major,           0, 'right attribute value' );
    is( $objs->[$i]->major(7)->major, 7, 'right chained attribute value' );
}

1;