Index: branches/release-35/lib/MT/Asset/Image.pm =================================================================== --- branches/release-35/lib/MT/Asset/Image.pm (revision 1829) +++ branches/release-35/lib/MT/Asset/Image.pm (revision 1927) @@ -10,6 +10,11 @@ use base qw( MT::Asset ); -__PACKAGE__->install_properties( { class_type => 'image', } ); -__PACKAGE__->install_meta( { columns => [ 'image_width', 'image_height', ], } ); +__PACKAGE__->install_properties( { + class_type => 'image', + column_defs => { + 'image_width' => 'integer meta', + 'image_height' => 'integer meta', + }, +} ); # List of supported file extensions (to aid the stock 'can_handle' method.) Index: branches/release-35/lib/MT/Upgrade.pm =================================================================== --- branches/release-35/lib/MT/Upgrade.pm (revision 1897) +++ branches/release-35/lib/MT/Upgrade.pm (revision 1927) @@ -1352,4 +1352,10 @@ } } + + # handle schema updates for meta table + if ($class->meta_pkg) { + $self->check_type($type . ':meta'); + } + 1; } Index: branches/release-35/lib/MT/Author.pm =================================================================== --- branches/release-35/lib/MT/Author.pm (revision 1823) +++ branches/release-35/lib/MT/Author.pm (revision 1927) @@ -37,4 +37,8 @@ 'userpic_asset_id' => 'integer', 'basename' => 'string(255)', + + # meta properties + 'widgets' => 'hash meta', + 'favorite_blogs' => 'array meta', }, defaults => { @@ -59,10 +63,4 @@ audit => 1, }); -__PACKAGE__->install_meta({ - columns => [ - 'favorite_blogs', - 'widgets', - ], -}); sub class_label { @@ -263,5 +261,5 @@ die unless $perms->isa('MT::Permission'); $perms->can_edit_all_posts || - ($perms->can_create_post && $entry->author_id == $author->id); + ($perms->can_create_post && $entry->author_id == $author->id); } Index: branches/release-35/lib/MT/Meta/Proxy.pm =================================================================== --- branches/release-35/lib/MT/Meta/Proxy.pm (revision 1927) +++ branches/release-35/lib/MT/Meta/Proxy.pm (revision 1927) @@ -0,0 +1,498 @@ +# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd. +# This program is distributed under the terms of the +# GNU General Public License, version 2. +# +# $Id: Proxy.pm 71506 2008-01-18 23:13:43Z ykerherve $ + +package MT::Meta::Proxy; +use strict; +use warnings; + +use MT::Meta; +use MT::Serialize; + +our $HAS_ZLIB = 0; +eval "require Compress::Zlib;"; +$HAS_ZLIB = 1 unless $@; + +my $serializer = MT::Serialize->new('MT'); + +sub new { + my $class = shift; + my($obj) = @_; + my $proxy = bless { pkg => ref($obj) }, $class; + $proxy->set_primary_keys($obj) if $obj->has_primary_key; + $proxy; +} + +sub is_changed { + my $proxy = shift; + my($col) = @_; + return unless $proxy->{__objects}; ## don't remove this line + ## see below. we should probably change this idiom + + if ($col) { + return 0 unless exists $proxy->{__objects}{$col}; + my $pkg = $proxy->{pkg}; + my $meta = $proxy->{__objects}{$col}; + my $field = MT::Meta->metadata_by_name($pkg, $col) + or return 0; + my $type = $field->{type} + or return 0; + return $meta->is_changed($type); + } else { + foreach my $field (keys %{ $proxy->{__objects} } ) { + next if $field eq ''; + return 1 if $proxy->is_changed($field); + } + return; + } +} + +sub exists_meta { + my $proxy = shift; + my($col) = @_; + + $proxy->lazy_load_objects; + return exists $proxy->{__objects}->{$col}; +} + +sub get { + my $proxy = shift; + my ($col) = @_; + + $proxy->lazy_load_objects; + + if (exists $proxy->{__objects}->{$col}) { + my $pkg = $proxy->{pkg}; + my $meta = $proxy->{__objects}->{$col}; + + my $field = MT::Meta->metadata_by_name($pkg, $col) + or Carp::croak("Metadata $col on $pkg not found."); + my $type = $field->{type} + or Carp::croak("$col not found on $pkg meta fields"); + + unless ($meta->has_column($type)) { + Carp::croak("something is wrong: $type not in column_values of metadata"); + } + return $meta->$type; + } else { + ## no metadata row in the database ... return undef, not '' + return undef; + } +} + +sub get_hash { + my $proxy = shift; + my ($col) = @_; + + $proxy->lazy_load_objects; + + my $collection = {}; + + foreach my $name (keys %{ $proxy->{__objects} }) { + $collection->{$name} = $proxy->get($name); + } + + return $collection; +} + +sub get_collection { + my $proxy = shift; + my ($col) = @_; + + $proxy->lazy_load_objects; + + my $collection = {}; + + foreach my $name (keys %{ $proxy->{__objects} }) { + if ($name =~ m/^\Q$col\E\.(.+)$/) { + my $suffix = $1; + $collection->{$suffix} = $proxy->get($name); + } + } + + return $collection; +} + +sub meta_pkg { + my $proxy = shift; + return $proxy->{pkg}->meta_pkg; +} + +sub create_meta_object { + my $proxy = shift; + my($col, $value) = @_; + + my $pkg = $proxy->{pkg}; + my $meta = $proxy->meta_pkg->new; + + my $field = MT::Meta->metadata_by_name($pkg, $col) + or Carp::croak("there's no field $col on $pkg"); + + my $type_id = $field->{type_id} + or Carp::croak("no type_id for $col"); + my $id = $field->{id}; + my $type = $MT::Meta::Types{$type_id}; + + $meta->type($col); + $meta->$type($value); + + $meta; +} + +sub set { + my $proxy = shift; + my ($col, $value) = @_; + + # xxx When you update the metadata, you have to preserve the + # original data as well. This should be eliminated by adding the + # update optimization for metadata columns + $proxy->lazy_load_objects; + + $proxy->{__objects}->{$col} = $proxy->create_meta_object($col, $value); + $proxy->get($col); +} + +sub save { + my $proxy = shift; + + # perl funkiness ... keys %{ $proxy->{__objects} } will automatically clobber + # empty hash reference on that key! + return unless $proxy->{__objects}; + + foreach my $field (keys %{ $proxy->{__objects} } ) { + next if $field eq ''; + next unless $proxy->is_changed($field); + my $meta_obj = $proxy->{__objects}->{$field}; + + ## primary key from core object + foreach my $pkey (keys %{ $proxy->{__pkeys} } ) { + my $pval = $proxy->{__pkeys}->{$pkey}; + $meta_obj->$pkey($pval); + } + + my $pkg = $proxy->{pkg}; + my $meta = MT::Meta->metadata_by_name($pkg, $field) + or Carp::croak("Metadata $field on $pkg not found."); + my $type = $meta->{type}; + + my $meta_col_def = $meta_obj->column_def($type); + my $meta_is_blob = $meta_col_def ? $meta_col_def->{type} eq 'blob' : 0; + + ## xxx can be a hook? + if ( ! defined $meta_obj->$type() ) { + $meta_obj->remove; + } + else { + serialize_blob($field, $meta_obj) if $meta_is_blob; + if ($MT::Meta::REPLACE_ENABLED) { + $meta_obj->replace; + } + else { + $meta_obj->save; + } + unserialize_blob($meta_obj) if $meta_is_blob; + } + } +} + +sub remove { + my $proxy = shift; + my $meta_pkg = $proxy->meta_pkg; + Carp::croak("Deletion of meta without PK installed") + unless $proxy->{__pkeys}; + + my %args = ($_[1] and ref($_[1]) eq 'HASH') ? %{ $_[1] } : (); + $args{nofetch} = 1; + + $meta_pkg->remove($proxy->{__pkeys}, \%args); + + delete $proxy->{__objects}; +} + +sub set_primary_keys { + my ($proxy, $obj) = @_; + + if (my $pkmap = $proxy->meta_pkg->properties->{pk_map}) { + my $pkeys; + while (my($object_key, $meta_key) = each %$pkmap) { + $pkeys->{$meta_key} = $obj->$object_key(); + } + $proxy->{__pkeys} = $pkeys; + return; + } + ## Map the N fields of the object's primary key to the first N fields of the meta object's primary key. + ## TODO: can we assume the meta class's primary key starts with the host package's primary key? + ## TODO: isn't there some idiom for iterating over two arrays in tandem? + my @class_keys = @{ $obj->primary_key_tuple }; + my @meta_keys = @{ $proxy->meta_pkg->primary_key_tuple }; + my $pkeys = {}; + for my $i (0..$#class_keys) { + my $pkey = $class_keys[$i]; + $pkeys->{$meta_keys[$i]} = $obj->$pkey(); + } + + $proxy->{__pkeys} = $pkeys; +} + +sub lazy_load_objects { + my $proxy = shift; + $proxy->load_objects if ! exists $proxy->{__objects} && $proxy->{__pkeys}; +} + +sub load_objects { + my $proxy = shift; + + my $pkg = $proxy->{pkg}; + my $meta_pkg = $proxy->meta_pkg; + + my @objs = $meta_pkg->search($proxy->{__pkeys}); + + foreach my $meta_obj (@objs) { + my $type_id = $meta_obj->type; + + my $field = MT::Meta->metadata_by_id($pkg, $type_id); + unless ($field) { + MT->log("Metadata ID $type_id on $pkg not found"); + next; + } + + my $name = $field->{name}; + my $type = $field->{type}; + + my $meta_col_def = $meta_obj->column_def($type); + my $meta_is_blob = $meta_col_def ? $meta_col_def->{type} eq 'blob' : 0; + + unserialize_blob($meta_obj) if $meta_is_blob; + $proxy->{__objects}->{$name} = $meta_obj; + } +} + +# This expose our unserialization just in case someone needs it +# PhenoType differ does. +sub do_unserialization { + my $class = shift; + my $dataref = shift; + + return $dataref unless defined $$dataref; + $$dataref =~ s/^([ABCINPSZ]{3})://; + my $prefix = $1; + unless (defined $prefix) { + return $dataref; + } + + if ($prefix eq 'ZIP') { + unless ($HAS_ZLIB) { + Carp::croak("FATAL: cannot deal with this zipped data, Zlib is missing"); + } + my $deflated = Compress::Zlib::uncompress($dataref); + unless ($deflated =~ s/^(BIN|ASC)://) { + Carp::croak("Cannot find subprefix in 'ZIP:' blob $deflated"); + } + my $subprefix = $1; + if ($subprefix eq 'BIN') { + my $val = $serializer->unserialize($deflated); + if (defined $val) { + return $val; # it's a ref already. + } else { + return \$val; + } + } + else { + return \$deflated; + } + } elsif ($prefix eq 'BIN') { + my $val = $serializer->unserialize($$dataref); + if (defined $val) { + return $val; # it's a ref already. + } else { + return \$val; + } + } elsif ($prefix eq 'ASC') { + return $dataref; + } else { + warn "Something's wrong with the data: prefix is $prefix"; + return $dataref; + } +} + +sub unserialize_blob { + my $meta_obj = shift; + for my $column (@{ $meta_obj->columns_of_type('blob') }) { + my $data = $meta_obj->$column(); + + my $unser = do_unserialization($meta_obj, \$data); + + # set it back to the unserialized data structure + $meta_obj->$column($$unser, { no_changed_flag => 1 }); + } +} + +sub serialize_blob { + my $field = shift; + my $meta_obj = shift; + for my $column (@{ $meta_obj->columns_of_type('blob') }) { + my $data = $meta_obj->$column(); + + my $val; + if (ref $data) { + $val = 'BIN:' . $serializer->serialize(\$data); + } elsif (defined $data) { + $val = 'ASC:' . $data; + } else { + $val = undef; + } + + if ($HAS_ZLIB && defined $val && $meta_obj->blob_requires_zip($field, \$val)) { + my $zipped = Compress::Zlib::compress($val); + $val = 'ZIP:' . $zipped; + } + + # set it back the serialized data + $meta_obj->$column($val, { no_changed_flag => 1 }); + } +} + +sub deflate_meta { + my $proxy = shift; + + ## Load all metadata for the object, so that we can store it. Odds are, + ## we've already got it anyway. + $proxy->lazy_load_objects; + + my $meta = {}; + for my $field (keys %{ $proxy->{__objects} } ) { + next if $field eq ''; + $meta->{$field} = $proxy->get($field); + } + $meta; +} + +sub inflate_meta { + my $proxy = shift; + my($deflated) = @_; + for my $key (keys %$deflated) { + my $value = eval { $proxy->create_meta_object($key, $deflated->{$key}) }; + next if $@; ## probably 2 versions of the code using the same memcached + $proxy->{__objects}{$key} = $value; + $proxy->{__objects}{$key}{changed_cols} = {}; + } +} + +sub refresh { + my $proxy = shift; + # just delete and let the Proxy lazy load it afterwards + delete $proxy->{__objects}; + return 1; +} + +1; + +__END__ + +=head1 NAME + +MT::Meta::Proxy - interface to a MT::Object's meta data object + +=head1 SYNOPSIS + + package Foo; + use base qw( MT::Object ); + + __PACKAGE__->install_properties({ ... }); + + __PACKAGE__->install_meta({ + datasource => 'foo_meta', + fields => [ + { name => 'selfaware', type => 'vchar', key => 1 }, + ], + }); + + sub meta_args { + +{ key => 'foo' }; + } + + + package main; + # then what? + + +=head1 DESCRIPTION + +The I is the interface between a I and +its meta data class generated by I. + +=head1 USAGE + +=head2 MT::Meta::Proxy->new($obj) + +Returns a new metadata proxy to manage metadata for the given +I instance. + +=head2 $proxy->get($field) + +Returns the value of the metadata field I<$field> represented by this proxy. + +=head2 $proxy->meta_pkg() + +Returns the name of the class containing the metadata this proxy will get and +set. The meta data class name is typically the original I +class appended with C<::Meta>. + +=head2 $proxy->create_meta_object($field, $value) + +Returns a new instance of the meta data class this proxy manages, representing +the metadata field I<$field> and containing the value I<$value>. + +As I will not put the object under this proxy's management, +you should not use it directly, but instead prefer to use I. + +=head2 $proxy->set($field, $value) + +Sets the metadata field I<$field> under this proxy's care to the value I<$value>. + +=head2 $proxy->save() + +Saves each of the meta data objects this proxy manages that have been changed. + +=head2 $proxy->remove() + +Removes all of the meta data objects this proxy manages from the database and +local memory storage. + +=head2 $proxy->set_primary_keys($obj) + +Sets the primary keys of I<$proxy> to those of the MT::Object instance +I<$obj>. + +=head2 $proxy->lazy_load_objects() + +Loads the meta data objects this proxy manages if they have not already been +loaded and cached in local memory storage. The actual loading is performed by +I. + +=head2 $proxy->load_objects() + +Loads all the meta data objects this proxy manages into local memory storage, +regardless of whether they've already been loaded. + +=head2 $proxy->deflate_meta() + +Returns a flat hash reference containing all the metadata managed by this +proxy. + +=head2 $proxy->inflate_meta($hash) + +Restores the internal state of this proxy with the metadata fields and values +found in the flat hash reference I<$hash>. Note the proxy will assume that the +hash contains the saved values of the meta data. That is, the fields named in +I<$hash> will I be marked as changed by I. + + +=head1 SEE ALSO + +I, I + +=cut + Index: branches/release-35/lib/MT/Blog.pm =================================================================== --- branches/release-35/lib/MT/Blog.pm (revision 1868) +++ branches/release-35/lib/MT/Blog.pm (revision 1927) @@ -77,4 +77,26 @@ 'archive_tmpl_category' => 'string(255)', 'archive_tmpl_individual' => 'string(255)', + + # meta properties + 'image_default_wrap_text' => 'integer meta', + 'image_default_align' => 'string meta', + 'image_default_thumb' => 'integer meta', + 'image_default_width' => 'integer meta', + 'image_default_wunits' => 'integer meta', + 'image_default_constrain' => 'integer meta', + 'image_default_popup' => 'integer meta', + 'commenter_authenticators' => 'string meta', + 'require_typekey_emails' => 'integer meta', + 'nofollow_urls' => 'integer meta', + 'follow_auth_links' => 'integer meta', + 'update_pings' => 'integer meta', + 'captcha_provider' => 'string meta', + 'publish_queue' => 'integer meta', + 'nwc_smart_replace' => 'integer meta', + 'nwc_replace_field' => 'string meta', + 'template_set' => 'string meta', + 'page_layout' => 'string meta', + 'include_system' => 'integer meta', + 'include_cache' => 'integer meta', }, meta => 1, @@ -93,28 +115,4 @@ datasource => 'blog', primary_key => 'id', -}); -__PACKAGE__->install_meta({ - columns => [ - 'image_default_wrap_text', - 'image_default_align', - 'image_default_thumb', - 'image_default_width', - 'image_default_wunits', - 'image_default_constrain', - 'image_default_popup', - 'commenter_authenticators', - 'require_typekey_emails', - 'nofollow_urls', - 'follow_auth_links', - 'update_pings', - 'captcha_provider', - 'publish_queue', - 'nwc_smart_replace', - 'nwc_replace_field', - 'template_set', - 'page_layout', - 'include_system', - 'include_cache', - ], }); Index: branches/release-35/lib/MT/Object.pm =================================================================== --- branches/release-35/lib/MT/Object.pm (revision 1873) +++ branches/release-35/lib/MT/Object.pm (revision 1927) @@ -53,12 +53,23 @@ } + my %meta; + my $super_props = $class->SUPER::properties(); + $props->{meta} = 1 if $super_props && $super_props->{meta}; + + if ($props->{meta}) { + # yank out any meta columns before we start working on column_defs + $meta{$_} = delete $props->{column_defs}{$_} + for grep { $props->{column_defs}{$_} =~ m/\bmeta\b/ } + keys %{ $props->{column_defs} }; + } + if ($super_props) { # subclass; merge hash - for (qw(primary_key meta_column class_column datasource driver audit meta)) { + for (qw(primary_key class_column datasource driver audit)) { $props->{$_} = $super_props->{$_} if exists $super_props->{$_} && !(exists $props->{$_}); } - for my $p (qw(column_defs defaults indexes meta_columns)) { + for my $p (qw(column_defs defaults indexes)) { if (exists $super_props->{$p}) { foreach my $k (keys %{ $super_props->{$p} }) { @@ -81,9 +92,8 @@ # Legacy MT::Object types only define 'columns'; we still support that # but they aren't handled properly with the upgrade system as a result. - if (exists $props->{column_defs}) { - $props->{columns} = [ keys %{ $props->{column_defs} } ]; - } else { + if (! exists $props->{column_defs}) { map { $props->{column_defs}{$_} = () } @{ $props->{columns} }; } + $props->{columns} = [ keys %{ $props->{column_defs} } ]; # Support audit flags @@ -98,16 +108,4 @@ } - # Metadata column - $props->{meta_column} ||= 'meta' if exists $props->{meta}; - if (my $col = $props->{meta_column}) { - if (!$props->{column_defs}{$col}) { - $props->{column_defs}{$col} = 'blob'; - push @{ $props->{columns} }, $col; - } - no strict 'refs'; ## no critic - *{$class . '::' . $col} = \&__meta_column; - $class->add_trigger( pre_save => \&pre_save_serialize_metadata ); - } - # Classed object types $props->{class_column} ||= 'class' if exists $props->{class_type}; @@ -151,5 +149,5 @@ foreach my $isa_class (@classes) { next if UNIVERSAL::isa($class, $isa_class); - eval "require $isa_class;" or die; + eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $isa_class;" or die; no strict 'refs'; ## no critic push @{$class . '::ISA'}, $isa_class; @@ -160,4 +158,9 @@ for my $name (keys %$cols) { next if exists $props->{column_defs}{$name}; + if ($cols->{$name} =~ m/\bmeta\b/) { + $meta{$name} = $cols->{$name}; + next; + } + $class->install_column($name, $cols->{$name}); $props->{indexes}{$name} = 1 @@ -226,4 +229,10 @@ no strict 'refs'; ## no critic *{$class . '::driver'} = sub { $_[0]->dbi_driver(@_) }; + } + + # inherit parent's metadata setup + if ($props->{meta}) { # if ($super_props && $super_props->{meta_installed}) { + $class->install_meta({ ( %meta ? ( column_defs => \%meta ) : ( columns => [] ) ) }); + $class->add_trigger( post_remove => \&remove_meta ); } @@ -347,7 +356,7 @@ return $package; } else { - eval "use $package;"; + eval "# line " . __LINE__ . " " . __FILE__ . "\nuse $package;"; return $package unless $@; - eval "use $pkg; $package->new;"; + eval "# line " . __LINE__ . " " . __FILE__ . "\nuse $pkg; $package->new;"; return $package unless $@; } @@ -373,88 +382,215 @@ # 'meta' metadata column support +sub new { + my $class = shift; + my $obj = $class->SUPER::new(@_); + if ($obj->properties->{meta_installed}) { + $obj->init_meta(); + } + return $obj; +} + +sub init_meta { + my $obj = shift; + require MT::Meta::Proxy; + $obj->{__meta} = MT::Meta::Proxy->new($obj); +} + sub install_meta { my $class = shift; - my ($props) = @_; + my ($params) = @_; if ( ( $class ne 'MT::Config' ) && (!$MT::plugins_installed) ) { - push @PRE_INIT_META, [$class, $props]; + push @PRE_INIT_META, [$class, $params]; return; } - my $cprops = $class->properties; - my $fields = $cprops->{meta_columns} ||= {}; - my $meta_col = $cprops->{meta_column}; - foreach my $name (@{ $props->{columns} }) { - $fields->{$name} = (); - # Skip adding this method if the class overloads it. - # this lets the SUPER::columnname magic do it's thing - unless ($class->can($name)) { - no strict 'refs'; ## no critic - *{"${class}::$name"} = sub { shift->$meta_col($name, @_) }; - } - } + + require MT::Meta; + my $pkg = ref $class || $class; + if (!$pkg->SUPER::properties->{meta_installed}) { + $pkg->add_trigger( post_save => \&post_save_save_metadata ); + $pkg->add_trigger( post_load => \&post_load_initialize_metadata ); + } + + my $props = $class->properties; + + if (!$params->{columns} && !$params->{fields} && !$params->{column_defs}) { + return $class->error('No meta fields specified to install_meta'); + } + + $params->{fields} ||= []; + if (my $cols = delete $params->{columns}) { + foreach my $col (@$cols) { + push @{ $params->{fields} }, { + name => $col, + type => 'vblob', + }; + # $props->{fields}{$col} = 'vblob'; + } + } + if (my $cols = delete $params->{column_defs}) { + foreach my $col ( keys %$cols ) { + my $type = $cols->{$col}; + $type =~ s/\s.*//; # take first keyword, ignoring anything after + $type .= '_indexed' + if $cols->{$col} =~ m/\bindexed\b/; + $type = MT::Meta->normalize_type($type); + + push @{ $params->{fields} }, { + name => $col, + type => $type, + }; + # $props->{fields}{$col} = $type; + } + } + + $params->{datasource} ||= $class->datasource . '_meta'; + + if ($props->{meta_installed} && !@{ $params->{fields} }) { + return 1; + } + + if (my $fields = MT::Meta->install($pkg, $params)) { + # we may have inherited meta fields so lets update with + # the fields returned by MT::Meta + $props->{fields} = $fields; + } + + return $props->{meta_installed} = 1; +} + +sub meta_args { + my $class = shift; + my $id_field = $class->datasource . '_id'; + return { + key => $class->datasource, + column_defs => { + $id_field => 'integer not null', + type => 'string(255) not null', + vchar => 'string(255)', + vchar_indexed => 'string(255)', + vdatetime => 'datetime', + vdatetime_indexed => 'datetime', + vinteger => 'integer', + vinteger_indexed => 'integer', + vfloat => 'float', + vfloat_indexed => 'float', + vblob => 'blob', + vclob => 'text', + }, + columns => [ $id_field, qw( + type + vchar + vchar_indexed + vdatetime + vdatetime_indexed + vinteger + vinteger_indexed + vfloat + vfloat_indexed + vblob + vclob + ) ], + indexes => { + $id_field => 1, + id_type => { columns => [ $id_field, 'type' ] }, + id_type_vchar => { columns => [ $id_field, 'type', 'vchar_indexed' ] }, + id_type_vdatetime => { columns => [ $id_field, 'type', + 'vdatetime_indexed' ] }, + id_type_vinteger => { columns => [ $id_field, 'type', + 'vinteger_indexed' ] }, + id_type_vfloat => { columns => [ $id_field, 'type', + 'vfloat_indexed' ] }, + }, + primary_key => [ $class->datasource . '_id', 'type' ], + }; } sub has_meta { - my $props = $_[0]->properties; - return $props->{meta} && (@_ > 1 ? exists $props->{meta_columns}{$_[1]} : 1); -} - -sub pre_save_serialize_metadata { - my ($obj) = shift; - my $meta_col = $obj->properties->{meta_column}; - if ($obj->{changed_cols}{$meta_col}) { - require MT::Serialize; - my $meta = $obj->$meta_col; - $obj->$meta_col(MT::Serialize->serialize(\$meta)); - } -} - -sub __thaw_meta { - my ($meta) = @_; - $$meta = '' unless defined $$meta; - require MT::Serialize; - my $out = MT::Serialize->unserialize($$meta); - if (ref $out eq 'REF') { - return $$out; - } else { - return {}; - } -} - -# $obj->meta returns a hashref of metadata information -# $obj->meta($scalar) allows assignment of a serialized value -# $obj->meta('name', 'value') assigns an individual metadata element -# $obj->meta('name') returns an individual metadata value -# $obj->save will automatically serialize the metadata back to the database -sub __meta_column { - my $obj = shift; - my $meta_col = $obj->properties->{meta_column} or return; - - if (@_) { - my $var = shift; - if ((defined $var) && ($var =~ m/^SERG\0\0\0\0/)) { - return $obj->column($meta_col, $var); - } - my $meta = $obj->column($meta_col); - if (!defined($meta)) { - $obj->{column_values}{$meta_col} = $meta = {}; - } elsif (!ref $meta) { - $obj->{column_values}{$meta_col} = $meta = __thaw_meta(\$meta); - } + my $obj = shift; + return $obj->is_meta_column(@_) if @_; + return $obj->properties->{meta_installed} ? 1 : 0; +} + +sub post_load_initialize_metadata { + my $obj = shift; + if (defined $obj && $obj->properties->{meta_installed}) { + $obj->init_meta(); + $obj->{__meta}->set_primary_keys($obj); + } +} + +sub is_meta_column { + my $obj = shift; + my ($field) = @_; + + my $props = $obj->properties; + return unless $props->{meta_installed}; + + my $meta = $obj->meta_pkg; + return 1 if $props->{fields}{$field}; + + return; +} + +sub meta_pkg { + my $class = shift; + my $props = $class->properties; + return unless $props->{meta}; # this only works for meta-enabled classes + + return $props->{meta_pkg} if $props->{meta_pkg}; + + my $meta = ref $class || $class; + $meta .= '::Meta'; + return $props->{meta_pkg} = $meta; +} + +sub has_column { + my $obj = shift; + return 1 if $obj->SUPER::has_column(@_); + return 1 if $obj->is_meta_column(@_); + return; +} + +sub post_save_save_metadata { + my $obj = shift; + if (defined $obj && exists $obj->{__meta}) { + $obj->{__meta}->set_primary_keys($obj); + $obj->{__meta}->save; + } +} + +sub meta { + my $obj = shift; + my ($name, $value) = @_; + + return !$obj->{__meta} ? undef + : 2 == scalar @_ ? $obj->{__meta}->set($name, $value) + : 1 == scalar @_ ? $obj->{__meta}->get($name) + : $obj->{__meta}->get_hash + ; +} + +sub meta_obj { + my $obj = shift; + return $obj->{__meta}; +} + +sub column_func { + my $obj = shift; + my ($col) = @_; + return if !$col; + + return $obj->SUPER::column_func(@_) + if !$obj->is_meta_column($col); + + return sub { + my $obj = shift; if (@_) { - $meta->{$var} = shift if @_; - $obj->{changed_cols}{$meta_col}++; - } - return $meta->{$var}; - } else { - my $meta = $obj->column($meta_col); - if (!ref $meta) { - $meta = __thaw_meta(\$meta); - $obj->{column_values}{$meta_col} = $meta; - } - # we should assume changes are going to be made, since - # we can't really monitor the hash once it has left us - $obj->{changed_cols}{$meta_col}++; - return $meta; - } + $obj->{__meta}->set($col, @_); + } + else { + $obj->{__meta}->get($col); + } + }; } @@ -466,5 +602,5 @@ my $ret = sprintf '%04d-%02d-%02d %02d:%02d:%02d', unpack 'A4A2A2A2A2A2', $_[0]; return $ret; -} +} sub db2ts { @@ -754,8 +890,15 @@ } +sub clone_all { + my $obj = shift; + my $clone = $obj->SUPER::clone_all(); + $clone->{__meta} = $obj->{__meta}; # TODO: clone this too + return $clone; +} + sub clone { my $obj = shift; my($param) = @_; - my $clone = $obj->SUPER::clone_all; + my $clone = $obj->clone_all(); ## If the caller has listed a set of columns not to copy to the clone, @@ -821,4 +964,12 @@ } +sub remove_meta { + my $obj = shift; + return 1 unless ref $obj; + my $mpkg = $obj->meta_pkg or return; + my $id_field = $obj->datasource . '_id'; + return $mpkg->remove({ $id_field => $obj->id }); +} + sub remove_children { my $obj = shift; @@ -834,5 +985,5 @@ my $obj_id = $obj->id; for my $class (@classes) { - eval "use $class;"; + eval "# line " . __LINE__ . " " . __FILE__ . "\nuse $class;"; $class->remove({ $key => $obj_id }); } @@ -943,5 +1094,6 @@ $def{key} = 1 if ($props->{primary_key}) && ($props->{primary_key} eq $col); $def{auto} = 1 if $def =~ m/\bauto[_ ]increment\b/i; - $def{default} = $props->{defaults}{$col} if exists $props->{defaults}{$col}; + $def{default} = $props->{defaults}{$col} + if exists $props->{defaults}{$col}; \%def; } @@ -1008,4 +1160,32 @@ $hash; } + +package MT::Object::Meta; + +use base qw( Data::ObjectDriver::BaseObject ); + +sub driver { $MT::Object::DRIVER ||= MT::ObjectDriverFactory->new } + +sub install_properties { + my $class = shift; + my ($props) = @_; + $props->{column_defs}->{$_} ||= 'string' + for @{ $props->{columns} }; + $class->SUPER::install_properties(@_); +} + +sub meta_pkg { undef } + +*table_name = \&MT::Object::table_name; +*column_defs = \&MT::Object::column_defs; +*column_def = \&MT::Object::column_def; +*index_defs = \&MT::Object::index_defs; +*__parse_defs = \&MT::Object::__parse_defs; +*__parse_def = \&MT::Object::__parse_def; +*count = \&MT::Object::count; +*columns_of_type = \&MT::Object::columns_of_type; + +# TODO: copy this too +sub blob_requires_zip {} 1; Index: branches/release-35/lib/MT/ObjectDriver/DDL/mysql.pm =================================================================== --- branches/release-35/lib/MT/ObjectDriver/DDL/mysql.pm (revision 1174) +++ branches/release-35/lib/MT/ObjectDriver/DDL/mysql.pm (revision 1927) @@ -22,4 +22,5 @@ my $field_prefix = $class->datasource; my $table_name = $class->table_name; + local $dbh->{RaiseError} = 0; my $sth = $dbh->prepare('SHOW INDEX FROM ' . $table_name) or return undef; Index: branches/release-35/lib/MT/Meta.pm =================================================================== --- branches/release-35/lib/MT/Meta.pm (revision 1927) +++ branches/release-35/lib/MT/Meta.pm (revision 1927) @@ -0,0 +1,428 @@ +# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd. +# This program is distributed under the terms of the +# GNU General Public License, version 2. +# +# $Id: Meta.pm 71460 2008-01-18 18:01:06Z ykerherve $ + +package MT::Meta; + +#--------------------------------------# +# Dependencies + +use strict; +use warnings; + +#--------------------------------------# +# Constants + +sub TYPE_VCHAR () { 1 } +sub TYPE_VCHAR_INDEXED () { 2 } +sub TYPE_VBLOB () { 3 } +sub TYPE_VINTEGER () { 4 } +sub TYPE_VINTEGER_INDEXED () { 5 } +sub TYPE_VDATETIME () { 6 } +sub TYPE_VDATETIME_INDEXED () { 7 } +sub TYPE_VFLOAT () { 8 } +sub TYPE_VFLOAT_INDEXED () { 9 } +sub TYPE_VCLOB () { 10 } + +sub DEBUG () { 0 } + +## Specify if the faster REPLACE INTO can be used instead of INSERT/UPDATE +our $REPLACE_ENABLED = 0; + +our (%Types, %TypesByName); +BEGIN { + %Types = ( + TYPE_VCHAR() => "vchar", + TYPE_VCHAR_INDEXED() => "vchar_indexed", + TYPE_VINTEGER() => "vinteger", + TYPE_VINTEGER_INDEXED() => "vinteger_indexed", + TYPE_VDATETIME() => "vdatetime", + TYPE_VDATETIME_INDEXED() => "vdatetime_indexed", + TYPE_VFLOAT() => "vfloat", + TYPE_VFLOAT_INDEXED() => "vfloat_indexed", + TYPE_VBLOB() => "vblob", + TYPE_VCLOB() => "vclob", + ); + + %TypesByName = reverse %Types; + + # some other aliases + $TypesByName{string} = TYPE_VCHAR; + $TypesByName{integer} = TYPE_VINTEGER; + $TypesByName{datetime} = TYPE_VDATETIME; + $TypesByName{float} = TYPE_VFLOAT; + $TypesByName{string_indexed} = TYPE_VCHAR_INDEXED; + $TypesByName{integer_indexed} = TYPE_VINTEGER_INDEXED; + $TypesByName{datetime_indexed} = TYPE_VDATETIME_INDEXED; + $TypesByName{float_indexed} = TYPE_VFLOAT_INDEXED; + $TypesByName{text} = TYPE_VCLOB; + $TypesByName{hash} = TYPE_VBLOB; + $TypesByName{array} = TYPE_VBLOB; +} + +## $Registry = { +## 'foo' => { # key +## 'MT::Foo' => { +## 'column' => { +## name => 'column', +## id => 123, +## type_id => 1, +## type => 'vchar_indexed', +## pkg => 'MT::Foo', +## zip => $cfg, ## optional +## }, +## } +## }, +## } + +## $RegistryById = { +## 'foo' => { # key +## 123 => { +## name => 'column', +## id => 123, +## type_id => 1, +## zip => $cfg, ## optional +## }, +## }, +## } +our($Registry, $RegistryById); + +#--------------------------------------# +# Public Class Methods + +sub install { + my $class = shift; + my ($pkg, $params) = @_; + + ## add base class defs, if they exist + my $base_args = $pkg->meta_args; + if ($base_args) { + while ( my ($k, $v) = each (%{ $base_args }) ) { + $params->{$k} = $v; + } + } + + ## add inherited metadata fields... + my $key = $params->{key}; + my $inherited = $class->_load_inheritance($pkg, $key); + + my $fields = delete $params->{fields}; # we'll reduce this big value + push @$fields, @$inherited; + + ## ... and add metadata fields to registry after + $class->register($pkg, $key, $fields); + + ## ... and save reduced fields in params (will be installed in properties) + ## while saving extra properties + for (@$fields) { + $params->{fields}{ $_->{name} } = 1; + $params->{blob_zip_cfg}{ $_->{name} } = $_->{zip} if $_->{zip}; + } + + ## build subclass + $class->_build_subclass($pkg, $params); + + return $params->{fields}; +} + +sub register { + my $class = shift; + my ($pkg, $key, $fields) = @_; + + foreach my $field ( @{ $fields } ) { + my $name = $field->{name}; + my $type = $field->{type}; + my $zip = $field->{zip}; + + ## check for potential deep recursion +# warn("$pkg has $name subroutine! Deep recursion imminent!") +# if $pkg->can($name); + + my $type_id = $TypesByName{$type} + or Carp::croak("Invalid metadata type '$type' for field $pkg $field->{name}"); + + ## load registry + print STDERR "$pkg is registering metadata $key\t$name\n" if DEBUG; + + ## clone it + my $value = { + name => $name, + type_id => $type_id, + type => $Types{$type_id}, + pkg => $pkg, + }; + $value->{zip} = $zip if defined $zip; + + $Registry->{$key}{$pkg}{$name} = $value; + } +} + +sub metadata_by_class { + my $class = shift; + my($pkg) = @_; + values %{ $Registry->{ $pkg->meta_args->{key} }{$pkg} }; +} + +sub metadata_by_name { + my $class = shift; + my($pkg, $name) = @_; + $Registry->{ $pkg->meta_args->{key} }{$pkg}{$name}; +} + +*metadata_by_id = \&metadata_by_name; + +sub has_own_metadata_of { + my $class = shift; + my($pkg) = @_; + my $key = $pkg->meta_args->{key}; # xxx is it really safe to call meta_args? + exists $Registry->{$key}{$pkg}; +} + +sub normalize_type { + my $pkg = shift; + my ($type) = @_; + return $Types{ $TypesByName{ $type } } || TYPE_VBLOB; +} + +#--------------------------------------# +# Private Class Methods + +sub _load_inheritance { + my $class = shift; + my ($pkg, $key) = @_; + + no strict 'refs'; ## no critic + my $base = ${"$pkg\::ISA"}[0]; + return [] if $base eq $pkg; + my @inherited; + if (exists $Registry->{$key}{$base}) { + for my $field ( values %{ $Registry->{$key}->{$base} } ) { + push @inherited, $field; + } + } + return \@inherited; +} + +sub _build_subclass { + my $class = shift; + my ($pkg, $meta) = @_; + + my $subclass = $pkg->meta_pkg; + return unless $subclass; + + return if defined ${"${subclass}::VERSION"}; + + ## Try to use this subclass first to see if it exists + my $subclass_file = $subclass . '.pm'; + $subclass_file =~ s{::}{/}g; + eval { + require $subclass_file; + $subclass->import(); + }; + if ($@) { + ## Die if we get an unexpected error + die $@ unless $@ =~ /^Can't locate /; + } else { + ## This class exists. We don't need to do anything. + return 1; + } + + my $base_class = 'MT::Object::Meta'; + + my $subclass_src = " + # line " . __LINE__ . " " . __FILE__ . " + package $subclass; + our \$VERSION = 1.0; + use base qw($base_class); + 1; + "; + + ## no critic ProhibitStringyEval + eval $subclass_src or print STDERR "Could not create package $subclass!\n"; + + $subclass->install_properties($meta); +} + +1; + +__END__ + +=head1 NAME + +MT::Meta - Get/Set metadata on a variety of objects + +=head1 SYNOPSIS + + package Foo; + use base qw( MT::Object ); + + __PACKAGE__->install_properties({ ... }); + + __PACKAGE__->install_meta({ + datasource => 'foo_meta', + fields => [ + { name => 'selfaware', type => 'vchar', key => 1 }, + ], + }); + + sub meta_args { + +{ key => 'foo' }; + } + + + package main; + + my $foo = Foo->new; + $foo->selfaware(1); + $foo->save if you dare; + + +=head1 DESCRIPTION + +The I class manages the configuration and of metadata for +Is. As metadata is fully integrated into I, +you should not need to access I directly. + + +=head1 USAGE + +These class methods allow you to retrieve information about the metadata +defined for specific classes and metadata fields. + +=head2 MT::Meta->install($class, $params) + +Defines the set of metadata for the class I<$class> as described in the hash +reference I<$params>, and configures I<$class> for use as a metadata host. + +Members of I<$params> can include: + +=over 4 + +=item * fields + +An array reference describing the metadata fields to define. Each member of the +array should be a hash reference containing: + +=over 4 + +=item * name + +The name of the metadata field. This corresponds to the object method you'd use +to get/set the metadata on a particular object in the package I<$class>. + +=item * id + +The numeric ID of the metadata field. This is used as the key for this metadata +field in the database. + +=item * type + +The data type of the metadata field. One of: C, C, or +C. + +=back + +The I member is required. + +=item * key + +A string to uniquely describe a hierarchy of classes that should share a set of +metadata fields. For example, for ArcheType::M::Asset I, +I is C. + +Note that, as this should be the same key as returned in the original class's +I method, you should probably not bother sending it here. + +=back + +The I<$params> hash may also contain arguments to be set as properties of the +metadata package (the class of I actually containing the meta +data). Useful properties to set include: + +=over 4 + +=item * datasource + +=item * primary_key + +=item * get_driver + +=back + +As I does not mark metadata as installed in the properties of +I<$class>, you should not use it directly, but prefer instead to use +I. (Its single argument is the same as +I<$params> here.) + +=head2 MT::Meta->register($class, $key, $fields) + +Defines the metadata fields I<$fields> for the class I<$class> under the key +I<$key>. The fields and key arguments are the same as those given to the +I method in I<$params>. + +As I does not configure I<$class> for use as a metadata host +(defining the meta data class, enabling automatic initialization of metadata on +loaded instances of I<$class>, etc), you should not use it directly, but prefer +instead to use I. + +=head2 MT::Meta->metadata_by_class($class) + +Returns a list of hash references describing all the metadata defined for the +class I<$class>. Each item in the array is a reference to a hash containing the +following keys: + +=over 4 + +=item * name + +The name of the metadata field. This corresponds to the object method you'd use +to get/set the metadata on a particular object in the package I<$class>. + +=item * id + +The numeric ID of the metadata field. This is used as the key for this metadata +field in the database. + +=item * type + +The data type of the metadata field. One of: C, C, or +C. + +=item * type_id + +The numeric ID corresponding to I. + +=item * pkg + +The name of the original I subclass to which this metadata +field belongs. + +=back + +=head2 MT::Meta->metadata_by_name($class, $name) + +Looks up a metadata field in the class I<$class> with the name I<$name>. If +I<$name> is a valid metadata field for I<$class>, returns a reference to a hash +containing the same keys as is returned above from I. +Otherwise, returns false. + +=head2 MT::Meta->metadata_by_id($class, $id) + +Looks up a metadata field in the class I<$class> with the numeric ID I<$id>. +If I<$id> identifies a valid metadata field for I<$class>, returns a reference +to a hash containing the same keys as is returned above from +I. Otherwise, returns false. + +=head2 MT::Meta->has_own_metadata_of($class) + +Returns true if the given class has any metadata fields defined. Otherwise, +returns false. + + +=head1 SEE ALSO + +L, L + +=cut Index: branches/release-35/lib/MT/Template.pm =================================================================== --- branches/release-35/lib/MT/Template.pm (revision 1877) +++ branches/release-35/lib/MT/Template.pm (revision 1927) @@ -35,4 +35,13 @@ 'build_type' => 'smallint', 'build_interval' => 'integer', + + # meta properties + 'last_rebuild_time' => 'integer meta', + 'page_layout' => 'string meta', + 'include_with_ssi' => 'integer meta', + 'use_cache' => 'integer meta', + 'cache_expire_type' => 'integer meta', + 'cache_expire_interval' => 'integer meta', + 'cache_expire_event' => 'string meta', }, indexes => { @@ -54,15 +63,4 @@ datasource => 'template', primary_key => 'id', -}); -__PACKAGE__->install_meta({ - columns => [ - 'last_rebuild_time', - 'page_layout', - 'include_with_ssi', - 'use_cache', - 'cache_expire_type', - 'cache_expire_interval', - 'cache_expire_event', - ], }); __PACKAGE__->add_trigger('pre_remove' => \&pre_remove_children); Index: branches/release-35/lib/MT/Component.pm =================================================================== --- branches/release-35/lib/MT/Component.pm (revision 1572) +++ branches/release-35/lib/MT/Component.pm (revision 1927) @@ -508,15 +508,21 @@ # check for a yaml file reference... - if ( !ref($v) && ( $v =~ m/^[-\w]+\.yaml$/ ) ) { - my $f = File::Spec->catfile( $c->path, $v ); - if ( -f $f ) { - require YAML::Tiny; - my $y = eval { YAML::Tiny->read($f) } - or die "Error reading $f: " . $YAML::Tiny::errstr; - - # skip over non-hash elements - shift @$y while @$y && ( ref( $y->[0] ) ne 'HASH' ); - if (@$y) { - $r->{$p} = $y->[0]; + if ( !ref($v) ) { + if ( $v =~ m/^[-\w]+\.yaml$/ ) { + my $f = File::Spec->catfile( $c->path, $v ); + if ( -f $f ) { + require YAML::Tiny; + my $y = eval { YAML::Tiny->read($f) } + or die "Error reading $f: " + . $YAML::Tiny::errstr; + # skip over non-hash elements + shift @$y + while @$y && ( ref( $y->[0] ) ne 'HASH' ); + $r->{$p} = $y->[0] if @$y; + } + } elsif ($v =~ m/^\$\w+::/) { + my $code = MT->handler_to_coderef($v); + if (ref $code eq 'CODE') { + $r->{$p} = $code->($c); } }