" '$_', ".
"'". $self->table($table)->column($_)->type. "', ".
"'". $self->table($table)->column($_)->null. "', ".
- "'". $self->table($table)->column($_)->length. "',\n"
+ "'". $self->table($table)->column($_)->length. "', ".
+ "'". $self->table($table)->column($_)->local. "',\n"
} $self->table($table)->columns
).
" ],\n".
my(@columns);
while ( @{$href->{$_}{'columns'}} ) {
push @columns, DBIx::DBSchema::Column->new(
- splice @{$href->{$_}{'columns'}}, 0, 4
+ splice @{$href->{$_}{'columns'}}, 0, 5
);
}
DBIx::DBSchema::Table->new(
$column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL' );
$column = new DBIx::DBSchema::Column ( $name, $sql_type, '', $length );
$column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL', $length );
+ $column = new DBIx::DBSchema::Column ( $name, $sql_type, 'NULL', $length, $local );
$name = $column->name;
$column->name( 'name' );
=over 4
-=item new [ NAME [ , SQL_TYPE [ , NULL [ , LENGTH ] ] ] ]
+=item new [ NAME [ , SQL_TYPE [ , NULL [ , LENGTH [ , LOCAL ] ] ] ] ]
Creates a new DBIx::DBSchema::Column object. NAME is the name of the column.
SQL_TYPE is the SQL data type. NULL is the nullability of the column (the
empty string is equivalent to `NOT NULL'). LENGTH is the SQL length of the
-column.
+column. LOCAL is reserved for database-specific information.
=cut
sub new {
- my($proto,$name,$type,$null,$length)=@_;
+ my($proto,$name,$type,$null,$length,$local)=@_;
#croak "Illegal name: $name" if grep $name eq $_, @reserved_words;
'type' => $type,
'null' => $null,
'length' => $length,
+ 'local' => $local,
};
bless ($self, $class);
}
}
+=item local [ LOCAL ]
+
+Returns or sets the database-specific field.
+
+=cut
+
+sub local {
+ my($self,$value)=@_;
+ if ( defined($value) ) {
+ $self->{'local'} = $value;
+ } else {
+ $self->{'local'};
+ }
+}
+
=item line [ $datasrc ]
Returns an SQL column definition.
$self->name,
$self->type. ( $self->length ? '('.$self->length.')' : '' ),
$null,
+ ( ( $datasrc =~ /^dbi:mysql:/i )
+ ? $self->local
+ : ''
+ ),
);
}
=item columns CLASS DBI_DBH TABLE
Given an active DBI database handle, return a listref of listrefs (see
-L<perllol>), each containing four elements: column name, column type,
-nullability, and column length.
+L<perllol>), each containing five elements: column name, column type,
+nullability, column length, and a field reserved for driver-specific use.
=item primary_key CLASS DBI_DBH TABLE
$_->{'attname'},
$_->{'typname'},
! $_->{'attnotnull'},
- $_->{'attlen'} == -1
+ ( $_->{'attlen'} == -1
? $_->{'atttypmod'} - 4
: ''
+ ),
+ ''
]
} @{ $sth->fetchall_arrayref({}) };
}
$_->{'Type'} =~ /^(\w+)\(?([\d\,]+)?\)?( unsigned)?$/
or die "Illegal type: ". $_->{'Type'}. "\n";
my($type, $length) = ($1, $2);
- [ $_->{'Field'}, $type, $_->{'Null'}, $length ]
+ [ $_->{'Field'}, $type, $_->{'Null'}, $length, $_->{'Extra'} ]
} @{ $sth->fetchall_arrayref( {} ) };
}
my($proto,$name,$primary_key,$unique,$index,@columns)=@_;
my(%columns) = map { $_->name, $_ } @columns;
+ my(@column_order) = map { $_->name } @columns;
#check $primary_key, $unique and $index to make sure they are $columns ?
# (and sanity check?)
my $class = ref($proto) || $proto;
my $self = {
- 'name' => $name,
- 'primary_key' => $primary_key,
- 'unique' => $unique,
- 'index' => $index,
- 'columns' => \%columns,
+ 'name' => $name,
+ 'primary_key' => $primary_key,
+ 'unique' => $unique,
+ 'index' => $index,
+ 'columns' => \%columns,
+ 'column_order' => \@column_order,
};
bless ($self, $class);
sub addcolumn {
my($self,$column)=@_;
${$self->{'columns'}}{$column->name}=$column; #sanity check?
+ push @{$self->{'column_order'}}, $column->name;
}
=item name [ TABLE_NAME ]
sub columns {
my($self)=@_;
- keys %{$self->{'columns'}};
+ #keys %{$self->{'columns'}};
+ #must preserve order
+ @{ $self->{'column_order'} };
}
=item column COLUMN_NAME