view Lib/Schema/DataSource/CDBIBuilder.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 03e58a454b20
children 16ada169ca75
line wrap: on
line source

use strict;
package Schema::DataSource::CDBIBuilder;
use Schema::DataSource::TypeMapping;
use Common;
our @ISA = qw(Object);

BEGIN {
    DeclareProperty ClassMappings => ACCESS_NONE;
    DeclareProperty TypeMapping => ACCESS_READ;
    DeclareProperty ValueTypeReflections => ACCESS_READ;
}

sub CTOR {
    my ($this,%args) = @_;
    
    $this->{$TypeMapping} = $args{'TypeMapping'} || Schema::DataSource::TypeMapping::Std->new;
    $this->{$ValueTypeReflections} = { DateTime => 'DateTime'};
}

sub ReflectValueType {
    my ($this,$Type) = @_;
    return $this->{$ValueTypeReflections}{$Type->Name->Simple};
}

sub GetClassMapping {
    my ($this,$type) = @_;
    
    if (my $mapping = $this->{$ClassMappings}->{$type->Name->Canonical}) {
        return $mapping;
    } else {
        $mapping = new Schema::DataSource::CDBIBuilder::ClassMapping(Class => $type,Parent => $this);
        $this->{$ClassMappings}{$type->Name->Canonical} = $mapping;
        return $mapping
    }
}

sub EnumClassMappings {
    my ($this) = @_;
    return $this->{$ClassMappings} ? values %{$this->{$ClassMappings}} : ();
}

sub AddType {
    my ($this,$type) = @_;
    $this->GetClassMapping($type);
}

sub BuildDBSchema {
    my ($this) = @_;
    
    my $schemaDB = new Schema::DB(Name => 'auto', Version => time);
    
    if ($this->{$ClassMappings}) {
        $_->CreateTable($schemaDB) foreach values %{ $this->{$ClassMappings} };
        $_->CreateConstraints($schemaDB) foreach values %{ $this->{$ClassMappings} };
    }
    
    return $schemaDB;
}

sub WriteModules {
    my ($this,$fileName,$prefix) = @_;
    
    my $text;
    $text = <<ModuleHeader;
#autogenerated script don't edit
package ${prefix}DBI;
use base 'Class::DBI';

require DateTime;

our (\$DSN,\$User,\$Password,\$Init);
\$DSN ||= 'DBI:null'; # avoid warning

__PACKAGE__->connection(\$DSN,\$User,\$Password);

# initialize
foreach my \$action (ref \$Init eq 'ARRAY' ? \@{\$Init} : \$Init) {
    next unless \$action;
    
    if (ref \$action eq 'CODE') {
        \$action->(__PACKAGE__->db_Main);
    } elsif (not ref \$action) {
        __PACKAGE__->db_Main->do(\$action);
    }
}

ModuleHeader
    
    if ($this->{$ClassMappings}) {
        $text .= join ("\n\n", map $_->GenerateText($prefix.'DBI',$prefix), sort {$a->Class->Name->Canonical cmp $b->Class->Name->Canonical } values %{ $this->{$ClassMappings} } );
    }
    
    $text .= "\n1;";
    
    open my $out, ">$fileName" or die new Exception("Failed to open file",$fileName,$!);
    print $out $text;
}

sub Dispose {
    my ($this) = @_;
    
    delete @$this{$ClassMappings,$TypeMapping,$ValueTypeReflections};
    
    $this->SUPER::Dispose;
}

package Schema::DataSource::CDBIBuilder::ClassMapping;
use Common;
use Schema;
our @ISA = qw(Object);

BEGIN {
    DeclareProperty Table => ACCESS_READ;
    DeclareProperty PropertyTables => ACCESS_READ;
    DeclareProperty PropertyMappings => ACCESS_READ;
    
    DeclareProperty Class => ACCESS_READ;
    DeclareProperty Parent => ACCESS_NONE;
}

sub CTOR {
    my ($this,%args) = @_;
    
    $this->{$Class} = $args{'Class'} or die new Exception('The class must be specified');
    $this->{$Parent} = $args{'Parent'} or die new Exception('The parent must be specified');
    
}

sub PropertyMapping {
    my ($this,%args) = @_;
    $this->{$PropertyMappings}{$args{'name'}} = { Column => $args{'Column'},DBType => $args{'DBType'} };
}

sub CreateTable {
    my ($this,$schemaDB) = @_;
    
    return if $this->{$Class}->isTemplate or $this->{$Class}->GetAttribute('ValueType') or $this->{$Class}->Name->Simple eq 'Set';
    
    # CreateTable
    my $table = $schemaDB->AddTable({Name => $this->{$Class}->Name->Canonical});
    $table->InsertColumn({
        Name => '_id',
        Type => $this->{$Parent}->TypeMapping->DBIdentifierType,
        Tag => ['AUTO_INCREMENT']
    });
    $table->SetPrimaryKey('_id');
    foreach my $prop ( grep { UNIVERSAL::isa($_,'Schema::Property') } $this->{$Class}->ListMembers ) {
        if ($prop->Type->Name->Name eq 'Set') {
            # special case for multiple values
            my $propTable = $this->CreatePropertyTable($schemaDB,$prop);
            $propTable->LinkTo($table,'parent');
        } else {
            $table->InsertColumn({
                Name => $prop->Name,
                Type => $this->{$Parent}->TypeMapping->MapType($prop->Type),
                CanBeNull => 1
            });
        }
    }
    $this->{$Table} = $table;
    return $table;
}

sub CreatePropertyTable {
    my ($this,$schemaDB,$property) = @_;
    
    my $table = $schemaDB->AddTable({Name => $this->{$Class}->Name->Canonical.'_'.$property->Name});
    $table->InsertColumn({
        Name => '_id',
        Type => $this->{$Parent}->TypeMapping->DBIdentifierType,
        Tag => ['AUTO_INCREMENT']
    });
    $table->SetPrimaryKey('_id');
    
    $table->InsertColumn({
        Name => 'parent',
        Type => $this->{$Parent}->TypeMapping->DBIdentifierType
    });
    
    $table->InsertColumn({
        Name => 'value',
        Type => $this->{$Parent}->TypeMapping->MapType($property->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'}),
        CanBeNull => 1
    });
    
    $this->{$PropertyTables}->{$property->Name} = $table;
    
    return $table;
}

sub CreateConstraints {
    my ($this,$schemaDB) = @_;
    return if $this->{$Class}->isTemplate or $this->{$Class}->GetAttribute('ValueType') or $this->{$Class}->Name->Simple eq 'Set';
    
    foreach my $prop ( grep { UNIVERSAL::isa($_,'Schema::Property') } $this->{$Class}->ListMembers ) {
        if ($prop->Type->Name->Name eq 'Set' ) {
            # special case for multiple values
            if (not $prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'}->GetAttribute('ValueType')) {
                $this->{$PropertyTables}->{$prop->Name}->LinkTo(
                    $this->{$Parent}->GetClassMapping($prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'})->Table,
                    'value'
                );
            }
        } elsif (not $prop->Type->GetAttribute('ValueType')) {
            $this->{$Table}->LinkTo(
                scalar($this->{$Parent}->GetClassMapping($prop->Type)->Table),
                $prop->Name
            );
        }
    }
}

sub GeneratePropertyTableText {
    my ($this,$prop,$baseModule,$prefix) = @_;
    
    my $packageName = $this->GeneratePropertyClassName($prop,$prefix);
    my $tableName = $this->{$PropertyTables}->{$prop->Name}->Name;
    my $parentName = $this->GenerateClassName($prefix);
    my $text .= "package $packageName;\n";
    $text .= "use base '$baseModule';\n\n";
    $text .= "__PACKAGE__->table('`$tableName`');\n";
    $text .= "__PACKAGE__->columns(Essential => qw/_id parent value/);\n";
    $text .= "__PACKAGE__->has_a( parent => '$parentName');\n";
    
    my $typeValue;
    if ($prop->Type->Name->Simple eq 'Set') {
        $typeValue = $prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'};
    } else {
        $typeValue = $prop->Type;
    }
    if ($typeValue->GetAttribute('ValueType')) {
        if (my $reflectedClass = $this->{$Parent}->ReflectValueType($typeValue)) {
            $text .= "__PACKAGE__->has_a( value => '$reflectedClass');\n";
        }
    } else {
        my $foreignName = $this->{$Parent}->GetClassMapping($prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'})->GenerateClassName($prefix);
        $text .= "__PACKAGE__->has_a( value => '$foreignName');\n";
    }
    
    return $text;
}

sub GeneratePropertyClassName {
    my ($this,$prop,$prefix) = @_;
    
    my $packageName = $this->{$Class}->Name->Canonical;
    $packageName =~ s/\W//g;
    return $prefix.$packageName.$prop->Name.'Ref';
}

sub GenerateClassName {
    my ($this,$prefix) = @_;
    my $packageName = $this->{$Class}->Name->Canonical;
    $packageName =~ s/\W//g;
    return $prefix. $packageName;
}

sub GenerateText {
    my ($this,$baseModule,$prefix) = @_;
    
    return if $this->{$Class}->isTemplate or $this->{$Class}->GetAttribute('ValueType') or $this->{$Class}->Name->Simple eq 'Set';
    
    my @PropertyModules;
    my $text;
    my $packageName = $this->GenerateClassName($prefix);
    
    my $tableName = $this->{$Table}->Name;
    my $listColumns = join ',', map { '\''. $_->Name . '\''} $this->{$Table}->Columns;
    
    $text .= "package $packageName;\n";
    $text .= "use base '$baseModule'". ($this->{$Class}->Name->Name eq 'Map' ? ',\'CDBI::Map\'' : '' ).";\n\n";
    
    $text .= "__PACKAGE__->table('`$tableName`');\n";
    $text .= "__PACKAGE__->columns(Essential => $listColumns);\n";
    
    foreach my $prop ( grep { UNIVERSAL::isa($_,'Schema::Property') } $this->{$Class}->ListMembers ) {
        my $propName = $prop->Name;
        if ($prop->Type->Name->Name eq 'Set') {
            # has_many
            push @PropertyModules, $this->GeneratePropertyTableText($prop,$baseModule,$prefix);
            my $propClass = $this->GeneratePropertyClassName($prop,$prefix);
            $text .= <<ACCESSORS;
__PACKAGE__->has_many( ${propName}_ref => '$propClass');
sub $propName {
    return map { \$_->value } ${propName}_ref(\@_);
}
sub add_to_$propName {
    return add_to_${propName}_ref(\@_);
}
ACCESSORS
            
        } elsif (not $prop->Type->GetAttribute('ValueType')) {
            # has_a
            my $ForeignClass = $this->{$Parent}->GetClassMapping($prop->Type)->GenerateClassName($prefix);
            $text .= "__PACKAGE__->has_a( $propName => '$ForeignClass');\n";
        } else {
            if (my $reflectedClass = $this->{$Parent}->ReflectValueType($prop->Type)) {
                $text .= "__PACKAGE__->has_a( $propName => '$reflectedClass');\n";
            }
        }
    }
    
    # создаем список дочерних классов
    foreach my $descedantMapping (grep {$_->{$Class}->isType($this->{$Class},1)} $this->{$Parent}->EnumClassMappings) {
        next if $descedantMapping == $this;
        $text .= "__PACKAGE__->might_have('m".$descedantMapping->GenerateClassName('')."' => '".$descedantMapping->GenerateClassName($prefix)."');\n";
    }
    
    # создаем ссылки на все классы, которые могут ссылаться на наш
    # вид свойства ссылки: refererClassProp
    foreach my $referer (grep {not $_->Class->isTemplate} $this->{$Parent}->EnumClassMappings) {
        next if $referer == $this;
        foreach my $prop ( grep { $_->isa('Schema::Property') } $referer->{$Class}->ListMembers ) {
            if($prop->Type->Equals($this->{$Class})) {
                $text .= "__PACKAGE__->has_many('referer".$referer->GenerateClassName('').$prop->Name."' => '".$referer->GenerateClassName($prefix)."','".$prop->Name."');\n";
            } elsif ($prop->Type->Name->Name eq 'Set' and $this->{$Class}->Equals($prop->Type->GetAttribute('TemplateInstance')->{'Parameters'}{'T'}) ) {
                # если класс был параметром множества и $prop->Type и есть это множество
                $text .= "__PACKAGE__->has_many('referer".$referer->GeneratePropertyClassName($prop,'')."value' => '".$referer->GeneratePropertyClassName($prop,$prefix)."','value');\n";
            }
        }
    }
    
    return (@PropertyModules,$text);
}

1;