Attachment #45598 for bug #15206

View | Details | Raw Unified | Return to bug 15206
Collapse All | Expand All





=head2 GetAge

  my ($age_year, $age_month) = &GetAge($dateofbirth);

this function return the borrowers age with the value of dateofbirth



#'
sub GetAge{
    my ( $dateofbirth, $date_ref ) = @_;

    if ( not defined $date_ref ) {
        $date_ref = sprintf( '%04d-%02d-%02d', Today() );
    }

    my ( $year1, $month1, $day1 ) = split /-/, $dateofbirth;
    my ( $year2, $month2, $day2 ) = split /-/, $date_ref;

    my $age_year = $year2 - $year1;
    my $age_month = $month2 - $month1;
    my $age_day = $day2 - $day1;

    $age_month-- if $age_day < 0;

    if ($age_month < 0) {
        $age_year--;
        $age_month += 12;
    }

    return ($age_year, $age_month);
}    # sub get_age

=head2 SetAge

Lines 289-298 if ($op eq 'save' \|\| $op eq 'insert'){ Link Here

(-)a/members/memberentry.pl (-2 / +2 lines)
289	}	289	}
290		290
291	if ( $newdata{dateofbirth} ) {	291	if ( $newdata{dateofbirth} ) {
292	my $age = GetAge($newdata{dateofbirth});	292	my ($age_year, $age_month) = GetAge($newdata{dateofbirth});
293	my $borrowercategory=GetBorrowercategory($newdata{'categorycode'});	293	my $borrowercategory=GetBorrowercategory($newdata{'categorycode'});
294	my ($low,$high) = ($borrowercategory->{'dateofbirthrequired'}, $borrowercategory->{'upperagelimit'});	294	my ($low,$high) = ($borrowercategory->{'dateofbirthrequired'}, $borrowercategory->{'upperagelimit'});
295	if (($high && ($age > $high)) or ($age < $low)) {	295	if (($high && ($age_year > $high)) or ($age_year < $low)) {
296	push @errors, 'ERROR_age_limitations';	296	push @errors, 'ERROR_age_limitations';
297	$template->param( age_low => $low);	297	$template->param( age_low => $low);
298	$template->param( age_high => $high);	298	$template->param( age_high => $high);





use Modern::Perl;

use Test::More tests => 79;
use Test::MockModule;
use Data::Dumper;
use C4::Context;

    my $original_dateofbirth = $member->{dateofbirth};

    ##Testing GetAge()
    my ($age_year, $age_month) = GetAge("1992-08-14", "2011-01-19");
    is ($age_year, "18", "Age year correct");
    is ($age_month, "5", "Age month correct");

    ($age_year, $age_month) = GetAge("2011-01-19", "1992-01-19");
    is ($age_year, "-19", "Birthday In the Future");

    ##Testing SetAge() for now()
    my $dt_now = DateTime->now();
    my $age = DateTime::Duration->new(years => 12, months => 6, days => 1);
    C4::Members::SetAge( $member, $age );
    ($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
    is ($age_year, '12', "SetAge 12 years and 6 months");
    is ($age_month, '6', "SetAge 12 years and 6 months");

    $age = DateTime::Duration->new(years => 18, months => 12, days => 31);
    C4::Members::SetAge( $member, $age );
    ($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
    is ($age_year, '19', "SetAge 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.
    is ($age_month, '1', "SetAge 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.

    $age = DateTime::Duration->new(years => 18, months => 12, days => 30);
    C4::Members::SetAge( $member, $age );
    ($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
    is ($age_year, '19', "SetAge 18 years");
    is ($age_month, '1', "SetAge 18 years");

    $age = DateTime::Duration->new(years => 0, months => 1, days => 1);
    C4::Members::SetAge( $member, $age );
    ($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
    is ($age_year, '0', "SetAge 0 years");
    is ($age_month, '1', "SetAge 0 years");

    $age = '0018-12-31';
    C4::Members::SetAge( $member, $age );
    ($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
    is ($age_year, '19', "SetAge ISO_Date 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.

    $age = '0018-12-30';
    C4::Members::SetAge( $member, $age );
    ($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
    is ($age_year, '19', "SetAge ISO_Date 18 years");

    $age = '18-1-1';
    eval { C4::Members::SetAge( $member, $age ); };


    $age = DateTime::Duration->new(years => 10, months => 3);
    C4::Members::SetAge( $member, $age, $relative_date );
    ($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );
    is ($age_year, '10', "SetAge, 10 years and 3 months old person was born on ".$member->{dateofbirth}." if todays is ".$relative_date->ymd());

    $age = DateTime::Duration->new(years => 112, months => 1, days => 1);
    C4::Members::SetAge( $member, $age, $relative_date );
    ($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );
    is ($age_year, '112', "SetAge, 112 years, 1 months and 1 days old person was born on ".$member->{dateofbirth}." if today is ".$relative_date->ymd());

    $age = '0112-01-01';
    C4::Members::SetAge( $member, $age, $relative_date );
    ($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );
    is ($age_year, '112', "SetAge ISO_Date, 112 years, 1 months and 1 days old person was born on ".$member->{dateofbirth}." if today is ".$relative_date->ymd());

    $member->{dateofbirth} = $original_dateofbirth; #It is polite to revert made changes in the unit tests.
} #sub testAgeAccessors
- 

Return to bug 15206

Lines 1640-1646 sub GetBorrowercategoryList { Link Here

(-)a/C4/Members.pm (-7 / +13 lines)
1640		1640
1641	=head2 GetAge	1641	=head2 GetAge
1642		1642
1643	$dateofbirth,$date = &GetAge($date);	1643	my ($age_year, $age_month) = &GetAge($dateofbirth);
1644		1644
1645	this function return the borrowers age with the value of dateofbirth	1645	this function return the borrowers age with the value of dateofbirth
1646		1646
Lines 1648-1668 this function return the borrowers age with the value of dateofbirth Link Here
1648		1648
1649	#'	1649	#'
1650	sub GetAge{	1650	sub GetAge{
1651	my ( $date, $date_ref ) = @_;	1651	my ( $dateofbirth, $date_ref ) = @_;
1652		1652
1653	if ( not defined $date_ref ) {	1653	if ( not defined $date_ref ) {
1654	$date_ref = sprintf( '%04d-%02d-%02d', Today() );	1654	$date_ref = sprintf( '%04d-%02d-%02d', Today() );
1655	}	1655	}
1656		1656
1657	my ( $year1, $month1, $day1 ) = split /-/, $date;	1657	my ( $year1, $month1, $day1 ) = split /-/, $dateofbirth;
1658	my ( $year2, $month2, $day2 ) = split /-/, $date_ref;	1658	my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1659		1659
1660	my $age = $year2 - $year1;	1660	my $age_year = $year2 - $year1;
1661	if ( $month1 . $day1 > $month2 . $day2 ) {	1661	my $age_month = $month2 - $month1;
1662	$age--;	1662	my $age_day = $day2 - $day1;
		1663
		1664	$age_month-- if $age_day < 0;
		1665
		1666	if ($age_month < 0) {
		1667	$age_year--;
		1668	$age_month += 12;
1663	}	1669	}
1664		1670
1665	return $age;	1671	return ($age_year, $age_month);
1666	} # sub get_age	1672	} # sub get_age
1667		1673
1668	=head2 SetAge	1674	=head2 SetAge

Lines 17-23 Link Here

(-)a/t/db_dependent/Members.t (-25 / +29 lines)
17		17
18	use Modern::Perl;	18	use Modern::Perl;
19		19
20	use Test::More tests => 74;	20	use Test::More tests => 79;
21	use Test::MockModule;	21	use Test::MockModule;
22	use Data::Dumper;	22	use Data::Dumper;
23	use C4::Context;	23	use C4::Context;
Lines 374-416 sub testAgeAccessors { Link Here
374	my $original_dateofbirth = $member->{dateofbirth};	374	my $original_dateofbirth = $member->{dateofbirth};
375		375
376	##Testing GetAge()	376	##Testing GetAge()
377	my $age=GetAge("1992-08-14", "2011-01-19");	377	my ($age_year, $age_month) = GetAge("1992-08-14", "2011-01-19");
378	is ($age, "18", "Age correct");	378	is ($age_year, "18", "Age year correct");
		379	is ($age_month, "5", "Age month correct");
379		380
380	$age=GetAge("2011-01-19", "1992-01-19");	381	($age_year, $age_month) = GetAge("2011-01-19", "1992-01-19");
381	is ($age, "-19", "Birthday In the Future");	382	is ($age_year, "-19", "Birthday In the Future");
382		383
383	##Testing SetAge() for now()	384	##Testing SetAge() for now()
384	my $dt_now = DateTime->now();	385	my $dt_now = DateTime->now();
385	$age = DateTime::Duration->new(years => 12, months => 6, days => 1);	386	my $age = DateTime::Duration->new(years => 12, months => 6, days => 1);
386	C4::Members::SetAge( $member, $age );	387	C4::Members::SetAge( $member, $age );
387	$age = C4::Members::GetAge( $member->{dateofbirth} );	388	($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
388	is ($age, '12', "SetAge 12 years");	389	is ($age_year, '12', "SetAge 12 years and 6 months");
		390	is ($age_month, '6', "SetAge 12 years and 6 months");
389		391
390	$age = DateTime::Duration->new(years => 18, months => 12, days => 31);	392	$age = DateTime::Duration->new(years => 18, months => 12, days => 31);
391	C4::Members::SetAge( $member, $age );	393	C4::Members::SetAge( $member, $age );
392	$age = C4::Members::GetAge( $member->{dateofbirth} );	394	($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
393	is ($age, '19', "SetAge 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.	395	is ($age_year, '19', "SetAge 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.
		396	is ($age_month, '1', "SetAge 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.
394		397
395	$age = DateTime::Duration->new(years => 18, months => 12, days => 30);	398	$age = DateTime::Duration->new(years => 18, months => 12, days => 30);
396	C4::Members::SetAge( $member, $age );	399	C4::Members::SetAge( $member, $age );
397	$age = C4::Members::GetAge( $member->{dateofbirth} );	400	($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
398	is ($age, '19', "SetAge 18 years");	401	is ($age_year, '19', "SetAge 18 years");
		402	is ($age_month, '1', "SetAge 18 years");
399		403
400	$age = DateTime::Duration->new(years => 0, months => 1, days => 1);	404	$age = DateTime::Duration->new(years => 0, months => 1, days => 1);
401	C4::Members::SetAge( $member, $age );	405	C4::Members::SetAge( $member, $age );
402	$age = C4::Members::GetAge( $member->{dateofbirth} );	406	($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
403	is ($age, '0', "SetAge 0 years");	407	is ($age_year, '0', "SetAge 0 years");
		408	is ($age_month, '1', "SetAge 0 years");
404		409
405	$age = '0018-12-31';	410	$age = '0018-12-31';
406	C4::Members::SetAge( $member, $age );	411	C4::Members::SetAge( $member, $age );
407	$age = C4::Members::GetAge( $member->{dateofbirth} );	412	($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
408	is ($age, '19', "SetAge ISO_Date 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.	413	is ($age_year, '19', "SetAge ISO_Date 18+1 years"); #This is a special case, where months=>12 and days=>31 constitute one full year, hence we get age 19 instead of 18.
409		414
410	$age = '0018-12-30';	415	$age = '0018-12-30';
411	C4::Members::SetAge( $member, $age );	416	C4::Members::SetAge( $member, $age );
412	$age = C4::Members::GetAge( $member->{dateofbirth} );	417	($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth} );
413	is ($age, '19', "SetAge ISO_Date 18 years");	418	is ($age_year, '19', "SetAge ISO_Date 18 years");
414		419
415	$age = '18-1-1';	420	$age = '18-1-1';
416	eval { C4::Members::SetAge( $member, $age ); };	421	eval { C4::Members::SetAge( $member, $age ); };
Lines 425-442 sub testAgeAccessors { Link Here
425		430
426	$age = DateTime::Duration->new(years => 10, months => 3);	431	$age = DateTime::Duration->new(years => 10, months => 3);
427	C4::Members::SetAge( $member, $age, $relative_date );	432	C4::Members::SetAge( $member, $age, $relative_date );
428	$age = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );	433	($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );
429	is ($age, '10', "SetAge, 10 years and 3 months old person was born on ".$member->{dateofbirth}." if todays is ".$relative_date->ymd());	434	is ($age_year, '10', "SetAge, 10 years and 3 months old person was born on ".$member->{dateofbirth}." if todays is ".$relative_date->ymd());
430		435
431	$age = DateTime::Duration->new(years => 112, months => 1, days => 1);	436	$age = DateTime::Duration->new(years => 112, months => 1, days => 1);
432	C4::Members::SetAge( $member, $age, $relative_date );	437	C4::Members::SetAge( $member, $age, $relative_date );
433	$age = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );	438	($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );
434	is ($age, '112', "SetAge, 112 years, 1 months and 1 days old person was born on ".$member->{dateofbirth}." if today is ".$relative_date->ymd());	439	is ($age_year, '112', "SetAge, 112 years, 1 months and 1 days old person was born on ".$member->{dateofbirth}." if today is ".$relative_date->ymd());
435		440
436	$age = '0112-01-01';	441	$age = '0112-01-01';
437	C4::Members::SetAge( $member, $age, $relative_date );	442	C4::Members::SetAge( $member, $age, $relative_date );
438	$age = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );	443	($age_year, $age_month) = C4::Members::GetAge( $member->{dateofbirth}, $relative_date->ymd() );
439	is ($age, '112', "SetAge ISO_Date, 112 years, 1 months and 1 days old person was born on ".$member->{dateofbirth}." if today is ".$relative_date->ymd());	444	is ($age_year, '112', "SetAge ISO_Date, 112 years, 1 months and 1 days old person was born on ".$member->{dateofbirth}." if today is ".$relative_date->ymd());
440		445
441	$member->{dateofbirth} = $original_dateofbirth; #It is polite to revert made changes in the unit tests.	446	$member->{dateofbirth} = $original_dateofbirth; #It is polite to revert made changes in the unit tests.
442	} #sub testAgeAccessors	447	} #sub testAgeAccessors
443	-