Attachment #57863 for bug #17557

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




        &GetFirstValidEmailAddress
        &GetNoticeEmailAddress

        &GetAge

        &GetHideLostItemsPreference

        &GetMemberAccountRecords

    return $results;
}

=head2 GetAge

  $dateofbirth,$date = &GetAge($date);

this function return the borrowers age with the value of dateofbirth

=cut

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

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

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

    my $age = $year2 - $year1;
    if ( $month1 . $day1 > $month2 . $day2 ) {
        $age--;
    }

    return $age;
}    # sub get_age

=head2 SetAge

  $borrower = C4::Members::SetAge($borrower, $datetimeduration);
  $borrower = C4::Members::SetAge($borrower, '0015-12-10');
  $borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);

  eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
  if ($@) {print $@;} #Catch a bad ISO Date or kill your script!

This function sets the borrower's dateofbirth to match the given age.
Optionally relative to the given $datetime_reference.

@PARAM1 koha.borrowers-object
@PARAM2 DateTime::Duration-object as the desired age
        OR a ISO 8601 Date. (To make the API more pleasant)
@PARAM3 DateTime-object as the relative date, defaults to now().
RETURNS The given borrower reference @PARAM1.
DIES    If there was an error with the ISO Date handling.

=cut

#'
sub SetAge{
    my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
    $datetime_ref = DateTime->now() unless $datetime_ref;

    if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
        if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
            $datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
        }
        else {
            die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
        }
    }

    my $new_datetime_ref = $datetime_ref->clone();
    $new_datetime_ref->subtract_duration( $datetimeduration );

    $borrower->{dateofbirth} = $new_datetime_ref->ymd();

    return $borrower;
}    # sub SetAge

=head2 GetHideLostItemsPreference

  $hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);




    return $enrolment_fee || 0;
}

=head3 get_age

my $age = $patron->get_age

Return the age of the patron

=cut

sub get_age {
    my ($self)    = @_;
    my $today_str = dt_from_string->strftime("%Y-%m-%d");
    my $dob_str   = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");

    my ( $dob_y,   $dob_m,   $dob_d )   = split /-/, $dob_str;
    my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;

    my $age = $today_y - $dob_y;
    if ( $dob_m . $dob_d > $today_m . $today_d ) {
        $age--;
    }

    return $age;
}

=head3 type

=cut

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

(-)a/members/memberentry.pl (-1 / +2 lines)
315	}	315	}
316		316
317	if ( $dateofbirth ) {	317	if ( $dateofbirth ) {
318	my $age = GetAge($dateofbirth);	318	my $patron = Koha::Patron->new({ dateofbirth => $dateofbirth });
		319	my $age = $patron->get_age;
319	my $borrowercategory = Koha::Patron::Categories->find($categorycode);	320	my $borrowercategory = Koha::Patron::Categories->find($categorycode);
320	my ($low,$high) = ($borrowercategory->dateofbirthrequired, $borrowercategory->upperagelimit);	321	my ($low,$high) = ($borrowercategory->dateofbirthrequired, $borrowercategory->upperagelimit);
321	if (($high && ($age > $high)) or ($age < $low)) {	322	if (($high && ($age > $high)) or ($age < $low)) {

Lines 236-244 my $overdues_exist = 0; Link Here

(-)a/members/moremember.pl (-3 / +1 lines)
236	my $totalprice = 0;	236	my $totalprice = 0;
237		237
238	# Calculate and display patron's age	238	# Calculate and display patron's age
239	my $dateofbirth = $data->{ 'dateofbirth' };	239	$template->param( age => Koha::Patron->new({ dateofbirth => $data->{dateofbirth} })->get_age );
240	my $age = GetAge($dateofbirth);
241	$template->param( age => $age );
242		240
243	### ###############################################################################	241	### ###############################################################################
244	# BUILD HTML	242	# BUILD HTML




    plan tests => 5;
    ##Testing age restriction for a borrower.
    my $now = DateTime->now();
    my $borrower = { dateofbirth => $now->add( years => -15 )->strftime("%Y-%m-%d") };
    C4::Members::SetAge( $borrower, '0015-00-00' );
    TestPatron($borrower,0);
};



            ##Testing age restriction for a borrower.
            my $now = DateTime->now();
            my $borrower = { dateofbirth => $now->add( years => -15 )->strftime("%Y-%m-%d") };
            C4::Members::SetAge( $borrower, '0015-00-00' );
            TestPatron($borrower,$offset);

            $offset++;




is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving an ageRestricted Biblio without a borrower dateofbirth succeeds" );

#Set the dateofbirth for the Borrower making him "too young".
$borrower->{dateofbirth} = DateTime->now->add( years => -15 );
C4::Members::SetAge( $borrower, '0015-00-00' );
C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );

is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'ageRestricted', "Reserving a 'PEGI 16' Biblio by a 15 year old borrower fails");

#Set the dateofbirth for the Borrower making him "too old".
$borrower->{dateofbirth} = DateTime->now->add( years => -30 );
C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );

is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving a 'PEGI 16' Biblio by a 30 year old borrower succeeds");
- 

Return to bug 17557

Lines 70-77 BEGIN { Link Here

(-)a/C4/Members.pm (-72 lines)
70	&GetFirstValidEmailAddress	70	&GetFirstValidEmailAddress
71	&GetNoticeEmailAddress	71	&GetNoticeEmailAddress
72		72
73	&GetAge
74
75	&GetHideLostItemsPreference	73	&GetHideLostItemsPreference
76		74
77	&GetMemberAccountRecords	75	&GetMemberAccountRecords
Lines 1213-1288 sub GetUpcomingMembershipExpires { Link Here
1213	return $results;	1211	return $results;
1214	}	1212	}
1215		1213
1216	=head2 GetAge
1217
1218	$dateofbirth,$date = &GetAge($date);
1219
1220	this function return the borrowers age with the value of dateofbirth
1221
1222	=cut
1223
1224	#'
1225	sub GetAge{
1226	my ( $date, $date_ref ) = @_;
1227
1228	if ( not defined $date_ref ) {
1229	$date_ref = sprintf( '%04d-%02d-%02d', Today() );
1230	}
1231
1232	my ( $year1, $month1, $day1 ) = split /-/, $date;
1233	my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
1234
1235	my $age = $year2 - $year1;
1236	if ( $month1 . $day1 > $month2 . $day2 ) {
1237	$age--;
1238	}
1239
1240	return $age;
1241	} # sub get_age
1242
1243	=head2 SetAge
1244
1245	$borrower = C4::Members::SetAge($borrower, $datetimeduration);
1246	$borrower = C4::Members::SetAge($borrower, '0015-12-10');
1247	$borrower = C4::Members::SetAge($borrower, $datetimeduration, $datetime_reference);
1248
1249	eval { $borrower = C4::Members::SetAge($borrower, '015-1-10'); };
1250	if ($@) {print $@;} #Catch a bad ISO Date or kill your script!
1251
1252	This function sets the borrower's dateofbirth to match the given age.
1253	Optionally relative to the given $datetime_reference.
1254
1255	@PARAM1 koha.borrowers-object
1256	@PARAM2 DateTime::Duration-object as the desired age
1257	OR a ISO 8601 Date. (To make the API more pleasant)
1258	@PARAM3 DateTime-object as the relative date, defaults to now().
1259	RETURNS The given borrower reference @PARAM1.
1260	DIES If there was an error with the ISO Date handling.
1261
1262	=cut
1263
1264	#'
1265	sub SetAge{
1266	my ( $borrower, $datetimeduration, $datetime_ref ) = @_;
1267	$datetime_ref = DateTime->now() unless $datetime_ref;
1268
1269	if ($datetimeduration && ref $datetimeduration ne 'DateTime::Duration') {
1270	if ($datetimeduration =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1271	$datetimeduration = DateTime::Duration->new(years => $1, months => $2, days => $3);
1272	}
1273	else {
1274	die "C4::Members::SetAge($borrower, $datetimeduration), datetimeduration not a valid ISO 8601 Date!\n";
1275	}
1276	}
1277
1278	my $new_datetime_ref = $datetime_ref->clone();
1279	$new_datetime_ref->subtract_duration( $datetimeduration );
1280
1281	$borrower->{dateofbirth} = $new_datetime_ref->ymd();
1282
1283	return $borrower;
1284	} # sub SetAge
1285
1286	=head2 GetHideLostItemsPreference	1214	=head2 GetHideLostItemsPreference
1287		1215
1288	$hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);	1216	$hidelostitemspref = &GetHideLostItemsPreference($borrowernumber);

Lines 476-481 sub add_enrolment_fee_if_needed { Link Here

(-)a/Koha/Patron.pm (+24 lines)
476	return $enrolment_fee \|\| 0;	476	return $enrolment_fee \|\| 0;
477	}	477	}
478		478
		479	=head3 get_age
		480
		481	my $age = $patron->get_age
		482
		483	Return the age of the patron
		484
		485	=cut
		486
		487	sub get_age {
		488	my ($self) = @_;
		489	my $today_str = dt_from_string->strftime("%Y-%m-%d");
		490	my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
		491
		492	my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
		493	my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
		494
		495	my $age = $today_y - $dob_y;
		496	if ( $dob_m . $dob_d > $today_m . $today_d ) {
		497	$age--;
		498	}
		499
		500	return $age;
		501	}
		502
479	=head3 type	503	=head3 type
480		504
481	=cut	505	=cut

Lines 526-539 C4::Biblio::ModBiblio( $record, $bibnum, '' ); Link Here

(-)a/t/db_dependent/Reserves.t (-4 / +2 lines)
526	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving an ageRestricted Biblio without a borrower dateofbirth succeeds" );	526	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving an ageRestricted Biblio without a borrower dateofbirth succeeds" );
527		527
528	#Set the dateofbirth for the Borrower making him "too young".	528	#Set the dateofbirth for the Borrower making him "too young".
529	my $now = DateTime->now();	529	$borrower->{dateofbirth} = DateTime->now->add( years => -15 );
530	C4::Members::SetAge( $borrower, '0015-00-00' );
531	C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );	530	C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );
532		531
533	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'ageRestricted', "Reserving a 'PEGI 16' Biblio by a 15 year old borrower fails");	532	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'ageRestricted', "Reserving a 'PEGI 16' Biblio by a 15 year old borrower fails");
534		533
535	#Set the dateofbirth for the Borrower making him "too old".	534	#Set the dateofbirth for the Borrower making him "too old".
536	C4::Members::SetAge( $borrower, '0030-00-00' );	535	$borrower->{dateofbirth} = DateTime->now->add( years => -30 );
537	C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );	536	C4::Members::ModMember( borrowernumber => $borrowernumber, dateofbirth => $borrower->{dateofbirth} );
538		537
539	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving a 'PEGI 16' Biblio by a 30 year old borrower succeeds");	538	is( C4::Reserves::CanBookBeReserved($borrowernumber, $biblionumber) , 'OK', "Reserving a 'PEGI 16' Biblio by a 30 year old borrower succeeds");
540	-

Lines 39-46 subtest 'Patron tests - 15 years old' => sub { Link Here

(-)a/t/Circulation/AgeRestrictionMarkers.t (-4 / +2 lines)
39	plan tests => 5;	39	plan tests => 5;
40	##Testing age restriction for a borrower.	40	##Testing age restriction for a borrower.
41	my $now = DateTime->now();	41	my $now = DateTime->now();
42	my $borrower = {};	42	my $borrower = { dateofbirth => $now->add( years => -15 )->strftime("%Y-%m-%d") };
43	C4::Members::SetAge( $borrower, '0015-00-00' );
44	TestPatron($borrower,0);	43	TestPatron($borrower,0);
45	};	44	};
46		45
Lines 57-64 subtest 'Patron tests - 15 years old (Time Zone shifts)' => sub { Link Here
57		56
58	##Testing age restriction for a borrower.	57	##Testing age restriction for a borrower.
59	my $now = DateTime->now();	58	my $now = DateTime->now();
60	my $borrower = {};	59	my $borrower = { dateofbirth => $now->add( years => -15 )->strftime("%Y-%m-%d") };
61	C4::Members::SetAge( $borrower, '0015-00-00' );
62	TestPatron($borrower,$offset);	60	TestPatron($borrower,$offset);
63		61
64	$offset++;	62	$offset++;