Business-AU-Ledger

 view release on metacpan or  search on metacpan

lib/Business/AU/Ledger/Util/Validate.pm  view on Meta::CPAN

		constraint_methods =>
		{
			day   => sub {return validate_day(pop)},
			month => sub {return validate_month(pop)},
			rm    => sub {return pop eq 'submit_payment' ? 1 : 0},
		},
		filters                => [sub {return clean_user_data(shift, 250)}, 'strip'],
		missing_optional_valid => 1,
		msgs                   =>
		{
			any_errors => 'error',
			prefix     => 'field_',
		},
		optional_regexp => qr/^(?:gst_amount|gst_code|petty_cash_in|petty_cash_out|private_use_amount|private_use_percent|reference|tx_detail)_\d+$/,
		required        => [qw/month rm sid/],
		required_regexp => qr/^(?:amount|category_code|day|payment_method|submit)_\d+$/,
	};

} # End of payment_profile.

# --------------------------------------------------

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

	return Data::FormValidator -> check($self -> query, $self -> receipt_profile);

} # End of receipt.

# -----------------------------------------------

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

	return
	{
		constraint_methods=>
		{
			day   => sub {return validate_day(pop)},
			month => sub {return validate_month(pop)},
			rm    => sub {return pop eq 'submit_receipt' ? 1 : 0},
		},
		filters                => [sub {return clean_user_data(shift, 250)}, 'strip'],
		missing_optional_valid => 1,
		msgs                   =>
		{
			any_errors => 'error',
			prefix     => 'field_',
		},
		optional_regexp => qr/^(?:bank_amount|comment|gst_amount|gst_code|reference|tx_detail)_\d+$/,
		required        => [qw/month rm sid/],
		required_regexp => qr/^(?:amount|category_code|day|submit)_\d+$/,
	};

} # End of receipt_profile.

# --------------------------------------------------

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

	return Data::FormValidator -> check($self -> query, $self -> update_context_profile);

} # End of update_context.

# -----------------------------------------------

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

	return
	{
		constraint_methods =>
		{
			rm          => sub {return pop eq 'update_context' ? 1 : 0},
			start_month => sub {return validate_month(pop)},
			start_year  => sub {return validate_year(pop)},
		},
		defaults =>
		{	# These apply before field_filters.
			comment => '', # Stop undef being passed thru to Postgres.
		},
		filters                => [sub {return clean_user_data(shift, 250)}, 'strip'],
		missing_optional_valid => 1,
		msgs                   =>
		{
			any_errors => 'error',
			prefix     => 'field_',
		},
		required => [qw/rm sid start_month start_year submit_context/],
	};

} # End of update_context_profile.

# --------------------------------------------------

sub validate_amount
{
	return sub
	{
		my($dfv, $value) = @_;
		my($field) = $dfv -> get_current_constraint_field;

		# Zap a leading $, if any;

		$value =~ s/^\$//;

		# Zap any embedded commas, if any.

		$value =~ tr/,//d;

		# Reject an empty field for 'amount'.

		if ( ($field =~ /^amount_\d+/) && (length($value) == 0) )
		{
			return 0;
		}

		# Accept up to 2 decimal places.

		return $RE{num}{decimal}{-places=>'0,2'} ? 1 : 0;
	};

} # End of validate_amount.

# --------------------------------------------------



( run in 1.137 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )