|
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 735-740
sub can_see_patron_infos {
Link Here
|
| 735 |
return $can; |
736 |
return $can; |
| 736 |
} |
737 |
} |
| 737 |
|
738 |
|
|
|
739 |
=head3 libraries_where_can_see_patrons |
| 740 |
|
| 741 |
my $libraries = $patron-libraries_where_can_see_patrons; |
| 742 |
|
| 743 |
Return the list of branchcodes(!) of libraries the patron is allowed to see other patron's infos. |
| 744 |
The branchcodes are arbitrarily returned sorted. |
| 745 |
We are supposing here that the object is related to the logged in patron (use of C4::Context::only_my_library) |
| 746 |
|
| 747 |
An empty array means no restriction, the patron can see patron's infos from any libraries. |
| 748 |
|
| 749 |
=cut |
| 750 |
|
| 751 |
sub libraries_where_can_see_patrons { |
| 752 |
my ( $self ) = @_; |
| 753 |
my $userenv = C4::Context->userenv; |
| 754 |
|
| 755 |
return () unless $userenv; # For tests, but userenv should be defined in tests... |
| 756 |
|
| 757 |
my @restricted_branchcodes; |
| 758 |
if (C4::Context::only_my_library) { |
| 759 |
push @restricted_branchcodes, $self->branchcode; |
| 760 |
} |
| 761 |
else { |
| 762 |
unless ( |
| 763 |
$self->can( |
| 764 |
{ borrowers => 'view_borrower_infos_from_any_libraries' } |
| 765 |
) |
| 766 |
) |
| 767 |
{ |
| 768 |
my $library_groups = $self->library->library_groups; |
| 769 |
if ( $library_groups->count ) |
| 770 |
{ |
| 771 |
while ( my $library_group = $library_groups->next ) { |
| 772 |
push @restricted_branchcodes, $library_group->parent->children->get_column('branchcode'); |
| 773 |
} |
| 774 |
} |
| 775 |
else { |
| 776 |
push @restricted_branchcodes, $self->branchcode; |
| 777 |
} |
| 778 |
} |
| 779 |
} |
| 780 |
return sort(uniq(@restricted_branchcodes)); |
| 781 |
} |
| 782 |
|
| 738 |
sub can { |
783 |
sub can { |
| 739 |
my ( $self, $flagsrequired ) = @_; |
784 |
my ( $self, $flagsrequired ) = @_; |
| 740 |
return unless $self->userid; |
785 |
return unless $self->userid; |