X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FObject.pm;h=c2aa3332106504704995bdd66e4019a1a785906e;hb=1ced2a25380c28174c07743b19820ec6d1d4f74f;hp=51e2f082bbea5117a6e9a9aa45b04512a46fd2ee;hpb=b178940934ec79968ed16511ec2644f3736c92f2;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Object.pm b/lib/SQL/Translator/Schema/Object.pm index 51e2f08..c2aa333 100644 --- a/lib/SQL/Translator/Schema/Object.pm +++ b/lib/SQL/Translator/Schema/Object.pm @@ -1,9 +1,7 @@ package SQL::Translator::Schema::Object; # ---------------------------------------------------------------------- -# $Id: Object.pm,v 1.3 2004-11-05 15:03:10 grommit Exp $ -# ---------------------------------------------------------------------- -# Copyright (C) 2002-4 SQLFairy Authors +# Copyright (C) 2002-2009 SQLFairy Authors # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -39,15 +37,16 @@ use strict; use Class::Base; use base 'Class::Data::Inheritable'; use base 'Class::Base'; +use Class::MakeMethods::Utility::Ref qw( ref_compare ); use vars qw[ $VERSION ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/; +$VERSION = '1.59'; =head1 Construction -Derived classes should decalare their attributes using the C<_attributes> +Derived classes should declare their attributes using the C<_attributes> method. They can then inherit the C method from here which will call accessors of the same name for any values given in the hash passed to C. Note that you will have to impliment the accessors your self and we expect perl @@ -121,21 +120,101 @@ have them. =head2 extra Get or set the objects "extra" attibutes (e.g., "ZEROFILL" for MySQL fields). -Accepts a hash(ref) of name/value pairs to store; returns a hash. +Call with no args to get all the extra data. +Call with a single name arg to get the value of the named extra attribute, +returned as a scalar. Call with a hash or hashref to set extra attributes. +Returns a hash or a hashref. $field->extra( qualifier => 'ZEROFILL' ); - my %extra = $field->extra; - + + $qualifier = $field->extra('qualifier'); + + %extra = $field->extra; + $extra = $field->extra; + =cut my $self = shift; - my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; + @_ = %{$_[0]} if ref $_[0] eq "HASH"; + my $extra = $self->{'extra'} ||= {}; + + if (@_==1) { + return exists($extra->{$_[0]}) ? $extra->{$_[0]} : undef ; + } + elsif (@_) { + my %args = @_; + while ( my ( $key, $value ) = each %args ) { + $extra->{$key} = $value; + } + } + + return wantarray ? %$extra : $extra; +} - while ( my ( $key, $value ) = each %$args ) { - $self->{'extra'}{ $key } = $value; +# ---------------------------------------------------------------------- +sub remove_extra { + +=head2 remove_extra + +L can only be used to get or set "extra" attributes but not to +remove some. Call with no args to remove all extra attributes that +have been set before. Call with a list of key names to remove +certain extra attributes only. + + # remove all extra attributes + $field->remove_extra(); + + # remove timezone and locale attributes only + $field->remove_extra(qw/timezone locale/); + +=cut + + my ( $self, @keys ) = @_; + unless (@keys) { + $self->{'extra'} = {}; + } + else { + delete $self->{'extra'}{$_} for @keys; } +} + +# ---------------------------------------------------------------------- +sub equals { + +=pod + +=head2 equals + +Determines if this object is the same as another. + + my $isIdentical = $object1->equals( $object2 ); - return %{ $self->{'extra'} || {} }; +=cut + + my $self = shift; + my $other = shift; + + return 0 unless $other; + return 1 if overload::StrVal($self) eq overload::StrVal($other); + return 0 unless $other->isa( __PACKAGE__ ); + return 1; +} + +# ---------------------------------------------------------------------- +sub _compare_objects { + my $self = shift; + my $obj1 = shift; + my $obj2 = shift; + my $result = (ref_compare($obj1, $obj2) == 0); +# if ( !$result ) { +# use Carp qw(cluck); +# cluck("How did I get here?"); +# use Data::Dumper; +# $Data::Dumper::Maxdepth = 1; +# print "obj1: ", Dumper($obj1), "\n"; +# print "obj2: ", Dumper($obj2), "\n"; +# } + return $result; } #============================================================================= @@ -152,6 +231,7 @@ Accepts a hash(ref) of name/value pairs to store; returns a hash. =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE, Mark Addison Emark.addison@itn.co.ukE +Ken Youens-Clark Ekclark@cpan.orgE, +Mark Addison Emark.addison@itn.co.ukE. =cut