our
@ISA
=
qw(AutoCode::Root)
;
sub
_initialize {
my
(
$self
,
@args
)=
@_
;
$self
->_add_scalar_accessor(
'schema'
);
$self
->_add_scalar_accessor(
'package_prefix'
);
my
(
$schema
,
$package_prefix
)=
$self
->_rearrange([
qw(SCHEMA PACKAGE_PREFIX)
],
@args
);
defined
$schema
or
$self
->throw(
"NO Schema set"
);
$self
->schema(
$schema
);
$package_prefix
||=
$schema
->package_prefix;
$package_prefix
||=
'AutoCode'
;
$self
->package_prefix(
$package_prefix
);
}
*make_virtual_module
= \
&make_module
;
sub
make_module {
my
(
$self
,
$type
,
$isa
) =
@_
;
$isa
=
'AutoCode::Root'
unless
defined
$isa
;
my
$schema
=
$self
->schema;
my
$package_prefix
=
$self
->package_prefix;
my
$vp
=
$self
->_get_virtual_package(
$type
);
my
$model
=
$schema
->get_module_model(
$type
);
my
@isa
=
$model
->get_isas(
$type
);
if
(
@isa
){
no
strict
'refs'
;
foreach
(
@isa
){
push
@{
"$vp\::ISA"
},
$self
->make_virtual_module(
$_
);
}
}
my
$vp
=
$self
->_get_virtual_package(
$type
);
no
strict
'refs'
;
push
@{
"$vp\::ISA"
},
$isa
unless
@{
"$vp\::ISA"
};
$self
->debug(
"making $type in $vp"
);
map
{
$self
->_add_scalar_accessor(
$_
,
$vp
);}
$model
->get_scalar_attributes;
map
{
$self
->_add_array_accessor([
$_
,
$schema
->get_plural(
$_
)],
$vp
);}
$model
->get_array_attributes;
$self
->_make_initialize(
$type
);
return
$vp
;
}
sub
_make_initialize {
my
(
$self
,
$type
)=
@_
;
my
$schema
=
$self
->schema;
my
$package_prefix
=
$self
->package_prefix;
my
$model
=
$self
->schema->get_module_model(
$type
);
my
@scalar_attrs
=
$model
->get_scalar_attributes;
my
@array_attrs
=
$model
->get_array_attributes;
my
@array_attrs_plural
=
map
{
$schema
->get_plural(
$_
)}
@array_attrs
;
my
$vp
=
$self
->_get_virtual_package(
$type
);
my
$source
=
'sub { my($dummy, @args)=@_;'
.
"\n"
;
if
(
@scalar_attrs
||
@array_attrs
){
$source
.=
'my ('
.
join
','
,
map
{
"\$$_"
}
@scalar_attrs
;
$source
.=
', '
.
join
','
,
map
{
"\$$_"
}
@array_attrs_plural
;
$source
.=
')='
.
"\n"
.
'$dummy->_rearrange([qw('
;
$source
.=
join
' '
,
@scalar_attrs
;
$source
.=
' '
.
join
' '
,
@array_attrs_plural
;
$source
.=
')], @args);'
.
"\n"
;
map
{
$source
.=
"defined \$$_ and \$dummy->$_(\$$_);\n"
}
@scalar_attrs
;
map
{
my
(
$singular
,
$plural
)=(
$_
,
$schema
->get_plural(
$_
));
$source
.=
<<END_OF_ARRAY_ACCESSORS;
if(ref(\$$plural) eq'ARRAY'){
\$dummy->add_$singular(\$_) foreach (\@{\$$plural});
}else{
\$dummy->remove_$plural;
}
END_OF_ARRAY_ACCESSORS
}
@array_attrs
;
}
$source
.=
"no strict 'refs';\n"
;
$source
.=
'my $super=AutoCode::Root::_find_super("'
.
$vp
.
'", "_initialize");'
.
"\n"
;
$source
.=
'&{$super. "::_initialize"}($dummy, @args);'
.
"\n"
;
$source
.=
'};'
.
"\n"
;
$self
->debug(
"$source"
);
no
strict
'refs'
;
$_
=
$source
;
*{
"$vp\::_initialize"
} =
eval
$source
;
$self
->throw(
"Error when eval'ing _initialize\n$@"
)
if
($@);
}
sub
_get_virtual_package {
my
(
$self
,
$type
)=
@_
;
my
$package_prefix
=
$self
->package_prefix;
return
"$package_prefix\::Virtual::$type"
;
}
1;