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	507	my $self = shift;
671							return @{
672	1					2	$self->_WRITABLE_COLS_CACHE() \|\| $self->_WRITABLE_COLS_CACHE(
	4					11
673	1	50				3	[ sort map { $_->name } grep { $_->writable } $self->columns ]
	5					18
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		414	my $self = shift;
773	339					396	my $column = shift;
774
775	339					812	my $value = $self->__value( $column => @_ );
776	339					1116	$self->_run_callback(
777							name => "after_" . $column,
778							args => \$value
779							);
780	339					1247	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		985	my $self = shift;
792
793	10					16	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				53	return $self->{'raw_values'}{$column_name}
798							if $self->{'fetched'}{$column_name};
799
800	4	100	66			24	if ( !$self->{'fetched'}{$column_name} and my $id = $self->id() ) {
801	3					7	my $pkey = $self->_primary_key();
802	3					11	my $query_string =
803							"SELECT "
804							. $column_name
805							. " FROM "
806							. $self->table
807							. " WHERE $pkey = ?";
808	3					19	my $sth = $self->_handle->simple_query( $query_string, $id );
809	3					5	my ($value) = eval { $sth->fetchrow_array() };
	3					34
810	3					8	$self->{'raw_values'}{$column_name} = $value;
811	3					36	$self->{'fetched'}{$column_name} = 1;
812							}
813
814	4					15	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		442	my $self = shift;
840
841	376					1027	my $column = $self->COLUMNS->{ +shift }; # Shortcut around ->resolve_column
842	376	100				2664	return unless $column;
843
844	374					518	my $column_name = $column->{name}; # Speed optimization
845
846	374	50				1029	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			3556	return $self->{'values'}{$column_name}
853							if ( $self->{'fetched'}{$column_name}
854							&& $self->{'decoded'}{$column_name} );
855
856	215	100				556	unless ($self->{'fetched'}{$column_name}) {
857							# Fetch it, and mark it as not decoded
858	4					30	$self->{'values'}{$column_name} = $self->__raw_value( $column_name );
859	4					10	$self->{'decoded'}{$column_name} = 0;
860							}
861
862	215	50				596	unless ( $self->{'decoded'}{$column_name} ) {
863	215	50				1218	$self->_apply_output_filters(
864							column => $column,
865							value_ref => \$self->{'values'}{$column_name},
866							) if exists $self->{'values'}{$column_name};
867	215					525	$self->{'decoded'}{$column_name} = 1;
868							}
869
870	215					485	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	2	my $self = shift;
882	1					2	my %values;
883	1					7	$values{$_} = $self->$_() for $self->readable_attributes;
884	1					7	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		754	my $self = shift;
897	61					322	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					220	my $ok = $self->_run_callback(
906							name => "before_set",
907							args => \%args,
908							);
909	61	50				167	return $ok if ( not defined $ok );
910
911							# Call the specific before_set_column triggers
912	61					239	$ok = $self->_run_callback(
913							name => "before_set_" . $args{column},
914							args => \%args,
915							);
916	61	50				166	return $ok if ( not defined $ok );
917
918							# Fetch the old value for the benefit of the triggers
919	61					180	my $old_value = $self->_value( $args{column} );
920
921	61					262	$ok = $self->__set(%args);
922	61	100				1816	return $ok if not $ok;
923
924							# Fetch the value back to make sure we have the actual value
925	58					775	my $value = $self->_value( $args{column} );
926
927							# Call the general after_set triggers
928	58					337	$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					355	$self->_run_callback(
935							name => "after_set_" . $args{column},
936							args => { column => $args{column}, value => $value, old_value => $old_value },
937							);
938
939	58					460	return $ok;
940							}
941
942							sub __set {
943	61			61		85	my $self = shift;
944
945	61					234	my %args = (
946							'column' => undef,
947							'value' => undef,
948							'is_sql_function' => undef,
949							@_
950							);
951
952	61					337	my $ret = Class::ReturnValue->new();
953
954	61					378	my $column = $self->column( $args{'column'} );
955	61	100				151	unless ($column) {
956	1					7	$ret->as_array( 0, 'No column specified' );
957	1					127	$ret->as_error(
958							errno => 5,
959							do_backtrace => 0,
960							message => "No column specified"
961							);
962	1					25	return ( $ret->return_value );
963							}
964
965	60					110	my $unmunged_value;
966	60	50				161	unless ($args{is_sql_function}) {
967	60					207	$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			368	if ( $self->{'fetched'}{ $column->name }
977							\|\| !$self->{'decoded'}{ $column->name } )
978							{
979	60	100	100			670	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					20	$ret->as_array( 1, "That is already the current value" );
994	2					18	return ( $ret->return_value );
995							}
996							}
997
998	58	100				736	if ( my $sub = $column->validator ) {
999	4					34	my ( $ok, $msg ) = $sub->( $self, $args{'value'} );
1000	4	100				40	unless ($ok) {
1001	1					5	$ret->as_array( 0, 'Illegal value for ' . $column->name );
1002	1					21	$ret->as_error(
1003							errno => 3,
1004							do_backtrace => 0,
1005							message => "Illegal value for " . $column->name
1006							);
1007	1					17	return ( $ret->return_value );
1008							}
1009							}
1010
1011							# Implement 'is distinct' checking
1012	57	100				359	if ( $column->distinct ) {
1013	1					7	my $ret = $self->is_distinct( $column->name, $args{'value'} );
1014	1	50				23	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					315	$unmunged_value = $args{'value'};
1020
1021	56	100				139	if ( $column->type =~ /^(text\|longtext\|clob\|blob\|lob\|bytea)$/i ) {
1022	5					44	my $bhash
1023							= $self->_handle->blob_params( $column->name, $column->type );
1024	5					12	$bhash->{'value'} = $args{'value'};
1025	5					7	$args{'value'} = $bhash;
1026							}
1027							}
1028
1029	56					474	my $val = $self->_handle->update_record_value(
1030							%args,
1031							table => $self->table(),
1032							primary_keys => { $self->primary_keys() }
1033							);
1034
1035	56	50				383	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				279	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					529	$self->{'raw_values'}{ $column->name } = $unmunged_value;
1056	56					608	$self->{'values'}{ $column->name } = $unmunged_value;
1057	56					1264	$self->{'decoded'}{ $column->name } = 0;
1058							}
1059	56					496	$ret->as_array( 1, "The new value has been set." );
1060	56					1731	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	34691	my $self = shift;
1074	68	100	66			479	return unless @_ and defined $_[0];
1075	67	50				220	Carp::carp("load called with more than one argument. Did you mean load_by_cols?") if @_ > 1;
1076
1077	67					333	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	1476	my $class = shift;
1104	122					309	my %hash = (@_);
1105	122					136	my ($self);
1106	122	100				293	if ( ref($class) ) {
1107	120					249	( $self, $class ) = ( $class, undef );
1108							} else {
1109	2		100			15	$self = $class->new( handle => ( delete $hash{'_handle'} \|\| undef ) );
1110							}
1111
1112	122					152	my ( @bind, @phrases );
1113	122					347	foreach my $key ( keys %hash ) {
1114	124	100	100			725	if ( defined $hash{$key} && $hash{$key} ne '' ) {
		100
1115	120					154	my $op;
1116							my $value;
1117	120					178	my $function = "?";
1118	120					379	my $column_obj = $self->column($key);
1119	120	50				305	Carp::confess(
1120							"Unknown column '$key' in class '" . ref($self) . "'" )
1121							if !defined $column_obj;
1122	120					500	my $case_sensitive = $column_obj->case_sensitive;
1123	120	100				712	if ( ref $hash{$key} eq 'HASH' ) {
1124	3					7	$op = $hash{$key}->{operator};
1125	3					7	$value = $hash{$key}->{value};
1126	3		50			15	$function = $hash{$key}->{function} \|\| "?";
1127	3	100				12	$case_sensitive = $hash{$key}->{case_sensitive}
1128							if exists $hash{$key}->{case_sensitive};
1129							} else {
1130	117					157	$op = '=';
1131	117					199	$value = $hash{$key};
1132							}
1133
1134	120	100	66			619	if ( blessed $value && $value->isa('Jifty::DBI::Record') ) {
1135	1	50				5	my $by = defined $column_obj->by ? $column_obj->by : 'id';
1136	1					14	$value = $value->$by;
1137							}
1138
1139							$self->_apply_input_filters(
1140	120	100				401	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			708	if ( $self->_handle->case_sensitive && $value ) {
1147	112	100	100			484	if ( $column_obj->is_string && !$case_sensitive ) {
1148	21					49	( $key, $op, $function )
1149							= $self->_handle->_make_clause_case_insensitive( $key,
1150							$op, $function );
1151							}
1152							}
1153
1154	120	50	33			580	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					920	push @phrases, "$key $op $function";
1158	120					343	push @bind, $value;
1159							}
1160
1161							} elsif ( !defined $hash{$key} ) {
1162	2					7	push @phrases, "$key IS NULL";
1163							} else {
1164	2					7	push @phrases, "($key IS NULL OR $key = ?)";
1165	2					6	my $column = $self->column($key);
1166
1167	2	100				9	if ( $column->is_numeric ) {
1168	1					2	push @bind, 0;
1169							} else {
1170	1					3	push @bind, '';
1171							}
1172
1173							}
1174							}
1175
1176	122					541	my $query_string
1177							= "SELECT * FROM "
1178							. $self->table
1179							. " WHERE "
1180							. join( ' AND ', @phrases );
1181	122	100				945	if ($class) {
1182	2					6	$self->_load_from_sql( $query_string, @bind );
1183	2					8	return $self;
1184							} else {
1185	120					463	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	18	my $self = shift;
1198	3	100				7	my $data = ( ref $_[0] eq 'HASH' ) ? $_[0] : {@_};
1199
1200	3					4	my %cols = ();
1201	3					2	foreach ( @{ $self->_primary_keys } ) {
	3					6
1202	3	100				10	return ( 0, "Missing PK column: '$_'" ) unless defined $data->{$_};
1203	2					3	$cols{$_} = $data->{$_};
1204							}
1205	2					6	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	150	my $self = shift;
1217	158					143	my $hashref = shift;
1218	158					210	my %args = @_;
1219	158	50				278	if ($args{fast}) {
1220							# Optimization for loading from database
1221	158					174	$self->{values} = $hashref;
1222	158					118	$self->{fetched}{$_} = 1 for keys %{$hashref};
	158					816
1223							# copy $hashref so changing 'values' doesn't change 'raw_values'
1224	158					175	$self->{raw_values}{$_} = $hashref->{$_} for keys %{$hashref};
	158					677
1225	158					255	$self->{decoded} = {};
1226	158					336	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		196	my $self = shift;
1255	126					165	my $query_string = shift;
1256	126					245	my @bind_values = (@_);
1257
1258	126					262	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				315	return ( 0, "Couldn't execute query" ) unless $sth;
1263
1264	125					4106	my $hashref = $sth->fetchrow_hashref;
1265	125					433	delete $self->{'values'};
1266	125					179	delete $self->{'raw_values'};
1267	125					272	$self->{'fetched'} = {};
1268	125					226	$self->{'decoded'} = {};
1269
1270							#foreach my $f ( keys %$hashref ) { $self->{'fetched'}{ $f } = 1; }
1271	125					375	foreach my $col ( map { $_->name } $self->columns ) {
	521					2743
1272	521	100				1297	next unless exists $hashref->{ lc($col) };
1273	473					633	$self->{'fetched'}{$col} = 1;
1274	473					714	$self->{'values'}->{$col} = $hashref->{ lc($col) };
1275	473					845	$self->{'raw_values'}->{$col} = $hashref->{ lc($col) };
1276							}
1277	125	50	66			534	if ( !$self->{'values'} && $sth->err ) {
1278	0					0	return ( 0, "Couldn't fetch row: " . $sth->err );
1279							}
1280
1281	125	100				325	unless ( $self->{'values'} ) {
1282	6					113	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				464	if ( grep { not defined } $self->primary_keys ) {
	238					510
1289	1					11	return ( 0, "Missing a primary key?" );
1290							}
1291
1292	118					1855	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	30681	my $class = shift;
1365	106					315	my %attribs = @_;
1366
1367	106					129	my ($self);
1368	106	100				314	if ( ref($class) ) {
1369	105					212	( $self, $class ) = ( $class, undef );
1370							} else {
1371	1		50			5	$self = $class->new(
1372							handle => ( delete $attribs{'_handle'} \|\| undef ) );
1373							}
1374
1375	106					464	my $ok
1376							= $self->_run_callback( name => "before_create", args => \%attribs );
1377	106	50				269	return $ok if ( not defined $ok );
1378
1379	106					516	my $ret = $self->__create(%attribs);
1380
1381	106					790	$ok = $self->_run_callback(
1382							name => "after_create",
1383							args => \$ret
1384							);
1385	106	50				390	return $ok if ( not defined $ok );
1386
1387	106	100				308	if ($class) {
1388	1					5	$self->load_by_cols( id => $ret );
1389	1					6	return ($self);
1390							} else {
1391	105					528	return ($ret);
1392							}
1393							}
1394
1395							sub __create {
1396	106			106		277	my ( $self, %attribs ) = @_;
1397
1398	106					285	foreach my $column_name ( keys %attribs ) {
1399	173					966	my $column = $self->column($column_name);
1400	173	50				613	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	173	100	66			880	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				80	my $by = defined $column->by ? $column->by : 'id';
1415	4					35	$attribs{$column_name} = $attribs{$column_name}->$by;
1416							}
1417
1418							$self->_apply_input_filters(
1419	173					2969	column => $column,
1420							value_ref => \$attribs{$column_name},
1421							);
1422
1423							# Implement 'is distinct' checking
1424	173	100				790	if ( $column->distinct ) {
1425	4					28	my $ret
1426							= $self->is_distinct( $column_name, $attribs{$column_name} );
1427	4	100				29	if ( not $ret ) {
1428	1					32	Carp::cluck(
1429							"$self failed a 'is_distinct' check for $column_name on "
1430							. $attribs{$column_name} );
1431	1					1095	return ($ret);
1432							}
1433							}
1434
1435	172	100				882	if ( $column->type =~ /^(text\|longtext\|clob\|blob\|lob\|bytea)$/i ) {
1436	8					120	my $bhash
1437							= $self->_handle->blob_params( $column_name, $column->type );
1438	8					27	$bhash->{'value'} = $attribs{$column_name};
1439	8					26	$attribs{$column_name} = $bhash;
1440							}
1441							}
1442
1443	105					1084	for my $column ( $self->columns ) {
1444	399	100	100			4099	if ( not defined $attribs{ $column->name }
			66
1445							and defined $column->default
1446							and not ref $column->default )
1447							{
1448	75					895	my $default = force $column->default;
1449	75	50				927	$default = $default->id
1450							if UNIVERSAL::isa( $default, 'Jifty::DBI::Record' );
1451
1452	75					143	$attribs{ $column->name } = $default;
1453
1454	75					326	$self->_apply_input_filters(
1455							column => $column,
1456							value_ref => \$attribs{ $column->name },
1457							);
1458							}
1459
1460	399	100	100			2790	if ( not defined $attribs{ $column->name }
			100
1461							and $column->mandatory
1462							and $column->type ne "serial" )
1463							{
1464							# Enforce "mandatory"
1465	1					24	Carp::carp "Did not supply value for mandatory column "
1466							. $column->name;
1467	1	50				591	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					15	return (0);
1474							}
1475							}
1476
1477	104					681	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	9	my $self = shift;
1509	3					7	my $before_ret = $self->_run_callback( name => 'before_delete' );
1510	3	50				8	return $before_ret unless ( defined $before_ret );
1511	3					15	my $ret = $self->__delete;
1512
1513	3					18	my $after_ret
1514							= $self->_run_callback( name => 'after_delete', args => \$ret );
1515	3	50				9	return $after_ret unless ( defined $after_ret );
1516	3					13	return ($ret);
1517
1518							}
1519
1520							sub __delete {
1521	3			3		4	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					8	my %pkeys = $self->primary_keys();
1528	3					8	my $return = $self->_handle->delete( $self->table, $self->primary_keys );
1529
1530	3	50				53	if ( UNIVERSAL::isa( 'Class::ReturnValue', $return ) ) {
1531	0					0	return ($return);
1532							} else {
1533	3					67	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	889	my $self = shift;
1553	683	100				1715	$self->TABLE_NAME( $self->_guess_table_name )
1554							unless ( $self->TABLE_NAME() );
1555	683					5981	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		427	my $self = shift;
1587	38	100				119	my $class = ref($self) ? ref($self) : $self;
1588	38	50				508	die "Couldn't turn " . $class . " into a table name"
1589							unless ( $class =~ /(?:\:\:)?(\w+)$/ );
1590	38					111	my $table = $1;
1591	38					288	$table =~ s/(?<=[a-z])([A-Z]+)/"_" . lc($1)/eg;
	5					19
1592	38					87	$table =~ tr/A-Z/a-z/;
1593	38					175	$table = Lingua::EN::Inflect::PL_N($table);
1594	38					84473	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	2242			2242		1951	my $self = shift;
1606	2242	100				3508	if (@_) {
1607	365					565	$self->{'DBIxHandle'} = shift;
1608							}
1609	2242					7583	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	553			553		594	my $self = shift;
1620	553					1370	my %args = ( direction => 'input', column => undef, @_ );
1621
1622	553	100				1227	if ( $args{'direction'} eq 'input' ) {
1623	338					703	return grep $_, map $_->input_filters,
1624							( $self, $args{'column'}, $self->_handle );
1625							} else {
1626	215					546	return grep $_, map $_->output_filters,
1627							( $self->_handle, $args{'column'}, $self );
1628							}
1629							}
1630
1631							sub _apply_input_filters {
1632	338			338		1080	return (shift)->_apply_filters( direction => 'input', @_ );
1633							}
1634
1635							sub _apply_output_filters {
1636	215			215		676	return (shift)->_apply_filters( direction => 'output', @_ );
1637							}
1638
1639							{ my %cache = ();
1640							sub _apply_filters {
1641	553			553		613	my $self = shift;
1642	553					2147	my %args = (
1643							direction => 'input',
1644							column => undef,
1645							value_ref => undef,
1646							@_
1647							);
1648
1649	553					1616	my @filters = $self->_filters(%args);
1650	553	100				1513	my $action = $args{'direction'} eq 'output' ? 'decode' : 'encode';
1651	553					877	foreach my $filter_class (@filters) {
1652	818	100				3175	unless ( exists $cache{ $filter_class } ) {
		50
1653	45					67	local $UNIVERSAL::require::ERROR;
1654	45					254	$filter_class->require;
1655	45	50				441	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					123	$cache{ $filter_class } = 1;
1661							}
1662							elsif ( !$cache{ $filter_class } ) {
1663	0					0	next;
1664							}
1665
1666	818					1954	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	818					2429	$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					6	my $column = shift;
1691	5					5	my $value = shift;
1692
1693	5					18	my $record = $self->new( $self->_new_record_args );
1694	5					18	$record->load_by_cols( $column => $value );
1695
1696	5					23	my $ret = Class::ReturnValue->new();
1697
1698	5	100				35	if ( $record->id ) {
1699	2					13	$ret->as_array( 0, "Value already exists for unique column $column" );
1700	2					86	$ret->as_error(
1701							errno => 3,
1702							do_backtrace => 0,
1703							message => "Value already exists for unique column $column",
1704							);
1705	2					29	return ( $ret->return_value );
1706							} else {
1707	3					39	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		885	my $self = shift;
1814	795					3363	my %args = (
1815							name => undef,
1816							args => undef,
1817							short_circuit => 1,
1818							extra => [],
1819							@_
1820							);
1821
1822	795					799	my $ret;
1823	795					1056	my $method = $args{'name'};
1824	795					750	my @results;
1825	795	50				4824	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					1082	$ret = $self->call_trigger( $args{'name'} => $args{args}, @{$args{'extra'}} );
	795					2675
1831							return (
1832							wantarray
1833	795	50				61244	? ( $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__