+
+ warn "$me Checking for unmigrated reasons\n" if $DEBUG;
+
+ my @legacy_reason_records = qsearch(
+ {
+ 'table' => $table,
+ 'hashref' => {},
+ 'extra_sql' => 'WHERE ' . $fieldname . ' IS NOT NULL',
+ }
+ );
+
+ if ( @legacy_reason_records ) {
+
+ warn "$me Found unmigrated reasons\n" if $DEBUG;
+
+ my $reason_type =
+ $class->_upgrade_get_legacy_reason_type( $reason_class );
+ # XXX "noreason" does not actually work, because we limited to
+ # "reason is not null" above. Records where the reason string
+ # is null will end up with a reasonnum of null also.
+ my $noreason = $class->_upgrade_get_no_reason( $reason_type );
+
+ foreach my $record_to_upgrade (@legacy_reason_records) {
+ my $reason = $record_to_upgrade->getfield($fieldname);
+ warn "Contemplating reason $reason\n" if $DEBUG > 1;
+ if ( $reason =~ /\S/ ) {
+ my $reason =
+ $class->_upgrade_get_reason( $reason, $reason_type );
+ $record_to_upgrade->set( $fieldname . 'num',
+ $reason->reasonnum );
+ }
+ else {
+ $record_to_upgrade->set( $fieldname . 'num',
+ $noreason->reasonnum );
+ }
+
+ $record_to_upgrade->setfield( $fieldname, '' );
+ my $error = $record_to_upgrade->replace;
+
+ my $primary_key = $record_to_upgrade->primary_key;
+ warn "*** WARNING: error replacing $fieldname in $class "
+ . $record_to_upgrade->get($primary_key)
+ . ": $error ***\n"
+ if $error;
+ }
+ }