###################################################################
# Copyright (C) 2006 RoyaltyShare, Inc.  All Rights Reserved
###################################################################

package Common::FormObject;

use strict;
use warnings;
use Carp;
use Data::Dumper;

use lib '/app/tools/metadata/lib';
use Metadata::Validate::Harness;

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;
use Common::Timer;
use Common::XMLObject;
use Common::Log;
use Common::DB::Item::Language;

use base 'Common::XMLObject';

# This encapsulates an object that can
# - represent itself as XML, and
# - has fields that can be accessed, set, and validated.
#

use constant kPropertySeperator => '_';

# import user codes
use constant kImportEmailFound       => 'email_found';
use constant kErrImportAccountExists => 'account_exists';
use constant kImportSuccess          => 'import_success';

# form submit codes
use constant kSuccessDelete          => 'delete_success';
use constant kSuccessCommit          => 'commit_success';
use constant kSuccessInvalidate      => 'invalidate_success';
use constant kSuccessReportQueued    => 'report_queued_success';
use constant kSuccessFormSubmit      => 'form_submit_success';
use constant kErrFormSubmit          => 'form_submit_error';
use constant kErrFormResubmit        => 'form_submit_resubmit';
use constant kSuccessFormMakeDefault => 'form_make_default_success';
use constant kErrFormMakeDefault     => 'form_make_default_error';

# artist contract deletion error codes
use constant kErrArtistContractHasItems => 'artist_contract_has_items';

# product deletion error codes
use constant kErrProducttHasItems => 'product_has_items';

# album deletion error codes
use constant kErrAlbumHasItems => 'album_has_items';

# track deletion error codes
use constant kErrTrackHasLicenses  => 'track_has_licenses';
use constant kErrTrackHasContracts => 'track_has_contracts';
use constant kErrTrackHasSales     => 'track_has_sales';

# artist payee deletion error codes
use constant kErrArtistPayeeHasItems => 'artist_payee_has_items';

# validation error codes
use constant kErrDelete            => 'delete_error';
use constant kErrFieldBlank        => 'field_blank';
use constant kErrFieldLength       => 'field_length';
use constant kErrFieldInvalid      => 'field_invalid';
use constant kErrFieldDuplicate    => 'field_duplicate';
use constant kErrRequiredFields    => 'required_fields';
use constant kErrEmailNotAvailable => 'email_not_available';
use constant kErrEmailUnsupported  => 'email_unsupported';
use constant kErrInvalidState      => 'field_invalid_state';
use constant kErrDuplicate         => 'field_duplicate';
use constant kErrDuplicateISRC     => 'field_duplicate_isrc';
use constant kErrFieldOutOfRange   => 'field_out_of_range';
use constant kErrFieldNumeric      => 'field_numeric';

# login related codes
use constant kSuccessPasswordChanged => 'password_changed';
use constant kSuccessTokenValid      => "token_valid";
use constant kSuccessEmailSent       => "email_sent";
use constant kErrEmailFailed         => "email_failed";
use constant kErrPasswordSpaces      => 'password_spaces';
use constant kErrPasswordLength      => 'password_length';
use constant kErrPasswordUnsafe      => 'password_unsafe';
use constant kErrPasswordHistory     => 'password_history';
use constant kErrUserLockedOut       => 'user_locked';
use constant kErrPasswordExpired     => 'password_expired';
use constant kErrPasswordInvalid     => 'password_invalid';
use constant kErrTooManyFailedLogins => 'failed_logins';

use constant kErrPasswordMismatch    => "password_mismatch";
use constant kErrEmailInvalid        => "email_invalid";
use constant kErrEmailAccessLevel    => "email_access_level";
use constant kErrEmailNotFound       => "email_not_found";
use constant kErrUserDisabled        => "user_disabled";
use constant kErrClientInvalid       => "client_invalid";
use constant kErrTokenInvalid        => "token_invalid";
use constant kErrMFACodeInvalid      => "mfa_code_invalid";

# portal related codes
use constant kErrRequiredForDistribution   => "required_for_distribution";

sub _init {
    my ( $self, %args ) = @_;

    $self->SUPER::_init(%args);

    # we check readOnly when setting a value and during validation.
    # readOnly XMLObjects cannot be "set" and will not be validated.
    #
    $self->{_readOnly} = $args{readOnly};

    return $self;
}

sub validate {
    my $self = shift;

    # A recursive validation mechanism.
    # Subclasses should override this to perform specific
    # validation, if they care too, then call the inherited
    # method (this).  This base method implements the
    # recursive descent.
    #
    my $valid = 1;
    foreach my $field ( keys %$self ) {

        # skip 'private' fields
        #
        next if '_' eq substr( $field, 0, 1 );

        # If each contained entity is a reference and it _can_
        # validate, then let it.
        #
        my $obj = $self->{$field};
        if (   defined $obj
            && ref($obj)
            && ( 'ARRAY' ne ref($obj) && 'HASH' ne ref($obj) )
            && $obj->can('validate')
            && !$obj->readOnly() ) {
            if ( !$obj->validate(@_) ) {

                #                Common::Log::Debug("======> OBJ ($field) failed validation: " . Dumper($obj));
                $valid = 0;
            }
        }
    }

    return $valid;
}

# !!! JPK - we're going to need to move this.  We don't want a dependency on any of our libraries outside of Common in a Common module.
#
sub _validateMetadata {
    my ( $self, %args ) = @_;
    my $scalar_rule_map = $args{fieldMap};
    my $current_data    = $args{currentData};
    my $validator       = $args{metadataValidator};

    Common::Log::Debug( "FAIL STATE: " . $validator->{_failState} );

    my ( $map, $key, $validate_key );
    my $result;
    my $has_changed;
    my $valid = 1;

    Common::Log::Debug( "Validator: " . ref($validator) );
    return $valid unless ( $validator && ref($validator) && ref($validator) eq "Metadata::Validate::Harness" );

    assert( $self && $scalar_rule_map );

    #
    # This is a bit of a one off.  We should only validate metadata
    # only if it has changed.  So we will still allow bad data in the
    # database as long as it is already in the system.
    #

    foreach $key ( keys( %{$scalar_rule_map} ) ) {
        $map          = $scalar_rule_map->{$key}->{legacy};
        $validate_key = $scalar_rule_map->{$key}->{validate};
        Common::Log::Debug("Validating $key");

        # If one of the two operands are null or they are not equal
        if (
               $map
            && defined($current_data)
            && (   !defined( $self->{$key} )
                || !defined( $current_data->{$map} )
                || ( $self->$key() ne $current_data->$map() ) )
          ) {
            Common::Log::Debug("$key has changed!");

            # If both are null then don't test them, because they are the same.
            $has_changed = ( !defined( $self->{$key} ) && !defined( $current_data->$map ) ) ? undef : 1;

        } else {
            Common::Log::Debug("$key NO CHANGE!") unless ( $validator->ignore_current_data() );
            $has_changed = $validator->ignore_current_data ? 1 : undef;
        }

        # If we have a validation rule to test and the data is new or has changed
        if ( defined($map) && ( !$current_data || $has_changed || $validator->ignore_current_data() ) ) {
            $result = $validator->validate_item( $validate_key, $self->$key(), undef, %$current_data );
            if ($result) {
                Common::Log::Debug("Validation failed, $result->{message}, $result->{code}");
                $self->{$key}->setError( $result->{code} );
                $self->{$key}->setErrorString( $result->{message} );
                $valid = 0;
            }
        }
    }

    return $valid;
}

# Need a simple mechanism we can use to specify what entities can or cannot be edited.
# Objects can override this in whatever way they choose.
#
sub _propertyIsEditable {
    my ( $self, $property ) = @_;

    # Default - everything this object contains is editable.
    #
    return 1;
}

#
# assignCGIParams
#
# This routine is the start of our 'deep paramater' scheme.
#
sub assignCGIParams {
    my ( $self, $baseName, $cgiParams ) = @_;

    Common::Log::Debug("assignCGIParams: baseName = $baseName");

    my $errors = 0;
    foreach my $fieldName ( keys %$cgiParams ) {
        my ( $base, @propertyAddress ) = split( kPropertySeperator, $fieldName );

        # Skip over any parameters that don't match the base name
        # (like 'submit', for instance...)
        #
        next unless $base eq $baseName;

        if ( !$self->_accessProperty( \@propertyAddress, $cgiParams->{$fieldName} ) ) {
            Common::Log::Debug( "======> _accessProperty returned false: address "
                  . Dumper( \@propertyAddress )
                  . " fieldName $fieldName param value "
                  . Dumper( $cgiParams->{$fieldName} ) );
            $errors++;
        }
    }
    return ( 0 == $errors );
}

#
# _accessProperty
#
# It gets passed an array ref that contains the 'property address':
# i.e. if the original property was 'Address_Name', the referenced array
# would be ['Address', 'Name'].
#
# We decide here whether to invoke our accessor, or whether to invoke
# a contained property's _accessProperty method to process this further.
#
sub _accessProperty {
    my $self        = shift;
    my $addressList = shift;

    my $localProperty = shift @$addressList;

    confess "unknown method \"$localProperty\" invoked on object " . Dumper($self) unless exists $self->{$localProperty};

    # If we're trying to set a property's value, make sure it is editable.
    #
    if ( scalar @_ && !$self->_propertyIsEditable($localProperty) ) {

        # JPK - Tempted to throw an exception here...  I think I will. :)
        confess "$localProperty is _not_ editable";
    }

    #
    # See whether the named Property is a list.  We rely on subclasses
    # to tell us this by overloading the _listProperties() method to
    # return an identity hash that names these Properties.
    #
    if ( exists $self->_listProperties()->{$localProperty} ) {
        my $index = shift @$addressList;
        return $self->$localProperty( $index, $addressList, @_ );
    }

    if ( 0 == scalar @$addressList ) {

        # End of the line - Invoke the property accessor directly.
        #
        return $self->$localProperty(@_);
    }
    assert( defined $self->{$localProperty}, "ERROR - the local property called '$localProperty' is undefined : class = " . ref($self) );
    return $self->{$localProperty}->_accessProperty( $addressList, @_ );
}

# Property Accessors
#
# We won't define any here, but I want to discuss how they work.
# Each accessor should:
# - Have the same name as key in the $self hash, if possible.
# - Returns an array, consisting of ($successFlag, $value).
# -- When just _accessing_ a property, $successFlag should always be true.
# -- When _setting_ a property, $successFlag will let us know whether the
#    operation succeeded.  This allows us to legally set a property to undef...
#

#
# Override this to return an identity hash that identifies the Properties
# that are Lists (arrays).
#
# Ex:  If a class overrides this like so:
# return { Object => 1 };
#
# Then requests that hit that object that look like this:
#  Object_1_Foo('bar');
#
# will result in this method (which you declare) being invoked:
# sub Object { my ($self, $index, $methodAddress, $value) = @_; ... }
# ... where $index = 1, $methodAddress = 'Foo', and $value = 'bar'.
#
#
sub _listProperties {
    return {};
}

# JPK - Added this method so we can use reference chaining to read 'deep'
# XML objects.
#
# In other words, you can now write code like this: print $form->Catalog()->Artist()->ArtistName();
#
sub access {
    my $self = shift;
    return $self;
}

# This AUTOLOAD method provides the default accessor behavior, so
# we won't have to write a zillion little identical methods.
#
use vars qw($AUTOLOAD);

sub AUTOLOAD {
    my $self           = shift;
    my $fieldSpecifier = $AUTOLOAD;
    $fieldSpecifier =~ s/.*://;    # Strips fully-qualified portion.

    return if 'DESTROY' eq $fieldSpecifier;

    confess("no reference") if ( !ref($self) );
    if ( !exists $self->{$fieldSpecifier} ) {
        confess "unknown property/method \"$fieldSpecifier\"";
    }

    my $returnVal;
    if ( '_' eq substr( $fieldSpecifier, 0, 1 ) ) {
        return $self->{$fieldSpecifier};
    }
    eval {
        if ( ref( $self->{$fieldSpecifier} ) ) {
            $returnVal = $self->{$fieldSpecifier}->access(@_);
        } else {
            if ( scalar @_ ) {
                my $newValue = shift @_;
                $self->{$fieldSpecifier} = $newValue;
            }
            $returnVal = $self->{$fieldSpecifier};
        }
    };
    if ($@) {
        confess("error accessing $fieldSpecifier - not a blessed reference - error $@");
    }

    return $returnVal;
}

sub setError {
    my ( $self, $error ) = @_;

    # print STDERR "setError: caller = ". caller() .", error = $error, class = " . ref($self) . "\n";

    #Common::Log::Debug("======> setError: error = $error, obj = " . Dumper($self) );
    $self->setXMLParam( 'e', $error );
    $self->_hasError(1);
}

# Use this to pass along some sort of explicit, detailed error message (rather than a constant).
#
sub setErrorString {
    my ( $self, $errorString ) = @_;

    Common::Log::Debug( "======> setErrorString: erroString = $errorString, obj = " . Dumper($self) );
    $self->setXMLParam( 'emsg', $errorString );
    $self->_hasError(1);
}

sub _hasError {
    my $self = shift;

    if (@_) {
        my ($setFlag) = @_;
        $self->{_hasError} = $setFlag;
    } else {
        return $self->{_hasError};
    }
}

sub readOnly {
    my $self = shift;

    if (@_) {
        my ($value) = @_;
        $self->{_readOnly} = $value;
    } else {
        return $self->{_readOnly};
    }
}

sub loadSubs {
    my ( $self, $setFlag ) = @_;

    if ( defined $setFlag ) {
        $self->{_loadSubs} = $setFlag;
    }

    return $self->{_loadSubs};
}

sub _userIDToName {
    my ($id) = @_;

    return "Joe User";
}

sub _formatDate {
    my ($date) = @_;

    return $date;
}

# !!! Surely these two methods can live in utils?

# convert 201 (sec) to "3:21"
#
sub _secondsToMMSS {
    my ($seconds) = @_;
    $seconds = 0 unless ($seconds);

    my $minutes = $seconds / 60;
    $seconds = $seconds % 60;
    return sprintf( "%02d:%02d", $minutes, $seconds );
}

# convert "3:21" to 201 (sec) (=(60 * 3) + 21)
#
sub _MMSSToSeconds {
    my ($mmssString) = @_;

    my $seconds;
    if ( $mmssString =~ /^(\d{1,3})?:(\d\d?)$/ ) {
        $seconds = ( 60 * $1 ) + $2;
    }

    return $seconds;
}

#######################
# End package XMLObject
#######################

# This is a simple sub package to wrap simple scalar objects with the XMLObject interface.
# The primary motivation for this is to suppose XML Parameters for non-object properties.
# ex:  Suppose I have a entry like this:
# <Address>
#  <zipcode>92020</zipcode>
# </Address>
#
# By wrapping the zipcode field in this Scalar class, I can set its XML Params.. For example, to
# indicate an error during CGI validation:
# <Address>
#   <zipcode error="Invalid zipcode provided">92020</zipcode>
#

package Common::FormObject::Scalar;
use base 'Common::FormObject';

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;

use Data::Dumper;

sub _init {
    my ( $self, %args ) = @_;

    $self->SUPER::_init(%args);

    $self->{_required} = $args{required};
    $self->{_hasError} = 0;

    # !!!
    # If we're constructing a new item, based on database data,
    # then we don't want to actually use _setValue.
    # We'll use setRawValue, which doesn't do any validation or localization or nuthin'.
    #
    $self->setRawValue( $args{value} );

    if ( $args{maxLength} ) {
        $self->{_maxLength} = $args{maxLength};
        $self->setXMLParam( 'maxLength', $self->{_maxLength} );
    }

    if ( defined( $args{minValue} ) ) {
        $self->{_minValue} = $args{minValue};
        $self->setXMLParam( 'minValue', $self->{_minValue} );
    }

    if ( defined( $args{maxValue} ) ) {
        $self->{_maxValue} = $args{maxValue};
        $self->setXMLParam( 'maxValue', $self->{_maxValue} );
    }

    if ( defined( $args{id} ) ) {
        $self->{_id} = $args{id};
        $self->setXMLParam( 'id', $self->{_id} );
    }

    if ( $args{required} ) {
        $self->setXMLParam( 'required', 1 );
    }

    return $self;
}

sub writeXML {
    my ( $self, $xw, $tag ) = @_;
    $xw->element( $tag, $self->{_value}, $self->getXMLParams() );
}

sub _getValue {
    my ($self) = @_;

    return $self->{_value};
}

sub _setValue {
    my ( $self, $newValue ) = @_;

    if ( defined $newValue ) {

        # Trim out extra whitespace.
        #
        $newValue =~ s/^\s+//;
        $newValue =~ s/\s+$//;

        # scrub html tags
        #
        $newValue =~ s/<.+?>//g;
    }

    return $self->setRawValue($newValue);
}

sub setRawValue {
    my ( $self, $newValue ) = @_;

    $self->{_value} = $newValue;
    return $self->{_value};
}

sub access {
    my $self = shift;

    if (@_) {

        # Asserting is too harsh.
        # We'll just not bother to set anything.
        #
        return 1 if $self->readOnly();

        #		assert(! $self->readOnly(), "cannot assign to a read-only properly");

        # jpk - simplifying this a bit - going to get rid of the _validateNewValue method,
        # and just rely on an overload of plain ole' validate.
        #
        my $newValue = shift @_;
        $self->_setValue($newValue);
        return 1;
    }

    return $self->_getValue();
}

sub _isValid {
    my ($self) = @_;

    # We might already have an error...
    #
    my $valid = !$self->_hasError();

    if ( $self->{_required} && ( !defined $self->{_value} || '' eq $self->{_value} ) ) {
        $self->setError(Common::FormObject::kErrFieldBlank);
        $valid = 0;
    }

    # we only range check the value if it's been supplied. in cases where it's not
    # "required", an empty field would fail the check and that's not what we want.
    if ( defined( $self->{_value} ) ) {
        if ( defined( $self->{_minValue} ) && $self->{_value} < $self->{_minValue} ) {
            $self->setError(Common::FormObject::kErrFieldOutOfRange);
            $valid = 0;
        }

        if ( defined( $self->{_maxValue} ) && $self->{_value} > $self->{_maxValue} ) {
            $self->setError(Common::FormObject::kErrFieldOutOfRange);
            $valid = 0;
        }
    }

    return $valid;
}

sub validate {
    my ($self) = @_;

    if ( !$self->_isValid() ) {

        # Use a generic error message, if _isValid did not specify a more specific error.
        #
        if ( !$self->_hasError() ) {
            $self->setError(Common::FormObject::kErrFieldInvalid);
        }
        return 0;
    }

    return 1;
}

#######################
# End package XMLObject::Scalar
#######################

# Now, let's define wrappers for some common scalar subtypes.
#

package Common::FormObject::Scalar::String;
use base 'Common::FormObject::Scalar';

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;

use constant kDefaultMaxlength => 255;

# overriding _init to provide a place to specify maxLength
#
sub _init {
    my ( $self, %args ) = @_;

    $args{maxLength} = kDefaultMaxlength unless defined $args{maxLength};

    return $self->SUPER::_init(%args);
}

#
# Over load this method so that we can strip out and funky control chars
# introduced into the system via excel files
#
sub setRawValue {
    my ( $self, $newValue ) = @_;

    if ( defined $newValue ) {

        #Common::Log::Debug( "Filtering: $newValue" );
        #my @ascii_character_numbers = unpack("C*", $newValue );
        #Common::Log::Debug( "Filter Target: $newValue: @ascii_character_numbers" );

        # Replace known control characters
        #
        $newValue =~ s/\x13/-/g;
        $newValue =~ s/\x18/'/g;
        $newValue =~ s/\x19/'/g;
        $newValue =~ s/\x1C/"/g;
        $newValue =~ s/\x1D/"/g;

        #@ascii_character_numbers = unpack("C*", $newValue );
        #Common::Log::Debug( "Filter Result: $newValue: @ascii_character_numbers" );

        # Replace unknown control characters
        #
        #$newValue =~ s/[:cntrl:]/?/g;

    }

    return $self->SUPER::setRawValue($newValue);
}

#################################################

# Now, let's define wrappers for some common scalar subtypes.
#

package Common::FormObject::Scalar::ID;
use base 'Common::FormObject::Scalar';

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;

# overriding _init to provide a place to specify maxLength
#
sub _init {
    my ( $self, %args ) = @_;

    return $self->SUPER::_init(%args);
}

#################################################

package Common::FormObject::Scalar::Integer;
use base 'Common::FormObject::Scalar';
use strict;
use warnings;

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;
use Common::Client;
use Common::RSApp;

sub _init {
    my ( $self, %args ) = @_;

    # !!! This needs to be lazy - Common::Client is also an XMLObject, and
    # !!! we'll get into a recursive death spiral if we try to fetch it before
    # !!! it has instantiated.
    #
    #    $self->{_locale} = $args{locale} ? $args{locale} : Common::Client::Locale();
    $self->{_locale} = $args{locale};

    $self->SUPER::_init(%args);

    return $self;
}

sub _getLocale {
    my ($self) = @_;

    if ( !$self->{_locale} ) {
        $self->{_locale} = Common::Client::Current()->Locale();
    }

    return $self->{_locale};
}

# Overriding inherited setValue method in order to
# allow commas in the numbers (eg. 1,000,000)
#
sub _setValue {
    my ( $self, $newValue ) = @_;

    if ( defined $newValue ) {

        # If this isn't a valid number, I want to set an error code immediately.
        #
        if ( !$self->_getLocale()->isValidNumber($newValue) ) {
            $self->setError(Common::FormObject::kErrFieldInvalid);
        } else {

            # If it was a valid number, convert it to our internal representation.
            #
            $newValue = $self->_getLocale()->scrubNumber($newValue);
        }
    }

    return $self->SUPER::_setValue($newValue);
}

sub writeXML {
    my ( $self, $xw, $tag ) = @_;

    $xw->element( $tag, $self->_formatForOutput( $self->{_value} ), $self->getXMLParams() );
}

sub _formatForOutput {
    my ( $self, $value ) = @_;

    $self->setXMLParam( 'raw', $value );

    # Don't try and format this if there was an error.
    #
    if ( $self->_hasError() ) {
        return $value;
    }
    return $self->_getLocale()->formatNumber($value);
}

#################################################

package Common::FormObject::Scalar::Decimal;
use base 'Common::FormObject::Scalar';
use strict;
use warnings;

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;
use Common::RSMath;
use Common::Client;
use Common::RSApp;

sub _defaultPrecision {
    return '.4';
}

sub _init {
    my ( $self, %args ) = @_;

    $self->{_precision} = $args{precision} ? $args{precision} : $self->_defaultPrecision();
    $self->{_locale} = $args{locale};

    $self->SUPER::_init(%args);

    return $self;
}

sub _getLocale {
    my ($self) = @_;

    if ( !$self->{_locale} ) {
        $self->{_locale} = Common::Client::Current()->Locale();
    }

    return $self->{_locale};
}

sub _setValue {
    my ( $self, $newValue ) = @_;

    if ( defined $newValue ) {

        # If this isn't a valid number, I want to set an error code immediately.
        #
        if ( !$self->_getLocale()->isValidNumber($newValue) ) {
            $self->setError(Common::FormObject::kErrFieldInvalid);
        } else {

            # If it was a valid number, convert it to our internal representation.
            #
            $newValue = $self->_getLocale()->scrubNumber($newValue);
        }
    }

    return $self->SUPER::_setValue($newValue);
}

sub writeXML {
    my ( $self, $xw, $tag ) = @_;

    my $xmlOutput;

    if ( defined $self->{_value} ) {
        $xmlOutput = $self->{_value};

        # Don't apply any more formatting if we've already got an error.
        # We want the user to see the ugly truth...
        #
        if ( !$self->_hasError() ) {
            my $format = "%" . $self->{_precision} . "f";

            # bug #162, don't show decimal for 0 value
            #
            if ( $self->{_value} == 0 ) {
                $format = "%d";
            }

            my $roundTo = $self->{_precision};
            $roundTo =~ s/^(\d+)?\.(\d+)$/$2/g;

            $xmlOutput = sprintf( $format, Common::RSMath::round( $self->{_value}, $roundTo ) );

            # !!! I think I can leave the preceeding formatting code alone.
            # !!! Now to apply the localization magic.
            #
            $xmlOutput = $self->_formatForOutput($xmlOutput);
        }
    } else {
        $xmlOutput = "";
    }

    $xw->element( $tag, $xmlOutput, $self->getXMLParams() );
}

sub _formatForOutput {
    my ( $self, $output ) = @_;

    return $self->_getLocale()->formatNumber($output);
}

# !!! This will need to be updated to account for foreign formatting.
#
#sub _isValid
#{
#    my ($self) = @_;
#print STDERR "DECIMAL:_isValid:\n";
#    my $valid = $self->SUPER::_isValid();
#print STDERR "DECIMAL:_isValid: inherited returned $valid\n";
#
#	my $value = $self->{_value};
##	$value =~ s/,//g;
#
##	if (defined $value && $value ne '' && $value !~ /^[+-]?\d*(\.)?\d+$/)
#	if (defined $value && $value ne '' && ! $self->{_locale}->isValidNumber($value))
#	{
#        print STDERR "DECIMAL:_isValid: FAILED for value $value\n";
#		$valid = 0;
#	}
#    return $valid;
#}

#################################################

package Common::FormObject::Scalar::Money;
use base 'Common::FormObject::Scalar::Decimal';
use strict;
use warnings;

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;
use Common::RSMath;
use Common::RSApp;
use Common::Locale;
use Common::CurrencyFormat;

sub _init {
    my ( $self, %args ) = @_;

    # Allow the user to pass in an alternate currency code.
    # If they don't specify it, we'll look it up later.
    # (We won't really know our locale until we're done initializing...)
    #
    $self->{_currencyCode} = $args{currencyCode} ? $args{currencyCode} : 0;

    $self->{_showCurrencyCode} = $args{showCurrencyCode} ? 1 : 0;

    $self->SUPER::_init(%args);

    # At this point we should know our Locale, so we can fill in some more bits.
    #
    if ( !$self->{_currencyCode} ) {
        $self->{_currencyCode} = $self->_getLocale()->currencyFormat()->currencyCode();
    }

    # Let's provide the symbol and the currency code as XMLParams.
    #
    $self->setXMLParam( 'currency_code',   $self->{_currencyCode} );
    $self->setXMLParam( 'currency_symbol', Common::CurrencyFormat::Symbol( $self->{_currencyCode} ) );
    $self->setXMLParam( 'value',           $self->{_value} );

    return $self;
}

sub _defaultPrecision {
    return '0.2';
}

sub _formatForOutput {
    my ( $self, $output ) = @_;

    my $currencyCode = $self->{_currencyCode};

    if ( $self->{_showCurrencyCode} ) {
        return $self->_getLocale()->formatMoneyWithCurrencyCode( $output, $currencyCode );
    } else {
        return $self->_getLocale()->formatMoney( $output, $currencyCode );
    }
}

# !!! Do we need to update the validation code to allow goofy currency symbols and stuff?
#

#################################################

package Common::FormObject::Scalar::Percent;
use base 'Common::FormObject::Scalar::Decimal';
use strict;
use warnings;

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;

sub _init {
    my ( $self, %args ) = @_;

    if ( !defined $args{value} ) {

        #if (defined $args{minValue})
        #{
        #	$args{value} = $args{minValue}
        #}
        #else
        #{
        $args{value} = 0;

        #}
    }

    $self->SUPER::_init(%args);

    if ( !defined( $self->{_minValue} ) ) {
        $self->{_minValue} = 0;
        $self->setXMLParam( 'minValue', $self->{_minValue} );
    }

    if ( !defined( $self->{_maxValue} ) ) {
        $self->{_maxValue} = 100;
        $self->setXMLParam( 'maxValue', $self->{_maxValue} );
    }

    return $self;
}

sub _defaultPrecision {
    return '.2';
}

#################################################

package Common::FormObject::Scalar::Boolean;
use base 'Common::FormObject::Scalar';

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;

sub _setValue {
    my ( $self, $newValue ) = @_;

    # Convert 'undef' to 0
    #
    $newValue = 0 unless $newValue;

    return $self->SUPER::_setValue($newValue);
}

sub _isValid {
    my ($self) = @_;

    my $valid = $self->SUPER::_isValid();

    if ( defined $self->{_value} && ( $self->{_value} !~ /^\d+$/ || ( $self->{_value} != 0 && $self->{_value} != 1 ) ) ) {
        $valid = 0;
    }

    return $valid;
}

#################################################

package Common::FormObject::Scalar::Date;
use base 'Common::FormObject::Scalar';

use Date::Calc;

use lib '/app/tools/common/lib';
use Common::XMLObject;
use Common::Assert;
use Common::Client;
use Common::RSApp;
use Common::Util qw(decodeDateMysql);

# Overriding inherited setValue method in order to
# translate incoming dates from 'MM/DD/YYYY' into 'YYY-MM-DD' format.
#
sub _setValue {
    my ( $self, $newValue ) = @_;

    if ( defined $newValue ) {
        my $decodedDate = Common::Client::Current()->Locale()->dateTimeFormat()->parseDate($newValue);

        if ($decodedDate) {
            my ( $year, $month, $day ) = split( '-', $decodedDate );

            if ( Date::Calc::check_date( $year, $month, $day ) ) {
                $newValue = sprintf( "%04d-%02d-%02d", $year, $month, $day );
            }
        }
    }

    return $self->SUPER::_setValue($newValue);
}

sub _isValid {
    my ($self) = @_;

    my $valid = $self->SUPER::_isValid();

    if ( defined( $self->{_value} ) && $self->{_value} ne '' ) {

        # my ($month, $day, $year) = split(/\//, $self->{_value});
        my ( $year, $month, $day ) = split( /-/, $self->{_value} );
        if ( !Date::Calc::check_date( $year, $month, $day ) ) {
            $valid = 0;
        }
    }

    return $valid;
}

# !!! Do we really want/need this method anymore?
#
sub formatMDY {
    my ($self) = @_;

    my $formatted;
    if ( $self->{_value} ) {
        my ( $year, $month, $day ) = split( /-/, $self->{_value} );
        if ( Date::Calc::check_date( $year, $month, $day ) ) {
            $formatted = Common::Client::Current()->Locale()->formatDate( $self->{_value} );
        }
    }

    return $formatted;
}

sub writeXML {
    my ( $self, $xw, $tag ) = @_;

    # if there isn't already a display value
    #
    if ( $self->{_value} && !$self->{_displayValue} ) {

        # if an invalid value was submitted and we caught it during validation
        # then we want to display the input value and not try to reformat
        #
        if ( !$self->_hasError() ) {
            my ( $year, $month, $day ) = split( /-/, $self->{_value} );

            # Last chance to do some sanity checking.
            #
            if ( Date::Calc::check_date( $year, $month, $day ) ) {
                $self->{_displayValue} = Common::Client::Current()->Locale()->formatDate( $self->{_value} );

                # We want to give the template the 'raw' numeric value for sorting purposes.
                #
                my $rawValue = sprintf( "%04d%02d%02d", $year, $month, $day );
                $self->setXMLParam( 'raw',   $rawValue );
                $self->setXMLParam( 'year',  $year );
                $self->setXMLParam( 'month', $month );
                $self->setXMLParam( 'day',   $day );

            }
        } else {
            $self->{_displayValue} = $self->{_value};
        }
    }

    $xw->element( $tag, $self->{_displayValue}, $self->getXMLParams() );
}

#################################################

# This class is not intended to be quite as magical
# as the Date class... Users generally will not be
# entering times in our interface.
# Really, it's primary purpose is to convert the
# date portion of mysql-style datetime values into
# mm/dd/yyyy format for printing purposes.
#

package Common::FormObject::Scalar::DateTime;
use base 'Common::FormObject::Scalar';

use Date::Calc;

use lib '/app/tools/common/lib';
use Common::Assert;
use Common::RSApp;
use Common::Util qw(decodeDateMysql);

# Overriding inherited setValue method in order to
# translate incoming dates from 'MM/DD/YYYY' into 'YYY-MM-DD' format.
#
sub _setValue {
    my ( $self, $newValue ) = @_;

    if ( defined $newValue ) {
        my ( $date, $time ) = split( / /, $newValue );

        # These Date::Calc::Decode... routines will return '0' if they fail, which
        # is why this logic works.
        #
        my ( $year, $month, $day );
        if (   ( ( $year, $month, $day ) = Date::Calc::Decode_Date_US($date) )
            || ( ( $year, $month, $day ) = Date::Calc::Decode_Date_EU($date) )
            || ( ( $year, $month, $day ) = decodeDateMysql($date) ) ) {
            if ( Date::Calc::check_date( $year, $month, $day ) ) {
                $date = sprintf( "%04d-%02d-%02d", $year, $month, $day );

                $newValue = "$date $time";
            }
        }
    }

    return $self->SUPER::_setValue($newValue);
}

sub _isValid {
    my ($self) = @_;

    my $valid = $self->SUPER::_isValid();

    if ( '' ne $self->{_value} ) {
        my ( $date, $time ) = split( / /, $self->{_value} );

        # my ($month, $day, $year) = split('/', $date);
        my ( $month, $day, $year ) = split( '-', $date );
        my ( $hour,  $min, $sec )  = split( /:/, $time );
        if (   !Date::Calc::check_date( $year, $month, $day )
            || !Date::Calc::check_time( $hour, $min, $sec ) ) {
            $valid = 0;
        }
    }

    return $valid;
}

sub writeXML {
    my ( $self, $xw, $tag ) = @_;

    # if there isn't a display value already.
    #
    if ( $self->{_value} && !$self->{_displayValue} ) {
        if ( !$self->_hasError() ) {
            my ( $date, $time ) = split( / /, $self->{_value} );
            if ( $date && $time ) {
                my ( $year, $month, $day ) = split( /-/, $date );

                # Last chance to do some sanity checking.
                #
                if ( $year && $month && $day ) {

                    #					$self->{_displayValue} = sprintf("%02d/%02d/%04d %s", $month, $day, $year, $time);
                    $self->{_displayValue} = Common::Client::Current()->Locale()->formatDateTime( $self->{_value} );
                }
            }
        } else {
            $self->{_displayValue} = $self->{_value};
        }
    }

    $xw->element( $tag, $self->{_displayValue}, $self->getXMLParams() );
}

#################################################

package Common::FormObject::Scalar::EmailAddress;
use base 'Common::FormObject::Scalar';

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;
use Common::Util qw(isValidEmailAddress);

sub _isValid {
    my ($self) = @_;

    my $valid = $self->SUPER::_isValid();

    if ( '' ne $self->{_value} ) {
        if ( !isValidEmailAddress( $self->{_value} ) ) {
            $valid = 0;
        }
    }

    return $valid;
}

#################################################

package Common::FormObject::Scalar::CountryList;
use base 'Common::FormObject::Scalar';

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;

sub _isValid {
    my ($self) = @_;

    if ( $self->{_value} =~ m/([A-Z][A-Z]( [A-Z][A-Z])*)?/ ) {
        return 1;
    }

    return 0;
}

#################################################

package Common::FormObject::Scalar::UserName;

# Generally we store users in our tables using an id.
# But we often want to display their actual name.
# This class facilitates that:  The accessors get and set
# their values as integers, but the writeXML method outputs
# the username.
#
use base 'Common::FormObject::Scalar';

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;

use lib '/app/tools/rps/lib';
use RPS::DB::Item::User;

sub writeXML {
    my ( $self, $xw, $tag ) = @_;

    if ( $self->{_value} && !$self->{_displayValue} ) {
        if ( !$self->_hasError() ) {

            # Get the 'real' user name via a db lookup
            #
            my $userItem = RPS::DB::Item::User->Lookup( user_id => $self->{_value} );
            if ($userItem) {
                $self->{_displayValue} = $userItem->first_name . " " . $userItem->last_name;
            }
        } else {
            $self->{_displayValue} = $self->{_value};
        }
    }

    $xw->element( $tag, $self->{_displayValue}, $self->getXMLParams() );
}

#################################################

package Common::FormObject::Scalar::PhoneNumber;

use base 'Common::FormObject::Scalar';

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;
use Common::Util;
use Common::FormValidation;

use lib '/app/tools/rps/lib';
use RPS::DB::Item::User;

sub writeXML {
    my ( $self, $xw, $tag ) = @_;

    my $value = Common::Util::pretty_phone( $self->{_value} );

    $xw->element( $tag, $value, $self->getXMLParams() );
}

sub _isValid {
    my ($self) = @_;

    my $valid = $self->SUPER::_isValid();

    if ( '' ne $self->{_value} ) {
        if ( Common::FormValidation::form_clean_validate_phone( $self->{_value} ) ) {
            $valid = 0;
        }
    }

    return $valid;
}

#################################################

package Common::FormObject::Scalar::Enum;

use base 'Common::FormObject::Scalar';

use lib '/app/tools/common/lib';
use Common::WriteXML;
use Common::XMLWriter;
use Common::Assert;
use Common::Util;

sub _init {
    my ( $self, %args ) = @_;

    $self->SUPER::_init(%args);

    # Enums must have a list of valid values!
    # These are used during validation.
    #
    assert( defined $args{validValues}, 'Enum: Missing validValues' );
    $self->{_validValues} = $args{validValues};
    $self->{_seperator} = $args{seperator} ? $args{seperator} : ',';

    # Show the list of items as an attribute.   Can XSL parse a string?
    # Javascript can...
    #
    $self->setXMLParam( 'options', join( $self->{_seperator}, @{ $self->{_validValues} } ) );
    $self->setXMLParam( 'sep', $self->{_seperator} );

    return $self;
}

sub _isValid {
    my ($self) = @_;

    my $valid = $self->SUPER::_isValid();

    my %valid;
    foreach my $validValue ( @{ $self->{_validValues} } ) {
        $valid{$validValue} = 1;
    }

    if ( defined $self->{_value} ) {
        if ( !$valid{ $self->{_value} } ) {
            $self->setError(Common::FormObject::kErrFieldInvalid);
            $valid = 0;
        }
    }

    return $valid;
}

#################################################

package Common::FormObject::Scalar::Language;
use base 'Common::FormObject::Scalar';

use lib '/app/tools/common/lib';
use Common::XMLObject;
use Common::Assert;
use Common::Client;
use Common::RSApp;

sub _isValid {
    my ($self) = @_;

    my $valid = $self->SUPER::_isValid();

    my $language = Common::DB::Item::Language->LanguageLookup( value => $self->{_value} );

    if ( !$language ) {
        $valid = 0;
    } else {
        $self->{_displayValue} = $language->name;
        $self->{_codeValue}    = $language->part1;
    }

    return $valid;
}

sub writeXML {
    my ( $self, $xw, $tag ) = @_;

    if ( !$self->{_displayValue} && ( $self->_hasError() || !$self->_isValid() ) ) {
        $self->{_displayValue} = $self->{_value};
    } elsif ( $self->{_codeValue} ) {
        $self->setXMLParam( 'code', $self->{_codeValue} );
    }

    $xw->element( $tag, $self->{_displayValue}, $self->getXMLParams() );
}

1;