Attachment #57219 for bug #17557

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




        &GetFirstValidEmailAddress
        &GetNoticeEmailAddress

        &GetAge
        &GetTitles

        &GetHideLostItemsPreference

    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-76 BEGIN { Link Here

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

Lines 449-454 sub add_enrolment_fee_if_needed { Link Here

(-)a/Koha/Patron.pm (+24 lines)
449	return $enrolment_fee \|\| 0;	449	return $enrolment_fee \|\| 0;
450	}	450	}
451		451
		452	=head3 get_age
		453
		454	my $age = $patron->get_age
		455
		456	Return the age of the patron
		457
		458	=cut
		459
		460	sub get_age {
		461	my ($self) = @_;
		462	my $today_str = dt_from_string->strftime("%Y-%m-%d");
		463	my $dob_str = dt_from_string( $self->dateofbirth )->strftime("%Y-%m-%d");
		464
		465	my ( $dob_y, $dob_m, $dob_d ) = split /-/, $dob_str;
		466	my ( $today_y, $today_m, $today_d ) = split /-/, $today_str;
		467
		468	my $age = $today_y - $dob_y;
		469	if ( $dob_m . $dob_d > $today_m . $today_d ) {
		470	$age--;
		471	}
		472
		473	return $age;
		474	}
		475
452	=head3 type	476	=head3 type
453		477
454	=cut	478	=cut

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

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

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++;