exemple.p6

use QDORM;

class Author is rw {
    has Int $.id; #= qdb:primarykey
    has Str $.name;
  }
  
class Chapter is rw {
	has Int $.id; #= qdb:primarykey
	has Str $.title;
	has Int $.words;
}
  
class Story is rw {
	has Int $.id; #= qdb:primarykey
	has Str $.title;
	has Author $.author;
	has Str @.tags; #= qdb:pgarray
	has Chapter @.chapters; #= qdb:card=1
  }
  
class Bookshelf is rw {
    has Int $.id; #= qdb:primarykey
    has Str $.name;
    has Story @.stories;
}


my $con = DBConnection.new(:driver("Pg"));

say "== HELO ==";

class StorableStory is Story does QDBStorable {
}

my StorableStory $s;

say "== Creation ==";
#Table Creation
qdorm-create-table(Bookshelf);

say "== Story from DB ==";
#Load from DB
$s.new-from-db(42);

say "== DELETE ==";
#Delete
$s.db-delete();


my $s1 = Story.new;
$s1 does QDBStorable;
#Save to DB
$s1.db-save();

gistfile1.txt

Type check failed in binding to parameter '<anon>'; expected QDORM::QDBStorable but got StorableStory (StorableStory.new(_qd...)
  in method  at /home/skarsnik/perl6/qdorm/lib/QDORM.pm (QDORM) line 93
  in method new-from-db at /home/skarsnik/perl6/qdorm/lib/QDORM.pm (QDORM) line 133

QDORM.pm6

module QDORM {

my %seen-classes{Any};

sub get-db-instruction(Attribute $attr) {
  my %instr;
  if $attr.WHY.defined and $attr.WHY ~~ /^'qdb:'(.+)/ {
    my @qdb-instr = $0.split(';');  
    for @qdb-instr -> $instr {
      if $instr ~~ /^'name='(.+)/ {
        %instr<name> = $0;
      }
      if $instr ~~ /^primarykey/ {
        %instr<primary-key> = True;
      }
      if $instr ~~ /^"card="(.)/ {
        %instr<card> = $0;
      }
      if $instr ~~ /^pgarray/ {
        %instr<pgarray> = True;
      }
    }
    return %instr;
  }
  return Hash.new
}

sub generate-fk($table-name, $field-name) {
  return $table-name.lc ~ '_' ~ $field-name.lc;
}

sub build-qdorm-data($type) {
  my %data;
  $type.^name ~~ /^(<-[+]>+)/;
  %data<table-name> = $0.Str.split('::').tail.[0];
  for $type.^attributes -> $attr {
      next if $attr.name ~~ /^.'!_qdb'/;
      my %instr = get-db-instruction($attr);
      given $attr.type {
        #say $attr.name;      
        when Positional {
          say "--Array";
          next if %instr<pgarray>; #Do nothing with pgarray for now;
          #next unless $attr.type.of; #Non typed array are ignored
          say "--Do something";
          if ! CORE::{$attr.type.of.^name}.defined {
            build-qdorm-data($attr.type.of) unless %seen-classes{$attr.type.of}:exists;
            my %tdata := %seen-classes{$attr.type.of};
            #The relation is n-1, we need to add a fk in the target class
            if %instr<card>:exists and %instr<card> eq '1' {
              %tdata<added-foreign-keys>.push(%data<table-name> , %data<primary-key>);
              %data<external-foreign-keys>{$attr.name} = $attr.type.of;
            } else {
              %data<relation-tables>{$attr.name} = $attr.type.of;
            }
          }
          
        }
        when Hash {
        
        }
        default {
            #Probably need to no something else, like having a list of valid type
            if CORE::{$attr.type.^name}:exists {
               my $name = %instr<name>:exists ?? %instr<name> !! $attr.name.substr(2);
               %data<fields>{$attr.name.substr(2)} = $name;
               %data<primary-key> = $name if %instr<primary-key>;
            }
            else {
              %data<foreign-key>{$attr.name.substr(2)} = $attr.name.substr(2);
            }        
        }
     }
  }

  die "No primary key found" unless %data<primary-key>:exists;
  %seen-classes{$type} = %data;
  return %data;
}


class DBConnection is export {
  has Str $.driver;
  has	  $.dbh;
}

role QDBStorable is export {
  has	$._qdb-connection;#  = $connection;
  has	$._qdb-insert-sth;
  has	$!_qdb-update-sth;
  has   $._qdb-select-sth;
  has	%._qdb-data;
  has Bool	$._qdb-init-done = False;
  
  method	_qdb-init {
    return if $!_qdb-init-done;
    %!_qdb-data = build-qdorm-data(self);
    my $sql-insert = "INSERT INTO " ~ %!_qdb-data<table-name> ~ "(" ~ (%!_qdb-data<fields>.keys.sort.map:{%!_qdb-data<fields>{$_}}).join(",");
    my @extra = ();
    if %!_qdb-data<added-foreign-keys>:exists {
      for %!_qdb-data<added-foreign-keys> -> @t {
        @extra.push(generate-fk(@t[0], @t[1]));
      }
    }
    $sql-insert ~= ',' ~ @extra.join(',') if @extra.elems;
    $sql-insert ~= ') VALUES(' ~ (('?') xx %!_qdb-data<fields>.elems + @extra.elems).join(',') ~ ')';
    my $sql-update = "UPDATE %!_qdb-data<table-name> SET(" ~ (%!_qdb-data<fields>.keys.sort.map:{%!_qdb-data<fields>{$_}}).join(",") ~ ')';
    $sql-update ~= ' = (' ~ (('?') xx %!_qdb-data<fields>.elems).join(',') ~ ") WHERE %!_qdb-data<primary-key> = ?;";
    
    my $sql-select = "SELECT " ~ %!_qdb-data<table-name> ~ "(" ~ (%!_qdb-data<fields>.keys.sort.map:{%!_qdb-data<fields>{$_}}).join(",");
    $sql-select ~= ') WHERE ' ~ %!_qdb-data<primary-key> ~ ' = ?';
    #say $sql-update;
    #say $sql-insert;
    $!_qdb-update-sth = $sql-update;
    $!_qdb-insert-sth = $sql-insert;
    $!_qdb-select-sth = $sql-select;
    #$!_qdb-update-sth = $!_qdb-connection.dbh.prepare($sql-update);
    #$!_qdb-insert-sth = $!_qdb-connection.dbh.prepare($sql-insert);
    $!_qdb-init-done = True;
  }
  
  method db-save {
    self._qdb-init();
    
  }
  
  method db-delete {
    say "DELETE";
  }
  
  method new-from-db($prim-key) {
    say "REQUESTED NEW";
    my $s = self.bless;
    $s._qdb-init();
    say $s._qdb-select-sth;
    for $s._qdb-data<added-foreign-keys> -> ($k, $v) {
      say $k, $v;
    }
    return $s;
  }
}

sub qdorm-create-table($a) is export {
  say "-----CREATE {$a.^shortname}----";
  my %data = %seen-classes{$a}:exists ?? %seen-classes{$a} !! build-qdorm-data($a);
  
  my $str = 'Create TABLE ' ~ %data<table-name> ~ "(\n";
  my @attrstr;
  for $a.^attributes -> $att {
    my $astr = '';
    given $att.type {
      when Str {
        $astr ~= %data<fields>{$att.name.substr(2)} ~ ' varchar(255)';
      }
      when Int {
        $astr ~= %data<fields>{$att.name.substr(2)} ~ ' Int';
      }
      when Bool {
        $astr ~= %data<fields>{$att.name.substr(2)} ~ ' Boolean';
      }
      when Positional {
        #say $att.type.of;
        qdorm-create-table($att.type.of) if $att.type.of !=== Any and ! (CORE::{$att.type.of.^name}:exists);
      }
      default {
        if ! (CORE::{$att.type.^name}:exists) {
          qdorm-create-table($att.type);
          $astr ~= %data<foreign-key>{$att.name.substr(2)}.lc ~ '_id Int REFERENCES ' ~ 
             %seen-classes{$att.type}<table-name> ~ '(' ~ %seen-classes{$att.type}<primary-key> ~ ')';
        }
      }
    }
    $astr ~= ' PRIMARY KEY ' if %data<primary-key> eq $att.name.substr(2);
    @attrstr.push($astr) if $astr ne '';
  }
  if %data<added-foreign-keys>:exists {
    for %data<added-foreign-keys> -> @t {
      #say @t;
      @attrstr.push(generate-fk(@t[0], @t[1]) ~ " Int REFERENCES {@t[0]}({@t[1]})");
    }
  }
  $str ~= @attrstr.join(",\n") ~ "\n);";
  say $str;
  if %data<relation-tables>:exists {
    for %data<relation-tables>.kv -> $a, $t {
      say 'Create TABLE ' ~ %data<table-name>.lc ~ '_' ~ $a.substr(2) ~ '_' ~  %seen-classes{$t}<table-name>.lc ~ " (\n";
      say generate-fk(%seen-classes{$t}<table-name>, %seen-classes{$t}<primary-key>) ~ " Int REFERENCES {%seen-classes{$t}<table-name>} ({%seen-classes{$t}<primary-key>}),";
      say generate-fk(%data<table-name>, %data<primary-key>) ~ " Int REFERENCES {%data<table-name>} ({%data<primary-key>}),";
      say ");";
    }
  }
  
}


}