|
Lines 21-26
package Koha::Patron;
Link Here
|
| 21 |
use Modern::Perl; |
21 |
use Modern::Perl; |
| 22 |
|
22 |
|
| 23 |
use Carp; |
23 |
use Carp; |
|
|
24 |
use List::MoreUtils qw( uniq ); |
| 24 |
|
25 |
|
| 25 |
use C4::Context; |
26 |
use C4::Context; |
| 26 |
use C4::Log; |
27 |
use C4::Log; |
|
Lines 610-615
sub can_see_patron_infos {
Link Here
|
| 610 |
return $can; |
611 |
return $can; |
| 611 |
} |
612 |
} |
| 612 |
|
613 |
|
|
|
614 |
=head3 libraries_where_can_see_patrons |
| 615 |
|
| 616 |
my $libraries = $patron-libraries_where_can_see_patrons; |
| 617 |
|
| 618 |
Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos. |
| 619 |
The branchcodes are arbitrarily returned sorted. |
| 620 |
We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library) |
| 621 |
|
| 622 |
An empty array means no restriction, the patron can see patron's infos from any libraries. |
| 623 |
|
| 624 |
=cut |
| 625 |
|
| 626 |
sub libraries_where_can_see_patrons { |
| 627 |
my ( $self ) = @_; |
| 628 |
my $userenv = C4::Context->userenv; |
| 629 |
|
| 630 |
return () unless $userenv; # For tests, but userenv should be defined in tests... |
| 631 |
|
| 632 |
my @restricted_branchcodes; |
| 633 |
if (C4::Context::only_my_library) { |
| 634 |
push @restricted_branchcodes, $self->branchcode; |
| 635 |
} |
| 636 |
else { |
| 637 |
unless ( |
| 638 |
$self->can( |
| 639 |
{ borrowers => 'view_borrower_infos_from_any_libraries' } |
| 640 |
) |
| 641 |
) |
| 642 |
{ |
| 643 |
my $library_groups = $self->library->library_groups; |
| 644 |
if ( $library_groups->count ) |
| 645 |
{ |
| 646 |
while ( my $library_group = $library_groups->next ) { |
| 647 |
push @restricted_branchcodes, $library_group->parent->children->get_column('branchcode'); |
| 648 |
} |
| 649 |
} |
| 650 |
else { |
| 651 |
push @restricted_branchcodes, $self->branchcode; |
| 652 |
} |
| 653 |
} |
| 654 |
} |
| 655 |
return sort(uniq(@restricted_branchcodes)); |
| 656 |
} |
| 657 |
|
| 613 |
sub can { |
658 |
sub can { |
| 614 |
my ( $self, $flagsrequired ) = @_; |
659 |
my ( $self, $flagsrequired ) = @_; |
| 615 |
return unless $self->userid; |
660 |
return unless $self->userid; |