Revision 78034f24
Von Sven Schöling vor mehr als 14 Jahren hinzugefügt
| SL/DB/Business.pm | ||
|---|---|---|
|
|
||
|
use SL::DB::MetaSetup::Business;
|
||
|
|
||
|
__PACKAGE__->attr_percent('discount', places => -2);
|
||
|
|
||
|
# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
|
||
|
__PACKAGE__->meta->make_manager_class;
|
||
|
|
||
| SL/DB/DeliveryOrder.pm | ||
|---|---|---|
|
|
||
|
use List::Util qw(first);
|
||
|
|
||
|
for my $field (qw(transdate reqdate)) {
|
||
|
__PACKAGE__->attr_date($field);
|
||
|
}
|
||
|
|
||
|
__PACKAGE__->meta->add_relationship(orderitems => { type => 'one to many',
|
||
|
class => 'SL::DB::DeliveryOrderItem',
|
||
|
column_map => { id => 'trans_id' },
|
||
| SL/DB/DeliveryOrderItem.pm | ||
|---|---|---|
|
|
||
|
use SL::DB::MetaSetup::DeliveryOrderItem;
|
||
|
|
||
|
for my $field (qw(qty sellprice discount base_qty lastcost price_factor marge_price_factor)) {
|
||
|
__PACKAGE__->attr_number($field, places => -2);
|
||
|
}
|
||
|
|
||
|
__PACKAGE__->meta->make_manager_class;
|
||
|
|
||
|
# methods
|
||
| SL/DB/DeliveryOrderItemsStock.pm | ||
|---|---|---|
|
|
||
|
use SL::DB::MetaSetup::DeliveryOrderItemsStock;
|
||
|
|
||
|
for my $field (qw(qty)) {
|
||
|
__PACKAGE__->attr_number($field, places => -2);
|
||
|
}
|
||
|
|
||
|
# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
|
||
|
__PACKAGE__->meta->make_manager_class;
|
||
|
|
||
| SL/DB/GLTransaction.pm | ||
|---|---|---|
|
|
||
|
use SL::DB::MetaSetup::GLTransaction;
|
||
|
|
||
|
for my $field (qw(transdate gldate)) {
|
||
|
__PACKAGE__->attr_date($field);
|
||
|
}
|
||
|
|
||
|
# Creates get_all, get_all_count, get_all_iterator, delete_all and update_all.
|
||
|
__PACKAGE__->meta->make_manager_class;
|
||
|
|
||
| SL/DB/Helpers/Attr.pm | ||
|---|---|---|
|
package SL::DB::Helper::Attr;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
sub auto_make {
|
||
|
my ($package, %params) = @_;
|
||
|
|
||
|
for my $col ($package->meta->columns) {
|
||
|
next if $col->primary_key_position; # don't make attr helper for primary keys
|
||
|
_make_by_type($package, $col->name, $col->type);
|
||
|
}
|
||
|
|
||
|
return $package;
|
||
|
}
|
||
|
|
||
|
sub make {
|
||
|
my ($package, %params) = @_;
|
||
|
|
||
|
for my $name (keys %params) {
|
||
|
my @types = ref $params{$name} eq 'ARRAY' ? @{ $params{$name} } : ($params{$name});
|
||
|
for my $type (@types) {
|
||
|
_make_by_type($package, $name, $type);
|
||
|
}
|
||
|
}
|
||
|
return $package;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
sub _make_by_type {
|
||
|
my ($package, $name, $type) = @_;
|
||
|
_as_number ($package, $name, places => -2) if $type =~ /numeric | real | float/xi;
|
||
|
_as_percent($package, $name, places => 0) if $type =~ /numeric | real | float/xi;
|
||
|
_as_number ($package, $name, places => 0) if $type =~ /int/xi;
|
||
|
_as_date ($package, $name) if $type =~ /date | timestamp/xi;
|
||
|
}
|
||
|
|
||
|
sub _as_number {
|
||
|
my $package = shift;
|
||
|
my $attribute = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
$params{places} = 2 if !defined($params{places});
|
||
|
|
||
|
no strict 'refs';
|
||
|
*{ $package . '::' . $attribute . '_as_number' } = sub {
|
||
|
my ($self, $string) = @_;
|
||
|
|
||
|
$self->$attribute($::form->parse_amount(\%::myconfig, $string)) if @_ > 1;
|
||
|
|
||
|
return $::form->format_amount(\%::myconfig, $self->$attribute, $params{places});
|
||
|
};
|
||
|
}
|
||
|
|
||
|
sub _as_percent {
|
||
|
my $package = shift;
|
||
|
my $attribute = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
$params{places} = 2 if !defined($params{places});
|
||
|
|
||
|
no strict 'refs';
|
||
|
*{ $package . '::' . $attribute . '_as_percent' } = sub {
|
||
|
my ($self, $string) = @_;
|
||
|
|
||
|
$self->$attribute($::form->parse_amount(\%::myconfig, $string) / 100) if @_ > 1;
|
||
|
|
||
|
return $::form->format_amount(\%::myconfig, 100 * $self->$attribute, $params{places});
|
||
|
};
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
sub _as_date {
|
||
|
my $package = shift;
|
||
|
my $attribute = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
no strict 'refs';
|
||
|
*{ $package . '::' . $attribute . '_as_date' } = sub {
|
||
|
my ($self, $string) = @_;
|
||
|
|
||
|
if (@_ > 1) {
|
||
|
if ($string) {
|
||
|
my ($yy, $mm, $dd) = $::locale->parse_date(\%::myconfig, $string);
|
||
|
$self->$attribute(DateTime->new(year => $yy, month => $mm, day => $dd));
|
||
|
} else {
|
||
|
$self->$attribute(undef);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
return $self->$attribute
|
||
|
? $::locale->reformat_date(
|
||
|
{ dateformat => 'yy-mm-dd' },
|
||
|
( $self->$attribute eq 'now'
|
||
|
? DateTime->now
|
||
|
: $self->$attribute
|
||
|
)->ymd,
|
||
|
$::myconfig{dateformat}
|
||
|
)
|
||
|
: undef;
|
||
|
};
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
|
||
|
|
||
|
1;
|
||
|
|
||
|
__END__
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
SL::DB::Helpers::Attr - attribute helpers
|
||
|
|
||
|
=head1 SYNOPSIS
|
||
|
|
||
|
use SL::DB::Helpers::Attr;
|
||
|
SL::DB::Helpers::Attr::make($class,
|
||
|
method_name => 'numeric(15,5)',
|
||
|
datemethod => 'date'
|
||
|
);
|
||
|
SL::DB::Helpers::Attr::auto_make($class);
|
||
|
|
||
|
=head1 DESCRIPTION
|
||
|
|
||
|
=head1 FUNCTIONS
|
||
|
|
||
|
=head1 BUGS
|
||
|
|
||
|
=head1 AUTHOR
|
||
|
|
||
|
=cut
|
||
| SL/DB/Helpers/AttrDate.pm | ||
|---|---|---|
|
package SL::DB::Helpers::AttrDate;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use Carp;
|
||
|
use English;
|
||
|
|
||
|
sub define {
|
||
|
my $package = shift;
|
||
|
my $attribute = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
no strict 'refs';
|
||
|
*{ $package . '::' . $attribute . '_as_date' } = sub {
|
||
|
my ($self, $string) = @_;
|
||
|
|
||
|
if (@_ > 1) {
|
||
|
if ($string) {
|
||
|
my ($yy, $mm, $dd) = $::locale->parse_date(\%::myconfig, $string);
|
||
|
$self->$attribute(DateTime->new(year => $yy, month => $mm, day => $dd));
|
||
|
} else {
|
||
|
$self->$attribute(undef);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
return $self->$attribute
|
||
|
? $::locale->reformat_date(
|
||
|
{ dateformat => 'yy-mm-dd' },
|
||
|
$self->${attribute}->ymd,
|
||
|
$::myconfig{dateformat}
|
||
|
)
|
||
|
: undef;
|
||
|
};
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
1;
|
||
| SL/DB/Helpers/AttrNumber.pm | ||
|---|---|---|
|
package SL::DB::Helpers::AttrNumber;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use Carp;
|
||
|
use English;
|
||
|
|
||
|
sub define {
|
||
|
my $package = shift;
|
||
|
my $attribute = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
$params{places} = 2 if !defined($params{places});
|
||
|
|
||
|
no strict 'refs';
|
||
|
*{ $package . '::' . $attribute . '_as_number' } = sub {
|
||
|
my ($self, $string) = @_;
|
||
|
|
||
|
$self->$attribute($::form->parse_amount(\%::myconfig, $string)) if @_ > 1;
|
||
|
|
||
|
return $::form->format_amount(\%::myconfig, $self->$attribute, $params{places});
|
||
|
};
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
1;
|
||
| SL/DB/Helpers/AttrPercent.pm | ||
|---|---|---|
|
package SL::DB::Helpers::AttrPercent;
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
use Carp;
|
||
|
use English;
|
||
|
|
||
|
sub define {
|
||
|
my $package = shift;
|
||
|
my $attribute = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
$params{places} = 2 if !defined($params{places});
|
||
|
|
||
|
no strict 'refs';
|
||
|
*{ $package . '::' . $attribute . '_as_percent' } = sub {
|
||
|
my ($self, $string) = @_;
|
||
|
|
||
|
$self->$attribute($::form->parse_amount(\%::myconfig, $string) / 100) if @_ > 1;
|
||
|
|
||
|
return $::form->format_amount(\%::myconfig, 100 * $self->$attribute, $params{places});
|
||
|
};
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
1;
|
||
| SL/DB/Helpers/Metadata.pm | ||
|---|---|---|
|
return 'SL::DB::Helpers::Manager';
|
||
|
}
|
||
|
|
||
|
sub initialize {
|
||
|
my $self = shift;
|
||
|
$self->make_attr_auto_helpers;
|
||
|
$self->SUPER::initialize(@_);
|
||
|
}
|
||
|
|
||
|
sub make_attr_helpers {
|
||
|
my ($self, %params) = @_;
|
||
|
SL::DB::Helper::Attr::make($self->class, %params);
|
||
|
}
|
||
|
|
||
|
sub make_attr_auto_helpers {
|
||
|
my ($self) = @_;
|
||
|
SL::DB::Helper::Attr::auto_make($self->class);
|
||
|
}
|
||
|
|
||
|
1;
|
||
| SL/DB/Invoice.pm | ||
|---|---|---|
|
use SL::DB::MetaSetup::Invoice;
|
||
|
use SL::DB::Manager::Invoice;
|
||
|
|
||
|
__PACKAGE__->attr_number($_, places => -2) for qw(amount netamount paid marge_total marge_percent taxamount);
|
||
|
__PACKAGE__->attr_date($_) for qw(transdate gldate datepaid duedate deliverydate orddate quodate);
|
||
|
__PACKAGE__->attr_percent($_) for qw(abschlag_percentage);
|
||
|
|
||
|
__PACKAGE__->meta->add_relationship(
|
||
|
invoiceitems => {
|
||
|
type => 'one to many',
|
||
| ... | ... | |
|
return $self->amount - $self->netamount;
|
||
|
}
|
||
|
|
||
|
__PACKAGE__->meta->make_attr_helpers(taxamount => 'numeric(15,5)');
|
||
|
|
||
|
1;
|
||
| SL/DB/InvoiceItem.pm | ||
|---|---|---|
|
|
||
|
use SL::DB::MetaSetup::InvoiceItem;
|
||
|
|
||
|
for my $field (qw(
|
||
|
qty allocated sellprice fxsellprice discount base_qty marge_total
|
||
|
marge_percent lastcost price_factor marge_price_factor
|
||
|
)) {
|
||
|
__PACKAGE__->attr_number($field, places => -2);
|
||
|
}
|
||
|
|
||
|
__PACKAGE__->meta->add_relationship(
|
||
|
part => {
|
||
|
type => 'one to one',
|
||
| SL/DB/Object.pm | ||
|---|---|---|
|
use List::MoreUtils qw(any);
|
||
|
|
||
|
use SL::DB;
|
||
|
use SL::DB::Helpers::AttrNumber;
|
||
|
use SL::DB::Helpers::AttrDate;
|
||
|
use SL::DB::Helpers::AttrPercent;
|
||
|
use SL::DB::Helpers::Attr;
|
||
|
use SL::DB::Helpers::Metadata;
|
||
|
use SL::DB::Helpers::Manager;
|
||
|
|
||
| ... | ... | |
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub make_attr_helper {
|
||
|
my ($self) = @_;
|
||
|
my $package = ref $self || $self;
|
||
|
|
||
|
for my $col ($package->meta->columns) {
|
||
|
next if $col->primary_key_position; # don't make attr helper for primary keys
|
||
|
|
||
|
attr_number ($package, $col->name, -2) if $col->type =~ /numeric | real | float/xi;
|
||
|
attr_percent($package, $col->name, -2) if $col->type =~ /numeric | real | float/xi;
|
||
|
attr_number ($package, $col->name, 0) if $col->type =~ /int/xi;
|
||
|
attr_date ($package, $col->name) if $col->type =~ /date | timestamp/xi;
|
||
|
}
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
sub attr_number {
|
||
|
SL::DB::Helpers::AttrNumber::define(@_);
|
||
|
}
|
||
|
|
||
|
sub attr_date {
|
||
|
SL::DB::Helpers::AttrDate::define(@_);
|
||
|
}
|
||
|
|
||
|
sub attr_percent {
|
||
|
SL::DB::Helpers::AttrPercent::define(@_);
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
|
||
|
__END__
|
||
| SL/DB/Order.pm | ||
|---|---|---|
|
use SL::DB::Manager::Order;
|
||
|
use SL::DB::Invoice;
|
||
|
|
||
|
__PACKAGE__->attr_number($_, places => -2) for qw(amount netamount marge_total marge_percent);
|
||
|
__PACKAGE__->attr_date($_) for qw(transdate reqdate);
|
||
|
__PACKAGE__->attr_percent($_) for qw(marge_percent);
|
||
|
|
||
|
__PACKAGE__->meta->add_relationship(
|
||
|
orderitems => {
|
||
|
type => 'one to many',
|
||
| SL/DB/Part.pm | ||
|---|---|---|
|
use SL::DB::MetaSetup::Part;
|
||
|
use SL::DB::Manager::Part;
|
||
|
|
||
|
__PACKAGE__->attr_number('lastcost', places => -2);
|
||
|
__PACKAGE__->attr_number('listprice', places => -2);
|
||
|
__PACKAGE__->attr_number('sellprice', places => -2);
|
||
|
|
||
|
__PACKAGE__->meta->add_relationships(
|
||
|
unit_obj => {
|
||
|
type => 'one to one',
|
||
| SL/DB/PurchaseInvoice.pm | ||
|---|---|---|
|
use SL::DB::MetaSetup::PurchaseInvoice;
|
||
|
use SL::DB::Manager::PurchaseInvoice;
|
||
|
|
||
|
for my $field (qw(transdate gldate datepaid duedate orddate quodate)) {
|
||
|
__PACKAGE__->attr_date($field);
|
||
|
}
|
||
|
|
||
|
__PACKAGE__->meta->add_relationship(invoiceitems => { type => 'one to many',
|
||
|
class => 'SL::DB::InvoiceItem',
|
||
|
column_map => { id => 'trans_id' },
|
||
| t/helper/attr.t | ||
|---|---|---|
|
use Test::More tests => 25;
|
||
|
use Test::More tests => 29;
|
||
|
|
||
|
use DateTime;
|
||
|
|
||
|
use_ok 'SL::DB::Part';
|
||
|
use_ok 'SL::DB::Order';
|
||
|
use_ok 'SL::DB::Invoice';
|
||
|
use_ok 'SL::Dispatcher';
|
||
|
|
||
|
SL::Dispatcher::pre_startup_setup();
|
||
| ... | ... | |
|
$o->reqdate(DateTime->new(year => 2010, month => 4, day => 12));
|
||
|
is($o->reqdate_as_date, '12.04.2010');
|
||
|
|
||
|
is($o->marge_percent_as_percent('40'), '40,00');
|
||
|
is($o->marge_percent_as_percent('40'), '40');
|
||
|
is($o->marge_percent, 0.40);
|
||
|
is($o->marge_percent_as_percent, '40,00');
|
||
|
is($o->marge_percent_as_percent('22,4'), '22,40');
|
||
|
is($o->marge_percent_as_percent, '40');
|
||
|
is($o->marge_percent_as_percent('22,4'), '22');
|
||
|
is($o->marge_percent, 0.224);
|
||
|
is($o->marge_percent_as_percent, '22,40');
|
||
|
is($o->marge_percent_as_percent, '22');
|
||
|
is($o->marge_percent(0.231), 0.231);
|
||
|
is($o->marge_percent_as_percent, '23,10');
|
||
|
is($o->marge_percent_as_percent, '23');
|
||
|
|
||
|
# overloaded attr: invoice taxamount
|
||
|
my $i = new_ok 'SL::DB::Invoice';
|
||
|
|
||
|
is($i->taxamount_as_number, '0,00');
|
||
|
$i->amount(12);
|
||
|
$i->netamount(10.34);
|
||
|
is($i->taxamount_as_number, '1,66');
|
||
|
|
||
Auch abrufbar als: Unified diff
Attribute Helper umgeschrieben.
Siehe Dokumentation SL::DB::Helpers::Attr.
Attributhelper werden jetzt beim Rose Start automatisch geladen.
numeric Felder bekommen immer einen as_number udn einen as_percent helper.
date Felder bekommen immer einen as_date helper.
as_date Helper kann jetzt auch mit 'now' umgehen.
Zusaätzliche Helper können zur Compilezeit mit
erstellt werden, wobei 'type' einfach das ist, was auch bei der autdetection
ind er Datenbank erkannt wird, z.B. "numeric(15,5)" oder "date". Die passenden
Helper werden dann installiert.