File Coverage

636							C returns a hash of C pairs for all the
637							columns in this model. See C
638							for the format of that hash.
639
640
641							=cut
642
643							sub serialize_metadata {
644	0			0	1	0	my $self = shift;
645							return {
646	0		0			0	class => ( ref($self) \|\| $self ),
647							table => $self->table,
648							columns => { $self->_serialize_columns },
649							};
650							}
651
652							sub _serialize_columns {
653	0			0		0	my $self = shift;
654	0					0	my %serialized_columns;
655	0					0	foreach my $column ( $self->columns ) {
656	0					0	$serialized_columns{ $column->name } = $column->serialize_metadata();
657							}
658
659	0					0	return %serialized_columns;
660							}
661
662							=head2 writable_attributes
663
664							Returns a list of this table's writable columns
665
666
667							=cut
668
669							sub writable_attributes {
670	1			1	1	865	my $self = shift;
671							return @{
672	1					3	$self->_WRITABLE_COLS_CACHE() \|\| $self->_WRITABLE_COLS_CACHE(
	4					19
673	1	50				4	[ sort map { $_->name } grep { $_->writable } $self->columns ]
	5					33
674							)
675							};
676							}
677
678							=head2 record values
679
680							As you've probably already noticed, C automatically
681							creates methods for your standard get/set accessors. It also provides you
682							with some hooks to massage the values being loaded or stored.
683
684							When you fetch a record value by calling
685							C<$my_record-Esome_field>, C provides the
686							following hook
687
688							=over
689
690
691
692							=item after_I
693
694							This hook is called with a reference to the value returned by
695							Jifty::DBI. Its return value is discarded.
696
697							=back
698
699							When you set a value, C provides the following hooks
700
701							=over
702
703							=item before_set_I PARAMHASH
704
705							C passes this function a reference to a paramhash
706							composed of:
707
708							=over
709
710							=item column
711
712							The name of the column we're updating.
713
714							=item value
715
716							The new value for I.
717
718							=item is_sql_function
719
720							A boolean that, if true, indicates that I is an SQL function,
721							not just a value.
722
723							=back
724
725							If before_set_I returns false, the new value isn't set.
726
727							=item before_set PARAMHASH
728
729							This is identical to the C>, but is called
730							for every column set.
731
732							=item after_set_I PARAMHASH
733
734							This hook will be called after a value is successfully set in the
735							database. It will be called with a reference to a paramhash that
736							contains C, C, and C keys. If C was a
737							SQL function, it will now contain the actual value that was set. If
738							C has filters on it, C will be the result of going
739							through an encode and decode cycle.
740
741							This hook's return value is ignored.
742
743							=item after_set PARAMHASH
744
745							This is identical to the C>, but is called
746							for every column set.
747
748							=item validate_I VALUE
749
750							This hook is called just before updating the database. It expects the
751							actual new value you're trying to set I to. It returns
752							two values. The first is a boolean with truth indicating success. The
753							second is an optional message. Note that validate_I may
754							be called outside the context of a I operation to validate a
755							potential value. (The Jifty application framework uses this as part of
756							its AJAX validation system.)
757
758							=back
759
760
761							=cut
762
763							=head2 _value
764
765							_value takes a single column name and returns that column's value for
766							this row. Subclasses can override _value to insert custom access
767							control.
768
769							=cut
770
771							sub _value {
772	339			339		1279	my $self = shift;
773	339					632	my $column = shift;
774
775	339					1481	my $value = $self->__value( $column => @_ );
776	339					9108	$self->_run_callback(
777							name => "after_" . $column,
778							args => \$value
779							);
780	339					2002	return $value;
781							}
782
783							=head2 __raw_value
784
785							Takes a column name and returns that column's raw value.
786							Subclasses should never override __raw_value.
787
788							=cut
789
790							sub __raw_value {
791	10			10		817	my $self = shift;
792
793	10					24	my $column_name = shift;
794
795							# In the default case of "yeah, we have a value", return it as
796							# fast as we can.
797	10	100				72	return $self->{'raw_values'}{$column_name}
798							if $self->{'fetched'}{$column_name};
799
800	4	100	66			36	if ( !$self->{'fetched'}{$column_name} and my $id = $self->id() ) {
801	3					9	my $pkey = $self->_primary_key();
802	3					16	my $query_string =
803							"SELECT "
804							. $column_name
805							. " FROM "
806							. $self->table
807							. " WHERE $pkey = ?";
808	3					29	my $sth = $self->_handle->simple_query( $query_string, $id );
809	3					6	my ($value) = eval { $sth->fetchrow_array() };
	3					51
810	3					11	$self->{'raw_values'}{$column_name} = $value;
811	3					677	$self->{'fetched'}{$column_name} = 1;
812							}
813
814	4					21	return $self->{'raw_values'}{$column_name};
815							}
816
817							=head2 resolve_column
818
819							given a column name, resolve it, even if it's actually an alias
820							return the column object.
821
822							=cut
823
824							sub resolve_column {
825	0			0	1	0	my $self = shift;
826	0					0	my $column_name = shift;
827	0	0				0	return unless $column_name;
828	0					0	return $self->COLUMNS->{$column_name};
829							}
830
831							=head2 __value
832
833							Takes a column name and returns that column's value. Subclasses should
834							never override __value.
835
836							=cut
837
838							sub __value {
839	376			376		733	my $self = shift;
840
841	376					1984	my $column = $self->COLUMNS->{ +shift }; # Shortcut around ->resolve_column
842	376	100				4566	return unless $column;
843
844	374					1060	my $column_name = $column->{name}; # Speed optimization
845
846	374	50				2092	if ($column->computed) {
847	0					0	return $self->$column_name;
848							}
849
850							# In the default case of "yeah, we have a value", return it as
851							# fast as we can.
852	374	100	100			5937	return $self->{'values'}{$column_name}
853							if ( $self->{'fetched'}{$column_name}
854							&& $self->{'decoded'}{$column_name} );
855
856	215	100				1034	unless ($self->{'fetched'}{$column_name}) {
857							# Fetch it, and mark it as not decoded
858	4					40	$self->{'values'}{$column_name} = $self->__raw_value( $column_name );
859	4					15	$self->{'decoded'}{$column_name} = 0;
860							}
861
862	215	50				1306	unless ( $self->{'decoded'}{$column_name} ) {
863	215	50				2126	$self->_apply_output_filters(
864							column => $column,
865							value_ref => \$self->{'values'}{$column_name},
866							) if exists $self->{'values'}{$column_name};
867	215					1318	$self->{'decoded'}{$column_name} = 1;
868							}
869
870	215					805	return $self->{'values'}{$column_name};
871							}
872
873							=head2 as_hash
874
875							Returns a version of this record's readable columns rendered as a hash
876							of key => value pairs
877
878							=cut
879
880							sub as_hash {
881	1			1	1	4	my $self = shift;
882	1					2	my %values;
883	1					68	$values{$_} = $self->$_() for $self->readable_attributes;
884	1					9	return %values;
885							}
886
887							=head2 _set
888
889							_set takes a single column name and a single unquoted value. It
890							updates both the in-memory value of this column and the in-database
891							copy. Subclasses can override _set to insert custom access control.
892
893							=cut
894
895							sub _set {
896	61			61		1239	my $self = shift;
897	61					546	my %args = (
898							'column' => undef,
899							'value' => undef,
900							'is_sql_function' => undef,
901							@_
902							);
903
904							# Call the general before_set triggers
905	61					267	my $ok = $self->_run_callback(
906							name => "before_set",
907							args => \%args,
908							);
909	61	50				256	return $ok if ( not defined $ok );
910
911							# Call the specific before_set_column triggers
912	61					632	$ok = $self->_run_callback(
913							name => "before_set_" . $args{column},
914							args => \%args,
915							);
916	61	50				251	return $ok if ( not defined $ok );
917
918							# Fetch the old value for the benefit of the triggers
919	61					346	my $old_value = $self->_value( $args{column} );
920
921	61					391	$ok = $self->__set(%args);
922	61	100				4548	return $ok if not $ok;
923
924							# Fetch the value back to make sure we have the actual value
925	58					1319	my $value = $self->_value( $args{column} );
926
927							# Call the general after_set triggers
928	58					701	$self->_run_callback(
929							name => "after_set",
930							args => { column => $args{column}, value => $value, old_value => $old_value },
931							);
932
933							# Call the specific after_set_column triggers
934	58					870	$self->_run_callback(
935							name => "after_set_" . $args{column},
936							args => { column => $args{column}, value => $value, old_value => $old_value },
937							);
938
939	58					1213	return $ok;
940							}
941
942							sub __set {
943	61			61		124	my $self = shift;
944
945	61					749	my %args = (
946							'column' => undef,
947							'value' => undef,
948							'is_sql_function' => undef,
949							@_
950							);
951
952	61					911	my $ret = Class::ReturnValue->new();
953
954	61					595	my $column = $self->column( $args{'column'} );
955	61	100				305	unless ($column) {
956	1					8	$ret->as_array( 0, 'No column specified' );
957	1					21	$ret->as_error(
958							errno => 5,
959							do_backtrace => 0,
960							message => "No column specified"
961							);
962	1					24	return ( $ret->return_value );
963							}
964
965	60					273	my $unmunged_value;
966	60	50				258	unless ($args{is_sql_function}) {
967	60					372	$self->_apply_input_filters(
968							column => $column,
969							value_ref => \$args{'value'}
970							);
971
972							# if value is not fetched or it's already decoded
973							# then we don't check eqality
974							# we also don't call __value because it decodes value, but
975							# we need encoded value
976	60	50	33			1489	if ( $self->{'fetched'}{ $column->name }
977							\|\| !$self->{'decoded'}{ $column->name } )
978							{
979	60	100	100			1175	if (( !defined $args{'value'}
			100
			100
			66
980							&& !defined $self->{'values'}{ $column->name }
981							)
982							\|\| ( defined $args{'value'}
983							&& defined $self->{'values'}{ $column->name }
984
985							# XXX: This is a bloody hack to stringify DateTime
986							# and other objects for compares
987							&& $args{value}
988							. "" eq ""
989							. $self->{'values'}{ $column->name }
990							)
991							)
992							{
993	2					37	$ret->as_array( 1, "That is already the current value" );
994	2					110	return ( $ret->return_value );
995							}
996							}
997
998	58	100				1087	if ( my $sub = $column->validator ) {
999	4					39	my ( $ok, $msg ) = $sub->( $self, $args{'value'} );
1000	4	100				44	unless ($ok) {
1001	1					6	$ret->as_array( 0, 'Illegal value for ' . $column->name );
1002	1					19	$ret->as_error(
1003							errno => 3,
1004							do_backtrace => 0,
1005							message => "Illegal value for " . $column->name
1006							);
1007	1					30	return ( $ret->return_value );
1008							}
1009							}
1010
1011							# Implement 'is distinct' checking
1012	57	100				645	if ( $column->distinct ) {
1013	1					7	my $ret = $self->is_distinct( $column->name, $args{'value'} );
1014	1	50				26	return ($ret) if not($ret);
1015							}
1016
1017							# The blob handling will destroy $args{'value'}. But we assign
1018							# that back to the object at the end. this works around that
1019	56					389	$unmunged_value = $args{'value'};
1020
1021	56	100				214	if ( $column->type =~ /^(text\|longtext\|clob\|blob\|lob\|bytea)$/i ) {
1022	5					75	my $bhash
1023							= $self->_handle->blob_params( $column->name, $column->type );
1024	5					20	$bhash->{'value'} = $args{'value'};
1025	5					25	$args{'value'} = $bhash;
1026							}
1027							}
1028
1029	56					658	my $val = $self->_handle->update_record_value(
1030							%args,
1031							table => $self->table(),
1032							primary_keys => { $self->primary_keys() }
1033							);
1034
1035	56	50				6510	unless ($val) {
1036	0					0	my $message
1037							= $column->name . " could not be set to " . $args{'value'} . ".";
1038	0					0	$ret->as_array( 0, $message );
1039	0					0	$ret->as_error(
1040							errno => 4,
1041							do_backtrace => 0,
1042							message => $message
1043							);
1044	0					0	return ( $ret->return_value );
1045							}
1046
1047							# If we've performed some sort of "functional update"
1048							# then we need to reload the object from the DB to know what's
1049							# really going on. (ex SET Cost = Cost+5)
1050	56	50				368	if ( $args{'is_sql_function'} ) {
1051
1052							# XXX TODO primary_keys
1053	0					0	$self->load_by_cols( id => $self->id );
1054							} else {
1055	56					816	$self->{'raw_values'}{ $column->name } = $unmunged_value;
1056	56					2112	$self->{'values'}{ $column->name } = $unmunged_value;
1057	56					625	$self->{'decoded'}{ $column->name } = 0;
1058							}
1059	56					1063	$ret->as_array( 1, "The new value has been set." );
1060	56					2509	return ( $ret->return_value );
1061							}
1062
1063							=head2 load
1064
1065							C can be called as a class or object method.
1066
1067							Takes a single argument, $id. Calls load_by_cols to retrieve the row
1068							whose primary key is $id.
1069
1070							=cut
1071
1072							sub load {
1073	68			68	1	71141	my $self = shift;
1074	68	100	66			1044	return unless @_ and defined $_[0];
1075	67	50				1350	Carp::carp("load called with more than one argument. Did you mean load_by_cols?") if @_ > 1;
1076
1077	67					575	return $self->load_by_cols( id => shift );
1078							}
1079
1080							=head2 load_by_cols
1081
1082							C can be called as a class or object method.
1083
1084							Takes a hash of columns and values. Loads the first record that
1085							matches all keys.
1086
1087							The hash's keys are the columns to look at.
1088
1089							The hash's values are either: scalar values to look for OR hash
1090							references which contain 'operator', 'value', 'case_sensitive'
1091							or 'function'
1092
1093							To load something case sensitively on a case insensitive database,
1094							you can do:
1095
1096							$record->load_by_cols( column => { operator => '=',
1097							value => 'Foo',
1098							case_sensitive => 1 } );
1099
1100							=cut
1101
1102							sub load_by_cols {
1103	122			122	1	1855	my $class = shift;
1104	122					445	my %hash = (@_);
1105	122					199	my ($self);
1106	122	100				426	if ( ref($class) ) {
1107	120					598	( $self, $class ) = ( $class, undef );
1108							} else {
1109	2		100			19	$self = $class->new( handle => ( delete $hash{'_handle'} \|\| undef ) );
1110							}
1111
1112	122					216	my ( @bind, @phrases );
1113	122					491	foreach my $key ( keys %hash ) {
1114	124	100	100			1063	if ( defined $hash{$key} && $hash{$key} ne '' ) {
		100
1115	120					329	my $op;
1116							my $value;
1117	120					645	my $function = "?";
1118	120					608	my $column_obj = $self->column($key);
1119	120	50				423	Carp::confess(
1120							"Unknown column '$key' in class '" . ref($self) . "'" )
1121							if !defined $column_obj;
1122	120					727	my $case_sensitive = $column_obj->case_sensitive;
1123	120	100				1674	if ( ref $hash{$key} eq 'HASH' ) {
1124	3					8	$op = $hash{$key}->{operator};
1125	3					9	$value = $hash{$key}->{value};
1126	3		50			21	$function = $hash{$key}->{function} \|\| "?";
1127	3	100				18	$case_sensitive = $hash{$key}->{case_sensitive}
1128							if exists $hash{$key}->{case_sensitive};
1129							} else {
1130	117					235	$op = '=';
1131	117					271	$value = $hash{$key};
1132							}
1133
1134	120	100	66			2321	if ( blessed $value && $value->isa('Jifty::DBI::Record') ) {
1135	1	50				4	my $by = defined $column_obj->by ? $column_obj->by : 'id';
1136	1					16	$value = $value->$by;
1137							}
1138
1139							$self->_apply_input_filters(
1140	120	100				596	column => $column_obj,
1141							value_ref => \$value,
1142							) if $column_obj->encode_on_select;
1143
1144							# if the handle is in a case_sensitive world and we need to make
1145							# a case-insensitive query
1146	120	100	66			1212	if ( $self->_handle->case_sensitive && $value ) {
1147	112	100	100			996	if ( $column_obj->is_string && !$case_sensitive ) {
1148	21					69	( $key, $op, $function )
1149							= $self->_handle->_make_clause_case_insensitive( $key,
1150							$op, $function );
1151							}
1152							}
1153
1154	120	50	33			1312	if ($column_obj and $column_obj->no_placeholder and $function eq "?") {
			33
1155	0					0	push @phrases, "$key $op ".$self->_handle->quote_value($value);
1156							} else {
1157	120					2130	push @phrases, "$key $op $function";
1158	120					512	push @bind, $value;
1159							}
1160
1161							} elsif ( !defined $hash{$key} ) {
1162	2					73	push @phrases, "$key IS NULL";
1163							} else {
1164	2					10	push @phrases, "($key IS NULL OR $key = ?)";
1165	2					12	my $column = $self->column($key);
1166
1167	2	100				18	if ( $column->is_numeric ) {
1168	1					3	push @bind, 0;
1169							} else {
1170	1					33	push @bind, '';
1171							}
1172
1173							}
1174							}
1175
1176	122					570	my $query_string
1177							= "SELECT * FROM "
1178							. $self->table
1179							. " WHERE "
1180							. join( ' AND ', @phrases );
1181	122	100				1618	if ($class) {
1182	2					8	$self->_load_from_sql( $query_string, @bind );
1183	2					10	return $self;
1184							} else {
1185	120					997	return $self->_load_from_sql( $query_string, @bind );
1186							}
1187
1188							}
1189
1190							=head2 load_by_primary_keys
1191
1192							Loads records with a given set of primary keys.
1193
1194							=cut
1195
1196							sub load_by_primary_keys {
1197	3			3	1	34	my $self = shift;
1198	3	100				13	my $data = ( ref $_[0] eq 'HASH' ) ? $_[0] : {@_};
1199
1200	3					5	my %cols = ();
1201	3					5	foreach ( @{ $self->_primary_keys } ) {
	3					8
1202	3	100				14	return ( 0, "Missing PK column: '$_'" ) unless defined $data->{$_};
1203	2					7	$cols{$_} = $data->{$_};
1204							}
1205	2					7	return ( $self->load_by_cols(%cols) );
1206							}
1207
1208							=head2 load_from_hash
1209
1210							Takes a hashref, such as created by Jifty::DBI and populates this
1211							record's loaded values hash.
1212
1213							=cut
1214
1215							sub load_from_hash {
1216	158			158	1	212	my $self = shift;
1217	158					186	my $hashref = shift;
1218	158					387	my %args = @_;
1219	158	50				413	if ($args{fast}) {
1220							# Optimization for loading from database
1221	158					280	$self->{values} = $hashref;
1222	158					194	$self->{fetched}{$_} = 1 for keys %{$hashref};
	158					1353
1223							# copy $hashref so changing 'values' doesn't change 'raw_values'
1224	158					292	$self->{raw_values}{$_} = $hashref->{$_} for keys %{$hashref};
	158					2663
1225	158					405	$self->{decoded} = {};
1226	158					607	return $self->{values}{id};
1227							}
1228
1229	0	0				0	unless ( ref $self ) {
1230	0					0	$self = $self->new( handle => delete $hashref->{'_handle'} );
1231							}
1232
1233	0					0	$self->{'values'} = {};
1234	0					0	$self->{'raw_values'} = {};
1235	0					0	$self->{'fetched'} = {};
1236
1237	0					0	foreach my $col ( grep exists $hashref->{ lc $_ }, map $_->name, $self->columns ) {
1238	0					0	$self->{'fetched'}{$col} = 1;
1239	0					0	$self->{'values'}{$col} = $hashref->{ lc $col };
1240	0					0	$self->{'raw_values'}{$col} = $hashref->{ lc $col };
1241							}
1242
1243	0					0	$self->{'decoded'} = {};
1244	0					0	return $self->id();
1245							}
1246
1247							=head2 _load_from_sql QUERYSTRING @BIND_VALUES
1248
1249							Load a record as the result of an SQL statement
1250
1251							=cut
1252
1253							sub _load_from_sql {
1254	126			126		709	my $self = shift;
1255	126					253	my $query_string = shift;
1256	126					331	my @bind_values = (@_);
1257
1258	126					370	my $sth = $self->_handle->simple_query( $query_string, @bind_values );
1259
1260							#TODO this only gets the first row. we should check if there are more.
1261
1262	126	100				476	return ( 0, "Couldn't execute query" ) unless $sth;
1263
1264	125					7225	my $hashref = $sth->fetchrow_hashref;
1265	125					628	delete $self->{'values'};
1266	125					360	delete $self->{'raw_values'};
1267	125					478	$self->{'fetched'} = {};
1268	125					353	$self->{'decoded'} = {};
1269
1270							#foreach my $f ( keys %$hashref ) { $self->{'fetched'}{ $f } = 1; }
1271	125					1032	foreach my $col ( map { $_->name } $self->columns ) {
	521					4418
1272	521	100				2476	next unless exists $hashref->{ lc($col) };
1273	473					2238	$self->{'fetched'}{$col} = 1;
1274	473					1217	$self->{'values'}->{$col} = $hashref->{ lc($col) };
1275	473					1818	$self->{'raw_values'}->{$col} = $hashref->{ lc($col) };
1276							}
1277	125	50	66			2074	if ( !$self->{'values'} && $sth->err ) {
1278	0					0	return ( 0, "Couldn't fetch row: " . $sth->err );
1279							}
1280
1281	125	100				402	unless ( $self->{'values'} ) {
1282	6					141	return ( 0, "Couldn't find row" );
1283							}
1284
1285							## I guess to be consistant with the old code, make sure the primary
1286							## keys exist.
1287
1288	119	100				895	if ( grep { not defined } $self->primary_keys ) {
	238					796
1289	1					17	return ( 0, "Missing a primary key?" );
1290							}
1291
1292	118					3062	return ( 1, "Found object" );
1293
1294							}
1295
1296							=head2 create PARAMHASH
1297
1298							C can be called as either a class or object method
1299
1300							This method creates a new record with the values specified in the PARAMHASH.
1301
1302							This method calls two hooks in your subclass:
1303
1304							=over
1305
1306							=item before_create
1307
1308							When adding the C trigger, you can determine whether
1309							the trigger may cause an abort or not by passing the C
1310							parameter to the C method. If this is not set, then the
1311							return value is ignored regardless.
1312
1313							sub before_create {
1314							my $self = shift;
1315							my $args = shift;
1316
1317							# Do any checks and changes on $args here.
1318							$args->{first_name} = ucfirst $args->{first_name};
1319
1320							return; # false return vallue will abort the create
1321							return 1; # true return value will allow create to continue
1322							}
1323
1324							This method is called before trying to create our row in the
1325							database. It's handed a reference to your paramhash. (That means it
1326							can modify your parameters on the fly). C returns a
1327							true or false value. If it returns C and the trigger has been
1328							added as C, the create is aborted.
1329
1330							=item after_create
1331
1332							When adding the C trigger, you can determine whether the
1333							trigger may cause an abort or not by passing the C
1334							parameter to the C method. If this is not set, then the
1335							return value is ignored regardless.
1336
1337							sub after_create {
1338							my $self = shift;
1339							my $insert_return_value_ref = shift;
1340
1341							return unless $$insert_return_value_ref; # bail if insert failed
1342							$self->load($$insert_return_value_ref); # load ourselves from db
1343
1344							# Do whatever needs to be done here
1345
1346							return; # aborts the create, possibly preventing a load
1347							return 1; # continue normally
1348							}
1349
1350							This method is called after attempting to insert the record into the
1351							database. It gets handed a reference to the return value of the
1352							insert. That will either be a true value or a L.
1353
1354							Aborting the trigger merely causes C to return a false
1355							(undefined) value even thought he create may have succeeded. This
1356							prevents the loading of the record that would normally be returned.
1357
1358							=back
1359
1360
1361							=cut
1362
1363							sub create {
1364	106			106	1	61529	my $class = shift;
1365	106					455	my %attribs = @_;
1366
1367	106					195	my ($self);
1368	106	100				526	if ( ref($class) ) {
1369	105					324	( $self, $class ) = ( $class, undef );
1370							} else {
1371	1		50			8	$self = $class->new(
1372							handle => ( delete $attribs{'_handle'} \|\| undef ) );
1373							}
1374
1375	106					665	my $ok
1376							= $self->_run_callback( name => "before_create", args => \%attribs );
1377	106	50				430	return $ok if ( not defined $ok );
1378
1379	106					757	my $ret = $self->__create(%attribs);
1380
1381	106					1607	$ok = $self->_run_callback(
1382							name => "after_create",
1383							args => \$ret
1384							);
1385	106	50				868	return $ok if ( not defined $ok );
1386
1387	106	100				415	if ($class) {
1388	1					13	$self->load_by_cols( id => $ret );
1389	1					7	return ($self);
1390							} else {
1391	105					1106	return ($ret);
1392							}
1393							}
1394
1395							sub __create {
1396	106			106		377	my ( $self, %attribs ) = @_;
1397
1398	106					442	foreach my $column_name ( keys %attribs ) {
1399	172					2098	my $column = $self->column($column_name);
1400	172	50				909	unless ($column) {
1401
1402							# "Virtual" columns beginning with __ are passed through
1403							# to handle without munging.
1404	0	0				0	next if $column_name =~ /^__/;
1405
1406	0					0	Carp::confess "$column_name isn't a column we know about";
1407							}
1408	172	100	66			1278	if ( $column->readable
			66
			100
1409							and $column->refers_to
1410							and UNIVERSAL::isa( $column->refers_to, "Jifty::DBI::Record" )
1411							and UNIVERSAL::isa( $attribs{$column_name}, 'Jifty::DBI::Record' ) )
1412							{
1413							# lookup the column referenced or default to id
1414	4	50				145	my $by = defined $column->by ? $column->by : 'id';
1415	4					60	$attribs{$column_name} = $attribs{$column_name}->$by;
1416							}
1417
1418							$self->_apply_input_filters(
1419	172					5785	column => $column,
1420							value_ref => \$attribs{$column_name},
1421							);
1422
1423							# Implement 'is distinct' checking
1424	172	100				1365	if ( $column->distinct ) {
1425	4					45	my $ret
1426							= $self->is_distinct( $column_name, $attribs{$column_name} );
1427	4	100				35	if ( not $ret ) {
1428	1					41	Carp::cluck(
1429							"$self failed a 'is_distinct' check for $column_name on "
1430							. $attribs{$column_name} );
1431	1					1043	return ($ret);
1432							}
1433							}
1434
1435	171	100				1709	if ( $column->type =~ /^(text\|longtext\|clob\|blob\|lob\|bytea)$/i ) {
1436	8					136	my $bhash
1437							= $self->_handle->blob_params( $column_name, $column->type );
1438	8					228	$bhash->{'value'} = $attribs{$column_name};
1439	8					35	$attribs{$column_name} = $bhash;
1440							}
1441							}
1442
1443	105					2070	for my $column ( $self->columns ) {
1444	399	100	100			7221	if ( not defined $attribs{ $column->name }
			66
1445							and defined $column->default
1446							and not ref $column->default )
1447							{
1448	75					1956	my $default = force $column->default;
1449	75	50				1425	$default = $default->id
1450							if UNIVERSAL::isa( $default, 'Jifty::DBI::Record' );
1451
1452	75					224	$attribs{ $column->name } = $default;
1453
1454	75					671	$self->_apply_input_filters(
1455							column => $column,
1456							value_ref => \$attribs{ $column->name },
1457							);
1458							}
1459
1460	399	100	100			4443	if ( not defined $attribs{ $column->name }
			100
1461							and $column->mandatory
1462							and $column->type ne "serial" )
1463							{
1464							# Enforce "mandatory"
1465	1					43	Carp::carp "Did not supply value for mandatory column "
1466							. $column->name;
1467	1	50				1055	unless ( $column->active ) {
1468	0					0	Carp::carp "The mandatory column "
1469							. $column->name
1470							. " is no longer active. This is likely to cause problems!";
1471							}
1472
1473	1					23	return (0);
1474							}
1475							}
1476
1477	104					1103	return $self->_handle->insert( $self->table, %attribs );
1478							}
1479
1480							=head2 delete
1481
1482							Delete this record from the database. On failure return a
1483							Class::ReturnValue with the error. On success, return 1;
1484
1485							This method has two hooks:
1486
1487							=over
1488
1489							=item before_delete
1490
1491							This method is called before the record deletion, if it exists. On
1492							failure it returns a L with the error. On success
1493							it returns 1.
1494
1495							If this method returns an error, it causes the delete to abort and
1496							return the return value from this hook.
1497
1498							=item after_delete
1499
1500							This method is called after deletion, with a reference to the return
1501							value from the delete operation.
1502
1503							=back
1504
1505							=cut
1506
1507							sub delete {
1508	3			3	1	13	my $self = shift;
1509	3					14	my $before_ret = $self->_run_callback( name => 'before_delete' );
1510	3	50				13	return $before_ret unless ( defined $before_ret );
1511	3					20	my $ret = $self->__delete;
1512
1513	3					24	my $after_ret
1514							= $self->_run_callback( name => 'after_delete', args => \$ret );
1515	3	50				16	return $after_ret unless ( defined $after_ret );
1516	3					17	return ($ret);
1517
1518							}
1519
1520							sub __delete {
1521	3			3		10	my $self = shift;
1522
1523							#TODO Check to make sure the key's not already listed.
1524							#TODO Update internal data structure
1525
1526							## Constructs the where clause.
1527	3					12	my %pkeys = $self->primary_keys();
1528	3					13	my $return = $self->_handle->delete( $self->table, $self->primary_keys );
1529
1530	3	50				240	if ( UNIVERSAL::isa( 'Class::ReturnValue', $return ) ) {
1531	0					0	return ($return);
1532							} else {
1533	3					100	return (1);
1534							}
1535							}
1536
1537							=head2 table
1538
1539							This method returns this class's default table name. It uses
1540							Lingua::EN::Inflect to pluralize the class's name as we believe that
1541							class names for records should be in the singular and table names
1542							should be plural.
1543
1544							If your class name is C, your table name will default
1545							to C. If your class name is C, your
1546							default table name will be C. Not perfect, but
1547							arguably correct.
1548
1549							=cut
1550
1551							sub table {
1552	683			683	1	1607	my $self = shift;
1553	683	100				2674	$self->TABLE_NAME( $self->_guess_table_name )
1554							unless ( $self->TABLE_NAME() );
1555	683					10099	return $self->TABLE_NAME();
1556							}
1557
1558							=head2 collection_class
1559
1560							Returns the collection class which this record belongs to; override
1561							this to subclass. If you haven't specified a collection class, this
1562							returns a best guess at the name of the collection class for this
1563							collection.
1564
1565							It uses a simple heuristic to determine the collection class name --
1566							It appends "Collection" to its own name. If you want to name your
1567							records and collections differently, go right ahead, but don't say we
1568							didn't warn you.
1569
1570							=cut
1571
1572							sub collection_class {
1573	0			0	1	0	my $self = shift;
1574	0		0			0	my $class = ref($self) \|\| $self;
1575	0					0	$class . 'Collection';
1576							}
1577
1578							=head2 _guess_table_name
1579
1580							Guesses a table name based on the class's last part.
1581
1582
1583							=cut
1584
1585							sub _guess_table_name {
1586	38			38		653	my $self = shift;
1587	38	100				196	my $class = ref($self) ? ref($self) : $self;
1588	38	50				710	die "Couldn't turn " . $class . " into a table name"
1589							unless ( $class =~ /(?:\:\:)?(\w+)$/ );
1590	38					588	my $table = $1;
1591	38					475	$table =~ s/(?<=[a-z])([A-Z]+)/"_" . lc($1)/eg;
	5					51
1592	38					146	$table =~ tr/A-Z/a-z/;
1593	38					278	$table = Lingua::EN::Inflect::PL_N($table);
1594	38					213481	return ($table);
1595
1596							}
1597
1598							=head2 _handle
1599
1600							Returns or sets the current Jifty::DBI::Handle object
1601
1602							=cut
1603
1604							sub _handle {
1605	2240			2240		5216	my $self = shift;
1606	2240	100				5839	if (@_) {
1607	365					947	$self->{'DBIxHandle'} = shift;
1608							}
1609	2240					21663	return ( $self->{'DBIxHandle'} );
1610							}
1611
1612							=head2 PRIVATE refers_to
1613
1614							used for the declarative syntax
1615
1616							=cut
1617
1618							sub _filters {
1619	552			552		1219	my $self = shift;
1620	552					2199	my %args = ( direction => 'input', column => undef, @_ );
1621
1622	552	100				2108	if ( $args{'direction'} eq 'input' ) {
1623	337					1205	return grep $_, map $_->input_filters,
1624							( $self, $args{'column'}, $self->_handle );
1625							} else {
1626	215					934	return grep $_, map $_->output_filters,
1627							( $self->_handle, $args{'column'}, $self );
1628							}
1629							}
1630
1631							sub _apply_input_filters {
1632	337			337		1672	return (shift)->_apply_filters( direction => 'input', @_ );
1633							}
1634
1635							sub _apply_output_filters {
1636	215			215		1056	return (shift)->_apply_filters( direction => 'output', @_ );
1637							}
1638
1639							{ my %cache = ();
1640							sub _apply_filters {
1641	552			552		1038	my $self = shift;
1642	552					3731	my %args = (
1643							direction => 'input',
1644							column => undef,
1645							value_ref => undef,
1646							@_
1647							);
1648
1649	552					2649	my @filters = $self->_filters(%args);
1650	552	100				2411	my $action = $args{'direction'} eq 'output' ? 'decode' : 'encode';
1651	552					1307	foreach my $filter_class (@filters) {
1652	817	100				5268	unless ( exists $cache{ $filter_class } ) {
		50
1653	45					105	local $UNIVERSAL::require::ERROR;
1654	45					466	$filter_class->require;
1655	45	50				744	if ($UNIVERSAL::require::ERROR) {
1656	0					0	warn $UNIVERSAL::require::ERROR;
1657	0					0	$cache{ $filter_class } = 0;
1658	0					0	next;
1659							}
1660	45					191	$cache{ $filter_class } = 1;
1661							}
1662							elsif ( !$cache{ $filter_class } ) {
1663	0					0	next;
1664							}
1665
1666	817					4018	my $filter = $filter_class->new(
1667							record => $self,
1668							column => $args{'column'},
1669							value_ref => $args{'value_ref'},
1670							handle => $self->_handle,
1671							);
1672
1673							# XXX TODO error proof this
1674	817					4021	$filter->$action();
1675							}
1676							} }
1677
1678							=head2 is_distinct COLUMN_NAME, VALUE
1679
1680							Checks to see if there is already a record in the database where
1681							COLUMN_NAME equals VALUE. If no such record exists then the
1682							COLUMN_NAME and VALUE pair is considered distinct and it returns 1.
1683							If a value is already present the test is considered to have failed
1684							and it returns a L with the error.
1685
1686							=cut
1687
1688							sub is_distinct {
1689	5			5	1	13	my $self = shift;
1690	5					11	my $column = shift;
1691	5					9	my $value = shift;
1692
1693	5					48	my $record = $self->new( $self->_new_record_args );
1694	5					31	$record->load_by_cols( $column => $value );
1695
1696	5					41	my $ret = Class::ReturnValue->new();
1697
1698	5	100				49	if ( $record->id ) {
1699	2					16	$ret->as_array( 0, "Value already exists for unique column $column" );
1700	2					98	$ret->as_error(
1701							errno => 3,
1702							do_backtrace => 0,
1703							message => "Value already exists for unique column $column",
1704							);
1705	2					202	return ( $ret->return_value );
1706							} else {
1707	3					74	return (1);
1708							}
1709							}
1710
1711							=head2 run_canonicalization_for_column column => 'COLUMN', value => 'VALUE'
1712
1713							Runs all canonicalizers for the specified column.
1714
1715							=cut
1716
1717							sub run_canonicalization_for_column {
1718	0			0	1	0	my $self = shift;
1719	0					0	my %args = (
1720							column => undef,
1721							value => undef,
1722							extra => [],
1723							@_
1724							);
1725
1726	0					0	my ( $ret, $value_ref ) = $self->_run_callback(
1727							name => "canonicalize_" . $args{'column'},
1728							args => $args{'value'},
1729							extra => $args{'extra'},
1730							short_circuit => 0,
1731							);
1732	0	0				0	return unless defined $ret;
1733							return (
1734	0	0				0	exists $value_ref->[-1]->[0]
1735							? $value_ref->[-1]->[0]
1736							: $args{'value'}
1737							);
1738							}
1739
1740							=head2 has_canonicalizer_for_column COLUMN
1741
1742							Returns true if COLUMN has a canonicalizer, otherwise returns undef.
1743
1744							=cut
1745
1746							sub has_canonicalizer_for_column {
1747	0			0	1	0	my $self = shift;
1748	0					0	my $key = shift;
1749	0					0	my $method = "canonicalize_$key";
1750	0	0				0	if ( $self->can($method) ) {
		0
1751	0					0	return 1;
1752							# We have to force context here because we're reaching inside Class::Trigger
1753							} elsif ( my @sighs = Class::Trigger::__fetch_all_triggers($self, $method) ) {
1754	0					0	return 1;
1755							} else {
1756	0					0	return undef;
1757							}
1758							}
1759
1760							=head2 run_validation_for_column column => 'COLUMN', value => 'VALUE' [extra => \@ARGS]
1761
1762							Runs all validators for the specified column.
1763
1764							=cut
1765
1766							sub run_validation_for_column {
1767	0			0	1	0	my $self = shift;
1768	0					0	my %args = (
1769							column => undef,
1770							value => undef,
1771							extra => [],
1772							@_
1773							);
1774	0					0	my $key = $args{'column'};
1775	0					0	my $attr = $args{'value'};
1776
1777	0					0	my ( $ret, $results )
1778							= $self->_run_callback(
1779							name => "validate_" . $key,
1780							args => $attr,
1781							extra => $args{'extra'},
1782							);
1783
1784	0	0				0	if ( defined $ret ) {
1785	0					0	return ( 1, 'Validation ok' );
1786							} else {
1787	0					0	return ( @{ $results->[-1] } );
	0					0
1788							}
1789
1790							}
1791
1792							=head2 has_validator_for_column COLUMN
1793
1794							Returns true if COLUMN has a validator, otherwise returns undef.
1795
1796							=cut
1797
1798							sub has_validator_for_column {
1799	0			0	1	0	my $self = shift;
1800	0					0	my $key = shift;
1801	0					0	my $method = "validate_$key";
1802	0	0				0	if ( $self->can( $method ) ) {
		0
1803	0					0	return 1;
1804							# We have to force context here because we're reaching inside Class::Trigger
1805							} elsif ( my @sighs = Class::Trigger::__fetch_all_triggers($self, $method) ) {
1806	0					0	return 1;
1807							} else {
1808	0					0	return undef;
1809							}
1810							}
1811
1812							sub _run_callback {
1813	795			795		1557	my $self = shift;
1814	795					6634	my %args = (
1815							name => undef,
1816							args => undef,
1817							short_circuit => 1,
1818							extra => [],
1819							@_
1820							);
1821
1822	795					6635	my $ret;
1823	795					1761	my $method = $args{'name'};
1824	795					1191	my @results;
1825	795	50				11548	if ( my $func = $self->can($method) ) {
1826	0					0	@results = $func->( $self, $args{args}, @{$args{'extra'}} );
	0					0
1827	0	0	0			0	return ( wantarray ? ( undef, [ [@results] ] ) : undef )
		0
1828							if $args{short_circuit} and not $results[0];
1829							}
1830	795					3102	$ret = $self->call_trigger( $args{'name'} => $args{args}, @{$args{'extra'}} );
	795					5753
1831							return (
1832							wantarray
1833	795	50				122741	? ( $ret, [ [@results], @{ $self->last_trigger_results } ] )
	0
1834							: $ret
1835							);
1836							}
1837
1838							=head2 unload_value COLUMN
1839
1840							Purges the cached value of COLUMN from the object, forcing it to be
1841							fetched from the database next time it is queried.
1842
1843							=cut
1844
1845							sub unload_value {
1846	0			0	1		my $self = shift;
1847	0						my $column = shift;
1848	0						delete $self->{$_}{$column} for qw/values raw_values fetched decoded _prefetched/;
1849							}
1850
1851							1;
1852
1853							__END__