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

(-)a/C4/Acquisition.pm (-2 lines)
Lines 22-32 use Modern::Perl; Link Here
22
use Carp;
22
use Carp;
23
use Text::CSV_XS;
23
use Text::CSV_XS;
24
use C4::Context;
24
use C4::Context;
25
use C4::Debug;
26
use C4::Suggestions;
25
use C4::Suggestions;
27
use C4::Biblio;
26
use C4::Biblio;
28
use C4::Contract;
27
use C4::Contract;
29
use C4::Debug;
30
use C4::Log qw(logaction);
28
use C4::Log qw(logaction);
31
use C4::Templates qw(gettemplate);
29
use C4::Templates qw(gettemplate);
32
use Koha::DateUtils qw( dt_from_string output_pref );
30
use Koha::DateUtils qw( dt_from_string output_pref );
(-)a/C4/Auth_with_cas.pm (-1 lines)
Lines 20-26 package C4::Auth_with_cas; Link Here
20
use strict;
20
use strict;
21
use warnings;
21
use warnings;
22
22
23
use C4::Debug;
24
use C4::Context;
23
use C4::Context;
25
use Koha::AuthUtils qw(get_script_name);
24
use Koha::AuthUtils qw(get_script_name);
26
use Authen::CAS::Client;
25
use Authen::CAS::Client;
(-)a/C4/Auth_with_ldap.pm (-1 lines)
Lines 20-26 package C4::Auth_with_ldap; Link Here
20
use Modern::Perl;
20
use Modern::Perl;
21
use Carp;
21
use Carp;
22
22
23
use C4::Debug;
24
use C4::Context;
23
use C4::Context;
25
use C4::Members::Messaging;
24
use C4::Members::Messaging;
26
use C4::Auth qw(checkpw_internal);
25
use C4::Auth qw(checkpw_internal);
(-)a/C4/Auth_with_shibboleth.pm (-1 lines)
Lines 19-25 package C4::Auth_with_shibboleth; Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use C4::Debug;
23
use C4::Context;
22
use C4::Context;
24
use Koha::AuthUtils qw(get_script_name);
23
use Koha::AuthUtils qw(get_script_name);
25
use Koha::Database;
24
use Koha::Database;
(-)a/C4/Barcodes.pm (-19 / +2 lines)
Lines 23-36 use warnings; Link Here
23
use Carp;
23
use Carp;
24
24
25
use C4::Context;
25
use C4::Context;
26
use C4::Debug;
27
use C4::Barcodes::hbyymmincr;
26
use C4::Barcodes::hbyymmincr;
28
use C4::Barcodes::annual;
27
use C4::Barcodes::annual;
29
use C4::Barcodes::incremental;
28
use C4::Barcodes::incremental;
30
use C4::Barcodes::EAN13;
29
use C4::Barcodes::EAN13;
31
30
32
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
31
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33
use vars qw($debug $cgi_debug);	# from C4::Debug, of course
34
use vars qw($max $prefformat);
32
use vars qw($max $prefformat);
35
33
36
BEGIN {
34
BEGIN {
Lines 73-83 sub value { Link Here
73
	my $self = shift;
71
	my $self = shift;
74
	if (@_) {
72
	if (@_) {
75
		my $value = shift;
73
		my $value = shift;
76
		if (defined $value) {
74
        warn "Error: UNDEF argument to value"
77
			$debug and print STDERR "    setting barcode value to $value\n";
75
            unless defined $value;
78
		} else {
79
			warn "Error: UNDEF argument to value";
80
		}
81
		$self->{value} = $value;
76
		$self->{value} = $value;
82
	}
77
	}
83
	return $self->{value};
78
	return $self->{value};
Lines 96-111 sub parse { # return 3 parts of barcode: non-incrementing, incrementing, non-inc Link Here
96
		carp "Barcode '$barcode' has no incrementing part!";
91
		carp "Barcode '$barcode' has no incrementing part!";
97
		return ($barcode,undef,undef);
92
		return ($barcode,undef,undef);
98
	}
93
	}
99
	$debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
100
	return ($1,$2,'');	# the third part is in anticipation of barcodes that include checkdigits
94
	return ($1,$2,'');	# the third part is in anticipation of barcodes that include checkdigits
101
}
95
}
102
sub max {
96
sub max {
103
	my $self = shift;
97
	my $self = shift;
104
	if ($self->{is_max}) {
98
	if ($self->{is_max}) {
105
		$debug and print STDERR "max taken from Barcodes value $self->value\n";
106
		return $self->value;
99
		return $self->value;
107
	}
100
	}
108
	$debug and print STDERR "Retrieving max database query.\n";
109
	return $self->db_max;
101
	return $self->db_max;
110
}
102
}
111
sub db_max {
103
sub db_max {
Lines 123-129 sub next_value { Link Here
123
		warn "No max barcode ($self->autoBarcode format) found.  Using initial value.";
115
		warn "No max barcode ($self->autoBarcode format) found.  Using initial value.";
124
		return $self->initial;
116
		return $self->initial;
125
	}
117
	}
126
	$debug and print STDERR "(current) max barcode found: $max\n";
127
	my ($head,$incr,$tail) = $self->parse($max);	# for incremental, you'd get ('',the_whole_barcode,'')
118
	my ($head,$incr,$tail) = $self->parse($max);	# for incremental, you'd get ('',the_whole_barcode,'')
128
	unless (defined $incr) {
119
	unless (defined $incr) {
129
		warn "No incrementing part of barcode ($max) returned by parse.";
120
		warn "No incrementing part of barcode ($max) returned by parse.";
Lines 135-145 sub next_value { Link Here
135
		# Those should override next_value() to work accordingly.
126
		# Those should override next_value() to work accordingly.
136
	$incr++;
127
	$incr++;
137
128
138
	$debug and warn "$incr";
139
	$head = $self->process_head($head,$max,$specific);
129
	$head = $self->process_head($head,$max,$specific);
140
    $tail = $self->process_tail($tail,$incr,$specific); # XXX use $incr and not $max!
130
    $tail = $self->process_tail($tail,$incr,$specific); # XXX use $incr and not $max!
141
	my $next_value = $head . $incr . $tail;
131
	my $next_value = $head . $incr . $tail;
142
	$debug and print STDERR "(  next ) max barcode found: $next_value\n";
143
	return $next_value;
132
	return $next_value;
144
}
133
}
145
sub next {
134
sub next {
Lines 183-191 sub new { Link Here
183
	my $class_or_object = shift;
172
	my $class_or_object = shift;
184
	my $type = ref($class_or_object) || $class_or_object;
173
	my $type = ref($class_or_object) || $class_or_object;
185
	my $from_obj = ref($class_or_object) ? 1 : 0;	# are we building off another Barcodes object?
174
	my $from_obj = ref($class_or_object) ? 1 : 0;	# are we building off another Barcodes object?
186
	if ($from_obj) {
187
		$debug and print STDERR "Building new(@_) from old Barcodes object\n"; 
188
	}
189
	my $autoBarcodeType = (@_) ? shift : $from_obj ? $class_or_object->autoBarcode : _prefformat;
175
	my $autoBarcodeType = (@_) ? shift : $from_obj ? $class_or_object->autoBarcode : _prefformat;
190
	$autoBarcodeType =~ s/^.*:://;	# in case we get C4::Barcodes::incremental, we just want 'incremental'
176
	$autoBarcodeType =~ s/^.*:://;	# in case we get C4::Barcodes::incremental, we just want 'incremental'
191
	unless ($autoBarcodeType) {
177
	unless ($autoBarcodeType) {
Lines 196-202 sub new { Link Here
196
		carp "The autoBarcode format '$autoBarcodeType' is unrecognized.";
182
		carp "The autoBarcode format '$autoBarcodeType' is unrecognized.";
197
		return;
183
		return;
198
	}
184
	}
199
	carp "autoBarcode format = $autoBarcodeType" if $debug;
200
	my $self;
185
	my $self;
201
	if ($autoBarcodeType eq 'OFF') {
186
	if ($autoBarcodeType eq 'OFF') {
202
 		$self = $class_or_object->default_self($autoBarcodeType);
187
 		$self = $class_or_object->default_self($autoBarcodeType);
Lines 207-213 sub new { Link Here
207
		$self = $class_or_object->new_object(@_);
192
		$self = $class_or_object->new_object(@_);
208
		$self->serial($class_or_object->serial + 1);
193
		$self->serial($class_or_object->serial + 1);
209
		if ($class_or_object->is_max) {
194
		if ($class_or_object->is_max) {
210
			$debug and print STDERR "old object was max: ", $class_or_object->value, "\n";
211
			$self->previous($class_or_object);
195
			$self->previous($class_or_object);
212
			$class_or_object->next($self);
196
			$class_or_object->next($self);
213
			$self->value($self->next_value($class_or_object->value));
197
			$self->value($self->next_value($class_or_object->value));
Lines 216-222 sub new { Link Here
216
			$self->value($self->next_value);
200
			$self->value($self->next_value);
217
		}
201
		}
218
	} else {
202
	} else {
219
		$debug and print STDERR "trying to create new $autoBarcodeType\n";
220
		$self = &{$types->{$autoBarcodeType}} (@_);
203
		$self = &{$types->{$autoBarcodeType}} (@_);
221
		$self->value($self->next_value) and $self->is_max(1);
204
		$self->value($self->next_value) and $self->is_max(1);
222
		$self->serial(1);
205
		$self->serial(1);
(-)a/C4/Barcodes/EAN13.pm (-3 lines)
Lines 21-33 use strict; Link Here
21
use warnings;
21
use warnings;
22
22
23
use C4::Context;
23
use C4::Context;
24
use C4::Debug;
25
24
26
use Algorithm::CheckDigits;
25
use Algorithm::CheckDigits;
27
use Carp;
26
use Carp;
28
27
29
use vars qw(@ISA);
28
use vars qw(@ISA);
30
use vars qw($debug $cgi_debug);	# from C4::Debug, of course
31
29
32
BEGIN {
30
BEGIN {
33
    @ISA = qw(C4::Barcodes);
31
    @ISA = qw(C4::Barcodes);
Lines 50-56 sub process_tail { Link Here
50
    my $ean = CheckDigits('ean');
48
    my $ean = CheckDigits('ean');
51
    my $full = $ean->complete($whole);
49
    my $full = $ean->complete($whole);
52
    my $chk  = $ean->checkdigit($full);
50
    my $chk  = $ean->checkdigit($full);
53
    $debug && warn "# process_tail $tail -> $chk [$whole -> $full] $specific";
54
    return $chk;
51
    return $chk;
55
}
52
}
56
53
(-)a/C4/Barcodes/annual.pm (-4 lines)
Lines 23-34 use warnings; Link Here
23
use Carp;
23
use Carp;
24
24
25
use C4::Context;
25
use C4::Context;
26
use C4::Debug;
27
26
28
use Koha::DateUtils qw( output_pref dt_from_string );
27
use Koha::DateUtils qw( output_pref dt_from_string );
29
28
30
use vars qw(@ISA);
29
use vars qw(@ISA);
31
use vars qw($debug $cgi_debug);	# from C4::Debug, of course
32
use vars qw($width);
30
use vars qw($width);
33
31
34
BEGIN {
32
BEGIN {
Lines 55-61 sub db_max { Link Here
55
	my $year = substr($iso,0,4);	# YYYY
53
	my $year = substr($iso,0,4);	# YYYY
56
	$sth->execute("$year-%");
54
	$sth->execute("$year-%");
57
	my $row = $sth->fetchrow_hashref;
55
	my $row = $sth->fetchrow_hashref;
58
	warn "barcode db_max (annual format, year $year): $row->{barcode}" if $debug;
59
	return $row->{barcode};
56
	return $row->{barcode};
60
}
57
}
61
58
Lines 71-77 sub parse { Link Here
71
		carp "Barcode '$barcode' has no incrementing part!";
68
		carp "Barcode '$barcode' has no incrementing part!";
72
		return ($barcode,undef,undef);
69
		return ($barcode,undef,undef);
73
	}
70
	}
74
	$debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
75
	return ($1,$2,'');  # the third part is in anticipation of barcodes that include checkdigits
71
	return ($1,$2,'');  # the third part is in anticipation of barcodes that include checkdigits
76
}
72
}
77
sub width {
73
sub width {
(-)a/C4/Barcodes/hbyymmincr.pm (-10 lines)
Lines 22-35 use Modern::Perl; Link Here
22
use Carp;
22
use Carp;
23
23
24
use C4::Context;
24
use C4::Context;
25
use C4::Debug;
26
25
27
use Koha::DateUtils qw( dt_from_string output_pref );
26
use Koha::DateUtils qw( dt_from_string output_pref );
28
27
29
use constant WIDTH => 4; # FIXME: too small for sizeable or multi-branch libraries?
28
use constant WIDTH => 4; # FIXME: too small for sizeable or multi-branch libraries?
30
29
31
use vars qw(@ISA);
30
use vars qw(@ISA);
32
use vars qw($debug $cgi_debug);	# from C4::Debug, of course
33
31
34
BEGIN {
32
BEGIN {
35
    @ISA = qw(C4::Barcodes);
33
    @ISA = qw(C4::Barcodes);
Lines 42-48 sub db_max { Link Here
42
	my $self = shift;
40
	my $self = shift;
43
    my $width = WIDTH;
41
    my $width = WIDTH;
44
    my $query = "SELECT SUBSTRING(barcode,-$width) AS chunk, barcode FROM items WHERE barcode REGEXP ? ORDER BY chunk DESC LIMIT 1";
42
    my $query = "SELECT SUBSTRING(barcode,-$width) AS chunk, barcode FROM items WHERE barcode REGEXP ? ORDER BY chunk DESC LIMIT 1";
45
	$debug and print STDERR "(hbyymmincr) db_max query: $query\n";
46
	my $sth = C4::Context->dbh->prepare($query);
43
	my $sth = C4::Context->dbh->prepare($query);
47
	my ($iso);
44
	my ($iso);
48
        if (@_) {
45
        if (@_) {
Lines 64-70 sub db_max { Link Here
64
	}
61
	}
65
	my ($row) = $sth->fetchrow_hashref;
62
	my ($row) = $sth->fetchrow_hashref;
66
	my $max = $row->{barcode};
63
	my $max = $row->{barcode};
67
	warn "barcode max (hbyymmincr format): $max" if $debug;
68
	return ($max || 0);
64
	return ($max || 0);
69
}
65
}
70
66
Lines 85-91 sub parse { # return 3 parts of barcode: non-incrementing, incrementing, non-i Link Here
85
		carp "Barcode '$barcode' has no incrementing part!";
81
		carp "Barcode '$barcode' has no incrementing part!";
86
		return ($barcode,undef,undef);
82
		return ($barcode,undef,undef);
87
	}
83
	}
88
	$debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''";
89
	return ($1,$2,'');  # the third part is in anticipation of barcodes that include checkdigits
84
	return ($1,$2,'');  # the third part is in anticipation of barcodes that include checkdigits
90
}
85
}
91
86
Lines 111-117 sub process_head { # (self,head,whole,specific) Link Here
111
}
106
}
112
107
113
sub new_object {
108
sub new_object {
114
    $debug and warn "hbyymmincr: new_object called";
115
    my $class_or_object = shift;
109
    my $class_or_object = shift;
116
110
117
    my $type = ref($class_or_object) || $class_or_object;
111
    my $type = ref($class_or_object) || $class_or_object;
Lines 127-136 sub new_object { Link Here
127
    $self->branch( @_ ? shift : $from_obj ? $class_or_object->branch : '' );
121
    $self->branch( @_ ? shift : $from_obj ? $class_or_object->branch : '' );
128
    warn "HBYYMM Barcode created with no branchcode, default is blank" if ( $self->branch() eq '' );
122
    warn "HBYYMM Barcode created with no branchcode, default is blank" if ( $self->branch() eq '' );
129
123
130
    # take the branch from argument, or existing object, or default
131
    use Data::Dumper;
132
    $debug and print STDERR "(hbyymmincr) new_object: ", Dumper($self), "\n";
133
134
    return $self;
124
    return $self;
135
}
125
}
136
126
(-)a/C4/Biblio.pm (-5 / +2 lines)
Lines 92-99 use C4::ClassSource; Link Here
92
use C4::Charset;
92
use C4::Charset;
93
use C4::Linker;
93
use C4::Linker;
94
use C4::OAI::Sets;
94
use C4::OAI::Sets;
95
use C4::Debug;
96
95
96
use Koha::Logger;
97
use Koha::Caches;
97
use Koha::Caches;
98
use Koha::Authority::Types;
98
use Koha::Authority::Types;
99
use Koha::Acquisition::Currencies;
99
use Koha::Acquisition::Currencies;
Lines 106-114 use Koha::SearchEngine::Indexer; Link Here
106
use Koha::Libraries;
106
use Koha::Libraries;
107
use Koha::Util::MARC;
107
use Koha::Util::MARC;
108
108
109
use vars qw($debug $cgi_debug);
110
111
112
=head1 NAME
109
=head1 NAME
113
110
114
C4::Biblio - cataloging management functions
111
C4::Biblio - cataloging management functions
Lines 2498-2504 $server is authorityserver or biblioserver Link Here
2498
2495
2499
sub ModZebra {
2496
sub ModZebra {
2500
    my ( $record_number, $op, $server ) = @_;
2497
    my ( $record_number, $op, $server ) = @_;
2501
    $debug && warn "ModZebra: updates requested for: $record_number $op $server\n";
2498
    Koha::Logger->get->debug("ModZebra: updates requested for: $record_number $op $server");
2502
    my $dbh = C4::Context->dbh;
2499
    my $dbh = C4::Context->dbh;
2503
2500
2504
    # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2501
    # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
(-)a/C4/Budgets.pm (-2 lines)
Lines 22-28 use C4::Context; Link Here
22
use Koha::Database;
22
use Koha::Database;
23
use Koha::Patrons;
23
use Koha::Patrons;
24
use Koha::Acquisition::Invoice::Adjustments;
24
use Koha::Acquisition::Invoice::Adjustments;
25
use C4::Debug;
26
use C4::Acquisition;
25
use C4::Acquisition;
27
use vars qw(@ISA @EXPORT);
26
use vars qw(@ISA @EXPORT);
28
27
Lines 510-516 sub GetBudgetHierarchy { Link Here
510
        }
509
        }
511
    }
510
    }
512
	$query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
511
	$query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
513
	$debug && warn $query,join(",",@bind_params);
514
	my $sth = $dbh->prepare($query);
512
	my $sth = $dbh->prepare($query);
515
	$sth->execute(@bind_params);
513
	$sth->execute(@bind_params);
516
514
(-)a/C4/Charset.pm (-4 / +4 lines)
Lines 17-31 package C4::Charset; Link Here
17
# You should have received a copy of the GNU General Public License
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
19
20
use strict;
20
use Modern::Perl;
21
use warnings;
22
21
23
use MARC::Charset qw/marc8_to_utf8/;
22
use MARC::Charset qw/marc8_to_utf8/;
24
use Text::Iconv;
23
use Text::Iconv;
25
use C4::Debug;
26
use Unicode::Normalize;
24
use Unicode::Normalize;
27
use Encode qw( decode encode is_utf8 );
25
use Encode qw( decode encode is_utf8 );
28
26
27
use Koha::Logger;
28
29
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
29
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
30
30
31
BEGIN {
31
BEGIN {
Lines 353-359 sub SetMarcUnicodeFlag { Link Here
353
            $marc_record->insert_grouped_field( 
353
            $marc_record->insert_grouped_field( 
354
                MARC::Field->new( 100, '', '', "a" => $string ) ); 
354
                MARC::Field->new( 100, '', '', "a" => $string ) ); 
355
        }
355
        }
356
		$debug && warn "encodage: ", substr( $marc_record->subfield(100, 'a'), $encodingposition, 3 );
356
        Koha::Logger->get->debug("encodage: ", substr( $marc_record->subfield(100, 'a'), $encodingposition, 3 ));
357
    } else {
357
    } else {
358
        warn "Unrecognized marcflavour: $marc_flavour";
358
        warn "Unrecognized marcflavour: $marc_flavour";
359
    }
359
    }
(-)a/C4/Circulation.pm (-3 lines)
Lines 34-40 use C4::Members; Link Here
34
use C4::Accounts;
34
use C4::Accounts;
35
use C4::ItemCirculationAlertPreference;
35
use C4::ItemCirculationAlertPreference;
36
use C4::Message;
36
use C4::Message;
37
use C4::Debug;
38
use C4::Log; # logaction
37
use C4::Log; # logaction
39
use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
38
use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
40
use C4::RotatingCollections qw(GetCollectionItemBranches);
39
use C4::RotatingCollections qw(GetCollectionItemBranches);
Lines 2293-2300 sub AddReturn { Link Here
2293
            (C4::Context->preference("UseBranchTransferLimits") and
2292
            (C4::Context->preference("UseBranchTransferLimits") and
2294
             ! IsBranchTransferAllowed($branch, $returnbranch, $item->$BranchTransferLimitsType )
2293
             ! IsBranchTransferAllowed($branch, $returnbranch, $item->$BranchTransferLimitsType )
2295
           )) {
2294
           )) {
2296
            $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s, %s)", $item->itemnumber,$branch, $returnbranch, $transfer_trigger;
2297
            $debug and warn "item: " . Dumper($item->unblessed);
2298
            ModItemTransfer($item->itemnumber, $branch, $returnbranch, $transfer_trigger, { skip_record_index => 1 });
2295
            ModItemTransfer($item->itemnumber, $branch, $returnbranch, $transfer_trigger, { skip_record_index => 1 });
2299
            $messages->{'WasTransfered'} = $returnbranch;
2296
            $messages->{'WasTransfered'} = $returnbranch;
2300
            $messages->{'TransferTrigger'} = $transfer_trigger;
2297
            $messages->{'TransferTrigger'} = $transfer_trigger;
(-)a/C4/ClassSplitRoutine/Dewey.pm (-3 lines)
Lines 19-26 package C4::ClassSplitRoutine::Dewey; Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use C4::Debug;
23
24
=head1 NAME
22
=head1 NAME
25
23
26
C4::ClassSplitRoutine::Dewey - Dewey call number split method
24
C4::ClassSplitRoutine::Dewey - Dewey call number split method
Lines 66-72 sub split_callnumber { Link Here
66
    push @lines, split /\s+/,
64
    push @lines, split /\s+/,
67
      pop @lines
65
      pop @lines
68
      ;    # split the last piece into an arbitrary number of pieces at spaces
66
      ;    # split the last piece into an arbitrary number of pieces at spaces
69
    $debug and print STDERR "split_ddcn array: ", join( " | ", @lines ), "\n";
70
    return @lines;
67
    return @lines;
71
}
68
}
72
69
(-)a/C4/ClassSplitRoutine/Generic.pm (-3 lines)
Lines 19-26 package C4::ClassSplitRoutine::Generic; Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use C4::Debug;
23
24
=head1 NAME
22
=head1 NAME
25
23
26
C4::ClassSplitRoutine::Generic - generic call number sorting key routine
24
C4::ClassSplitRoutine::Generic - generic call number sorting key routine
Lines 58-64 sub split_callnumber { Link Here
58
        warn sprintf( 'regexp failed to match string: %s', $cn_item );
56
        warn sprintf( 'regexp failed to match string: %s', $cn_item );
59
        push( @lines, $cn_item );
57
        push( @lines, $cn_item );
60
    }
58
    }
61
    $debug and print STDERR "split_ccn array: ", join( " | ", @lines ), "\n";
62
59
63
    return @lines;
60
    return @lines;
64
}
61
}
(-)a/C4/ClassSplitRoutine/LCC.pm (-3 / +2 lines)
Lines 20-26 package C4::ClassSplitRoutine::LCC; Link Here
20
use Modern::Perl;
20
use Modern::Perl;
21
use Library::CallNumber::LC;
21
use Library::CallNumber::LC;
22
22
23
use C4::Debug;
23
use Koha::Logger;
24
24
25
=head1 NAME
25
=head1 NAME
26
26
Lines 45-56 sub split_callnumber { Link Here
45
    # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
45
    # lccn examples: 'HE8700.7 .P6T44 1983', 'BS2545.E8 H39 1996';
46
    my @lines = Library::CallNumber::LC->new($cn_item)->components();
46
    my @lines = Library::CallNumber::LC->new($cn_item)->components();
47
    unless (scalar @lines && defined $lines[0])  {
47
    unless (scalar @lines && defined $lines[0])  {
48
        $debug and warn sprintf('regexp failed to match string: %s', $cn_item);
48
        Koha::Logger->get->debug(sprintf('regexp failed to match string: %s', $cn_item));
49
        @lines = $cn_item;     # if no match, just use the whole string.
49
        @lines = $cn_item;     # if no match, just use the whole string.
50
    }
50
    }
51
    my $LastPiece = pop @lines;
51
    my $LastPiece = pop @lines;
52
    push @lines, split /\s+/, $LastPiece if $LastPiece;   # split the last piece into an arbitrary number of pieces at spaces
52
    push @lines, split /\s+/, $LastPiece if $LastPiece;   # split the last piece into an arbitrary number of pieces at spaces
53
    $debug and warn "split LCC array: ", join(" | ", @lines), "\n";
54
    return @lines;
53
    return @lines;
55
}
54
}
56
55
(-)a/C4/ClassSplitRoutine/RegEx.pm (-2 lines)
Lines 19-26 package C4::ClassSplitRoutine::RegEx; Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use C4::Debug;
23
24
=head1 NAME
22
=head1 NAME
25
23
26
C4::ClassSplitRoutine::RegEx - regex call number sorting key routine
24
C4::ClassSplitRoutine::RegEx - regex call number sorting key routine
(-)a/C4/Context.pm (-1 lines)
Lines 44-50 use POSIX (); Link Here
44
use YAML::XS;
44
use YAML::XS;
45
use ZOOM;
45
use ZOOM;
46
46
47
use C4::Debug;
48
use Koha::Caches;
47
use Koha::Caches;
49
use Koha::Config::SysPref;
48
use Koha::Config::SysPref;
50
use Koha::Config::SysPrefs;
49
use Koha::Config::SysPrefs;
(-)a/C4/Creators/Batch.pm (-2 lines)
Lines 6-13 use warnings; Link Here
6
use autouse 'Data::Dumper' => qw(Dumper);
6
use autouse 'Data::Dumper' => qw(Dumper);
7
7
8
use C4::Context;
8
use C4::Context;
9
use C4::Debug;
10
11
9
12
sub _check_params {
10
sub _check_params {
13
    my $given_params = {};
11
    my $given_params = {};
(-)a/C4/Creators/Layout.pm (-2 lines)
Lines 6-15 use warnings; Link Here
6
use autouse 'Data::Dumper' => qw(Dumper);
6
use autouse 'Data::Dumper' => qw(Dumper);
7
7
8
use C4::Context;
8
use C4::Context;
9
use C4::Debug;
10
use C4::Creators::PDF;
9
use C4::Creators::PDF;
11
10
12
13
# FIXME: Consider this style parameter verification instead...
11
# FIXME: Consider this style parameter verification instead...
14
#  my %param = @_;
12
#  my %param = @_;
15
#   for (keys %param)
13
#   for (keys %param)
(-)a/C4/Creators/Lib.pm (-2 lines)
Lines 23-29 use Storable qw(dclone); Link Here
23
use autouse 'Data::Dumper' => qw(Dumper);
23
use autouse 'Data::Dumper' => qw(Dumper);
24
24
25
use C4::Context;
25
use C4::Context;
26
use C4::Debug;
27
26
28
BEGIN {
27
BEGIN {
29
    use base qw(Exporter);
28
    use base qw(Exporter);
Lines 266-272 sub get_all_image_names { Link Here
266
    my $image_names = [];
265
    my $image_names = [];
267
    my $query = "SELECT image_name FROM creator_images";
266
    my $query = "SELECT image_name FROM creator_images";
268
    my $sth = C4::Context->dbh->prepare($query);
267
    my $sth = C4::Context->dbh->prepare($query);
269
#    $sth->{'TraceLevel'} = 3 if $debug;
270
    $sth->execute();
268
    $sth->execute();
271
    if ($sth->err) {
269
    if ($sth->err) {
272
        warn sprintf('Database returned the following error: %s', $sth->errstr);
270
        warn sprintf('Database returned the following error: %s', $sth->errstr);
(-)a/C4/Creators/Profile.pm (-1 lines)
Lines 6-12 use warnings; Link Here
6
use autouse 'Data::Dumper' => qw(Dumper);
6
use autouse 'Data::Dumper' => qw(Dumper);
7
7
8
use C4::Context;
8
use C4::Context;
9
use C4::Debug;
10
use C4::Creators::Lib qw(get_unit_values);
9
use C4::Creators::Lib qw(get_unit_values);
11
10
12
11
(-)a/C4/Creators/Template.pm (-1 lines)
Lines 6-12 use POSIX qw(ceil); Link Here
6
use autouse 'Data::Dumper' => qw(Dumper);
6
use autouse 'Data::Dumper' => qw(Dumper);
7
7
8
use C4::Context;
8
use C4::Context;
9
use C4::Debug;
10
use C4::Creators::Profile;
9
use C4::Creators::Profile;
11
use C4::Creators::Lib qw(get_unit_values);
10
use C4::Creators::Lib qw(get_unit_values);
12
11
(-)a/C4/Debug.pm (-183 lines)
Lines 1-183 Link Here
1
package C4::Debug;
2
3
# Copyright 2000-2002 Katipo Communications
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use strict;
21
use warnings;
22
23
use Exporter;
24
25
# use CGI qw ( -utf8 );
26
use vars qw(@ISA @EXPORT $debug $cgi_debug);
27
# use vars qw(@EXPORT_OK %EXPORT_TAGS);
28
29
BEGIN {
30
	@ISA       = qw(Exporter);
31
	@EXPORT    = qw($debug $cgi_debug);
32
	# @EXPOR_OK    = qw();
33
	# %EXPORT_TAGS = ( all=>[qw($debug $cgi_debug)], );
34
}
35
36
BEGIN {
37
	# this stuff needs a begin block too, since dependencies might alter their compilations
38
	# for example, adding DataDumper
39
40
	$debug = $ENV{KOHA_DEBUG} || $ENV{DEBUG} || 0;
41
42
	# CGI->new conflicts w/ some upload functionality, 
43
	# since we would get the "first" CGI object here.
44
	# Instead we have to parse for ourselves if we want QUERY_STRING triggers.
45
	#	my $query = CGI->new();		# conflicts!
46
	#	$cgi_debug = $ENV{KOHA_CGI_DEBUG} || $query->param('debug') || 0;
47
48
	$cgi_debug = $ENV{KOHA_CGI_DEBUG} || 0;
49
	unless ($cgi_debug or not $ENV{QUERY_STRING}) {
50
		foreach (split /\&/,  $ENV{QUERY_STRING}) {
51
			/^debug\=(.+)$/ or next;
52
			$cgi_debug = $1;
53
			last;
54
		}
55
	}
56
	unless ($debug =~ /^\d$/) {
57
		warn "Invalid \$debug value attempted: $debug";
58
		$debug=1;
59
	}
60
	unless ($cgi_debug =~ /^\d$/) {
61
		$debug and
62
		warn "Invalid \$cgi_debug value attempted: $cgi_debug";
63
		$cgi_debug=1;
64
	}
65
}
66
67
# sub import {
68
# 	print STDERR __PACKAGE__ . " (Debug) import @_\n";
69
# 	C4::Debug->export_to_level(1, @_);
70
# }
71
72
1;
73
__END__
74
75
=head1 NAME 
76
77
C4::Debug - Standardized, centralized, exported debug switches.
78
79
=head1 SYNOPSIS
80
81
	use C4::Debug;
82
83
=head1 DESCRIPTION
84
85
The purpose of this module is to centralize some of the "switches" that turn debugging
86
off and on in Koha.  Most often, this functionality will be provided via C4::Context.
87
C4::Debug is separate to preserve the relatively stable state of Context, and 
88
because other code will use C4::Debug without invoking Context.
89
90
Although centralization is our intention, 
91
for logical and security reasons, several approaches to debugging need to be 
92
kept separate.  Information useful to developers in one area will not necessarily
93
be useful or even available to developers in another area. 
94
95
For example, the designer of template-influenced javascript my want to be able to
96
trigger javascript's alert function to display certain variable values, to verify
97
the template selection is being performed correctly.  For this purpose the presence
98
of a javascript "debug" variable might be a good switch.  
99
100
Meanwhile, where security coders (say, for LDAP Auth) will appreciate low level feedback about
101
Authentication transactions, an environmental system variable might be a good switch.  
102
However, clearly we would not want to expose that same information (e.g., entire LDAP records)
103
to the web interface based on a javascript variable (even if it were possible)!  
104
105
All that is a long way of saying THERE ARE SECURITY IMPLICATIONS to turning on 
106
debugging in various parts of the system, so don't treat them all the same or confuse them.
107
108
=head1 VARIABLES / AREAS
109
110
=head2 $debug - System, general
111
The general purpose debug switch.  
112
113
=head3 How to Set $debug:
114
115
=over
116
117
=item environmental variable DEBUG or KOHA_DEBUG.  In bash, you might do:
118
119
	export KOHA_DEBUG=1;
120
	perl t/Auth.t;
121
122
=item Keep in mind that your webserver will not be running in the same environment as your shell.
123
However, for development purposes, the same effect can be had by using Apache's SET_ENV
124
command with ERROR_LOG enabled for your VirtualHost.  Not intended for production systems.
125
126
=item You can force the value from perl directly, like:
127
128
	use C4::Debug;
129
	BEGIN { $C4::Debug::debug = 1; }
130
	# now any other dependencies that also use C4::Debug will have debugging ON.
131
132
=back
133
134
=head2 $cgi_debug (CGI params) The web-based debug switch.
135
136
=head3 How to Set $cgi_debug:
137
138
=over
139
140
=item From a web browser, for example by supplying a non-zero debug parameter (1 to 9):
141
142
	http://www.mylibrary.org/cgi-bin/koha/opac-search.pl?q=history&debug=1
143
144
=item Or in HTML, add a similar input parameter:
145
146
	<input type="hidden" name="debug" value="1" />
147
148
=item Or from shell (or Apache), set KOHA_CGI_DEBUG.
149
150
=back 
151
152
The former methods mean $cgi_debug is exposed.  Do NOT use it to trigger any actions that you would
153
not allow a (potentially anonymous) end user to perform.  Dumping sensitive data, directory listings, or 
154
emailing yourself a test message would all be bad actions to tie to $cgi_debug.
155
156
=head1 OTHER SOURCES of Debug Switches
157
158
=head2 System Preferences
159
160
=cut
161
162
=head2 Database Debug
163
164
Debugging at the database level might be useful.  Koha does not currently integrate any such 
165
capability.
166
167
=head1 CONVENTIONS
168
169
Debug values range from 0 to 9.  At zero (the default), debugging is off.  
170
171
=head1 AUTHOR
172
173
Joe Atzberger
174
atz AT liblime DOT com
175
176
=head1 SEE ALSO
177
178
CGI(3)
179
180
C4::Context
181
182
=cut
183
(-)a/C4/External/BakerTaylor.pm (-3 lines)
Lines 23-29 use LWP::Simple; Link Here
23
use HTTP::Request::Common;
23
use HTTP::Request::Common;
24
24
25
use C4::Context;
25
use C4::Context;
26
use C4::Debug;
27
26
28
use Modern::Perl;
27
use Modern::Perl;
29
28
Lines 91-99 sub availability { Link Here
91
	($user and $pass) or return;
90
	($user and $pass) or return;
92
	$isbn =~ s/(p|-)//g;	# sanitize
91
	$isbn =~ s/(p|-)//g;	# sanitize
93
    my $url = "https://contentcafe2.btol.com/ContentCafe/InventoryAvailability.asmx/CheckInventory?UserID=$user&Password=$pass&Value=$isbn";
92
    my $url = "https://contentcafe2.btol.com/ContentCafe/InventoryAvailability.asmx/CheckInventory?UserID=$user&Password=$pass&Value=$isbn";
94
	$debug and warn __PACKAGE__ . " request:\n$url\n";
95
	my $content = get($url);
93
	my $content = get($url);
96
	$debug and print STDERR $content, "\n";
97
	warn "could not retrieve $url" unless $content;
94
	warn "could not retrieve $url" unless $content;
98
	my $xmlsimple = XML::Simple->new();
95
	my $xmlsimple = XML::Simple->new();
99
	my $result = $xmlsimple->XMLin($content);
96
	my $result = $xmlsimple->XMLin($content);
(-)a/C4/Form/MessagingPreferences.pm (-1 lines)
Lines 23-29 use warnings; Link Here
23
use CGI qw ( -utf8 );
23
use CGI qw ( -utf8 );
24
use C4::Context;
24
use C4::Context;
25
use C4::Members::Messaging;
25
use C4::Members::Messaging;
26
use C4::Debug;
27
26
28
use constant MAX_DAYS_IN_ADVANCE => 30;
27
use constant MAX_DAYS_IN_ADVANCE => 30;
29
28
(-)a/C4/ImportExportFramework.pm (-14 / +12 lines)
Lines 27-34 use Text::CSV_XS; Link Here
27
use List::MoreUtils qw(indexes);
27
use List::MoreUtils qw(indexes);
28
28
29
use C4::Context;
29
use C4::Context;
30
use C4::Debug;
30
use Koha::Logger;
31
32
31
33
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
32
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
34
33
Lines 226-232 sub ExportFramework Link Here
226
                }
225
                }
227
            };
226
            };
228
            if ($@) {
227
            if ($@) {
229
                $debug and warn "Error ExportFramework $@\n";
228
                Koha::Logger->get->warn("Error ExportFramework $@");
230
                return 0;
229
                return 0;
231
            }
230
            }
232
        }
231
        }
Lines 298-304 sub _export_table_csv Link Here
298
        $$strCSV .= chr(10);
297
        $$strCSV .= chr(10);
299
    };
298
    };
300
    if ($@) {
299
    if ($@) {
301
        $debug and warn "Error _export_table_csv $@\n";
300
        Koha::Logger->get->warn("Error _export_table_csv $@");
302
        return 0;
301
        return 0;
303
    }
302
    }
304
    return 1;
303
    return 1;
Lines 364-370 sub _export_table_ods Link Here
364
        }
363
        }
365
    };
364
    };
366
    if ($@) {
365
    if ($@) {
367
        $debug and warn "Error _export_table_ods $@\n";
366
        Koha::Logger->get->warn("Error _export_table_ods $@");
368
        return 0;
367
        return 0;
369
    }
368
    }
370
    return 1;
369
    return 1;
Lines 429-435 sub _export_table_excel Link Here
429
        }
428
        }
430
    };
429
    };
431
    if ($@) {
430
    if ($@) {
432
        $debug and warn "Error _export_table_excel $@\n";
431
        Koha::Logger->get->warn("Error _export_table_excel $@");
433
        return 0;
432
        return 0;
434
    }
433
    }
435
    return 1;
434
    return 1;
Lines 551-557 sub createODS Link Here
551
            }
550
            }
552
        };
551
        };
553
        if ($@) {
552
        if ($@) {
554
            $debug and warn "Error createODS $@\n";
553
            Koha::Logger->get->warn("Error createODS $@");
555
        } else {
554
        } else {
556
            # create ods file from tempdir directory
555
            # create ods file from tempdir directory
557
            eval {
556
            eval {
Lines 676-686 sub ImportFramework Link Here
676
                        }
675
                        }
677
                    }
676
                    }
678
                } else {
677
                } else {
679
                    $debug and warn "Error ImportFramework couldn't create dom\n";
678
                    Koha::Logger->get->warn("Error ImportFramework couldn't create dom");
680
                }
679
                }
681
            };
680
            };
682
            if ($@) {
681
            if ($@) {
683
                $debug and warn "Error ImportFramework $@\n";
682
                Koha::Logger->get->warn("Error ImportFramework $@");
684
            } else {
683
            } else {
685
                if ($extension eq 'csv') {
684
                if ($extension eq 'csv') {
686
                    close($dom) if ($dom);
685
                    close($dom) if ($dom);
Lines 689-695 sub ImportFramework Link Here
689
        }
688
        }
690
        unlink ($filename) if ($deleteFilename); # remove temporary file
689
        unlink ($filename) if ($deleteFilename); # remove temporary file
691
    } else {
690
    } else {
692
        $debug and warn "Error ImportFramework no conex to database or not readeable $filename\n";
691
        Koha::Logger->get->warn("Error ImportFramework no conex to database or not readeable $filename");
693
    }
692
    }
694
    if ($deleteFilename && $tempdir && -d $tempdir && -w $tempdir) {
693
    if ($deleteFilename && $tempdir && -d $tempdir && -w $tempdir) {
695
        eval {
694
        eval {
Lines 860-867 sub _processRow_DB Link Here
860
        $sth->execute((@$dataFields, @$dataFields));
859
        $sth->execute((@$dataFields, @$dataFields));
861
    };
860
    };
862
    if ($@) {
861
    if ($@) {
863
        warn $@;
862
        Koha::Logger->get->warn("Error _processRow_DB $@");
864
        $debug and warn "Error _processRow_DB $@\n";
865
    } else {
863
    } else {
866
        $ok = 1;
864
        $ok = 1;
867
    }
865
    }
Lines 1011-1017 sub _import_table_ods Link Here
1011
        my $nodeR = $nodes[0]->firstChild;
1009
        my $nodeR = $nodes[0]->firstChild;
1012
        return _processRows_Table($dbh, $frameworkcode, $nodeR, $table, $PKArray, 'ods', $fields2Delete);
1010
        return _processRows_Table($dbh, $frameworkcode, $nodeR, $table, $PKArray, 'ods', $fields2Delete);
1013
    } else {
1011
    } else {
1014
        $debug and warn "Error _import_table_ods there's not worksheet for $table\n";
1012
        Koha::Logger->get->warn("Error _import_table_ods there's not worksheet for $table");
1015
    }
1013
    }
1016
    return 0;
1014
    return 0;
1017
}#_import_table_ods
1015
}#_import_table_ods
Lines 1037-1043 sub _import_table_excel Link Here
1037
            }
1035
            }
1038
        }
1036
        }
1039
    } else {
1037
    } else {
1040
        $debug and warn "Error _import_table_excel there's not worksheet for $table\n";
1038
        Koha::Logger->get->warn("Error _import_table_excel there's not worksheet for $table");
1041
    }
1039
    }
1042
    return 0;
1040
    return 0;
1043
}#_import_table_excel
1041
}#_import_table_excel
(-)a/C4/Labels/Label.pm (-4 lines)
Lines 10-16 use Data::Dumper; Link Here
10
use Text::Bidi qw( log2vis );
10
use Text::Bidi qw( log2vis );
11
11
12
use C4::Context;
12
use C4::Context;
13
use C4::Debug;
14
use C4::Biblio;
13
use C4::Biblio;
15
use Koha::ClassSources;
14
use Koha::ClassSources;
16
use Koha::ClassSortRules;
15
use Koha::ClassSortRules;
Lines 153-160 sub _get_barcode_data { Link Here
153
            for my $field ( @fields ) {
152
            for my $field ( @fields ) {
154
                if ($item->{$field}) {
153
                if ($item->{$field}) {
155
                    push @data, $item->{$field};
154
                    push @data, $item->{$field};
156
                } else {
157
                    $debug and warn sprintf("The '%s' field contains no data.", $field);
158
                }
155
                }
159
            }
156
            }
160
            $datastring .= join ' ', @data;
157
            $datastring .= join ' ', @data;
Lines 241-247 sub _BIBBAR { Link Here
241
    my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
238
    my $barcode_y_scale_factor = 0.01 * $self->{'height'};              # this scales the barcode height to 10% of the label height
242
    my $line_spacer = ($self->{'font_size'} * 1);       # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.).
239
    my $line_spacer = ($self->{'font_size'} * 1);       # number of pixels between text rows (This is actually leading: baseline to baseline minus font size. Recommended starting point is 20% of font size.).
243
    my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
240
    my $text_lly = ($self->{'lly'} + ($self->{'height'} - $self->{'top_text_margin'}));
244
    $debug and warn  "Label: llx $self->{'llx'}, lly $self->{'lly'}, Text: lly $text_lly, $line_spacer, Barcode: llx $barcode_llx, lly $barcode_lly, $barcode_width, $barcode_y_scale_factor\n";
245
    return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
241
    return $self->{'llx'}, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor;
246
}
242
}
247
243
(-)a/C4/Letters.pm (-7 / +4 lines)
Lines 32-38 use C4::Members; Link Here
32
use C4::Log;
32
use C4::Log;
33
use C4::SMS;
33
use C4::SMS;
34
use C4::Templates;
34
use C4::Templates;
35
use C4::Debug;
36
use Koha::DateUtils;
35
use Koha::DateUtils;
37
use Koha::SMS::Providers;
36
use Koha::SMS::Providers;
38
37
Lines 947-953 sub EnqueueLetter { Link Here
947
    my $content = $params->{letter}->{content};
946
    my $content = $params->{letter}->{content};
948
    $content =~ s/\s+//g if(defined $content);
947
    $content =~ s/\s+//g if(defined $content);
949
    if ( not defined $content or $content eq '' ) {
948
    if ( not defined $content or $content eq '' ) {
950
        warn "Trying to add an empty message to the message queue" if $debug;
949
        Koha::Logger->get->info("Trying to add an empty message to the message queue");
951
        return;
950
        return;
952
    }
951
    }
953
952
Lines 1032-1038 sub SendQueuedMessages { Link Here
1032
        warn sprintf( 'sending %s message to patron: %s',
1031
        warn sprintf( 'sending %s message to patron: %s',
1033
                      $message->{'message_transport_type'},
1032
                      $message->{'message_transport_type'},
1034
                      $message->{'borrowernumber'} || 'Admin' )
1033
                      $message->{'borrowernumber'} || 'Admin' )
1035
          if $params->{'verbose'} or $debug;
1034
          if $params->{'verbose'};
1036
        # This is just begging for subclassing
1035
        # This is just begging for subclassing
1037
        next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1036
        next MESSAGE if ( lc($message->{'message_transport_type'}) eq 'rss' );
1038
        if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
1037
        if ( lc( $message->{'message_transport_type'} ) eq 'email' ) {
Lines 1043-1055 sub SendQueuedMessages { Link Here
1043
                my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1042
                my $patron = Koha::Patrons->find( $message->{borrowernumber} );
1044
                my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1043
                my $sms_provider = Koha::SMS::Providers->find( $patron->sms_provider_id );
1045
                unless ( $sms_provider ) {
1044
                unless ( $sms_provider ) {
1046
                    warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1045
                    warn sprintf( "Patron %s has no sms provider id set!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1047
                    _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1046
                    _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1048
                    next MESSAGE;
1047
                    next MESSAGE;
1049
                }
1048
                }
1050
                unless ( $patron->smsalertnumber ) {
1049
                unless ( $patron->smsalertnumber ) {
1051
                    _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1050
                    _set_message_status( { message_id => $message->{'message_id'}, status => 'failed' } );
1052
                    warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'} or $debug;
1051
                    warn sprintf( "No smsalertnumber found for patron %s!", $message->{'borrowernumber'} ) if $params->{'verbose'};
1053
                    next MESSAGE;
1052
                    next MESSAGE;
1054
                }
1053
                }
1055
                $message->{to_address}  = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
1054
                $message->{to_address}  = $patron->smsalertnumber; #Sometime this is set to email - sms should always use smsalertnumber
Lines 1318-1325 sub _get_unsent_messages { Link Here
1318
        }
1317
        }
1319
    }
1318
    }
1320
1319
1321
    $debug and warn "_get_unsent_messages SQL: $statement";
1322
    $debug and warn "_get_unsent_messages params: " . join(',',@query_params);
1323
    my $sth = $dbh->prepare( $statement );
1320
    my $sth = $dbh->prepare( $statement );
1324
    my $result = $sth->execute( @query_params );
1321
    my $result = $sth->execute( @query_params );
1325
    return $sth->fetchall_arrayref({});
1322
    return $sth->fetchall_arrayref({});
(-)a/C4/Output.pm (-2 lines)
Lines 100-107 sub pagination_bar { Link Here
100
	$base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
100
	$base_url =~ s/$delim*\b$startfrom_name=(\d+)//g; # remove previous pagination var
101
    unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
101
    unless (defined $current_page and $current_page > 0 and $current_page <= $nb_pages) {
102
        $current_page = ($1) ? $1 : 1;	# pull current page from param in URL, else default to 1
102
        $current_page = ($1) ? $1 : 1;	# pull current page from param in URL, else default to 1
103
		# $debug and	# FIXME: use C4::Debug;
104
		# warn "with QUERY_STRING:" .$ENV{QUERY_STRING}. "\ncurrent_page:$current_page\n1:$1  2:$2  3:$3";
105
    }
103
    }
106
	$base_url =~ s/($delim)+/$1/g;	# compress duplicate delims
104
	$base_url =~ s/($delim)+/$1/g;	# compress duplicate delims
107
	$base_url =~ s/$delim;//g;		# remove empties
105
	$base_url =~ s/$delim;//g;		# remove empties
(-)a/C4/Overdues.pm (-7 / +4 lines)
Lines 31-37 use C4::Circulation; Link Here
31
use C4::Context;
31
use C4::Context;
32
use C4::Accounts;
32
use C4::Accounts;
33
use C4::Log; # logaction
33
use C4::Log; # logaction
34
use C4::Debug;
34
use Koha::Logger;
35
use Koha::DateUtils;
35
use Koha::DateUtils;
36
use Koha::Account::Lines;
36
use Koha::Account::Lines;
37
use Koha::Account::Offsets;
37
use Koha::Account::Offsets;
Lines 275-281 sub CalcFine { Link Here
275
275
276
    $amount = $item->{replacementprice} if ( $issuing_rule->{cap_fine_to_replacement_price} && $item->{replacementprice} && $amount > $item->{replacementprice} );
276
    $amount = $item->{replacementprice} if ( $issuing_rule->{cap_fine_to_replacement_price} && $item->{replacementprice} && $amount > $item->{replacementprice} );
277
277
278
    $debug and warn sprintf("CalcFine returning (%s, %s, %s)", $amount, $units_minus_grace, $chargeable_units);
279
    return ($amount, $units_minus_grace, $chargeable_units);
278
    return ($amount, $units_minus_grace, $chargeable_units);
280
}
279
}
281
280
Lines 522-529 sub UpdateFine { Link Here
522
    my $amount         = $params->{amount};
521
    my $amount         = $params->{amount};
523
    my $due            = $params->{due} // q{};
522
    my $due            = $params->{due} // q{};
524
523
525
    $debug and warn "UpdateFine({ itemnumber => $itemnum, borrowernumber => $borrowernumber, due => $due, issue_id => $issue_id})";
526
527
    unless ( $issue_id ) {
524
    unless ( $issue_id ) {
528
        carp("No issue_id passed in!");
525
        carp("No issue_id passed in!");
529
        return;
526
        return;
Lines 547-553 sub UpdateFine { Link Here
547
    while (my $overdue = $overdues->next) {
544
    while (my $overdue = $overdues->next) {
548
        if ( defined $overdue->issue_id && $overdue->issue_id == $issue_id && $overdue->status eq 'UNRETURNED' ) {
545
        if ( defined $overdue->issue_id && $overdue->issue_id == $issue_id && $overdue->status eq 'UNRETURNED' ) {
549
            if ($accountline) {
546
            if ($accountline) {
550
                $debug and warn "Not a unique accountlines record for issue_id $issue_id";
547
                Koha::Logger->get->debug("Not a unique accountlines record for issue_id $issue_id"); # FIXME Do we really need to log that?
551
                #FIXME Should we still count this one in total_amount ??
548
                #FIXME Should we still count this one in total_amount ??
552
            }
549
            }
553
            else {
550
            else {
Lines 563-574 sub UpdateFine { Link Here
563
        if ($accountline) {
560
        if ($accountline) {
564
            if ( ( $amount - $accountline->amount ) > $maxIncrease ) {
561
            if ( ( $amount - $accountline->amount ) > $maxIncrease ) {
565
                my $new_amount = $accountline->amount + $maxIncrease;
562
                my $new_amount = $accountline->amount + $maxIncrease;
566
                $debug and warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached";
563
                Koha::Logger->get->debug("Reducing fine for item $itemnum borrower $borrowernumber from $amount to $new_amount - MaxFine reached");
567
                $amount = $new_amount;
564
                $amount = $new_amount;
568
            }
565
            }
569
        }
566
        }
570
        elsif ( $amount > $maxIncrease ) {
567
        elsif ( $amount > $maxIncrease ) {
571
            $debug and warn "Reducing fine for item $itemnum borrower $borrowernumber from $amount to $maxIncrease - MaxFine reached";
568
            Koha::Logger->get->debug("Reducing fine for item $itemnum borrower $borrowernumber from $amount to $maxIncrease - MaxFine reached");
572
            $amount = $maxIncrease;
569
            $amount = $maxIncrease;
573
        }
570
        }
574
    }
571
    }
(-)a/C4/Patroncards/Lib.pm (-3 lines)
Lines 20-29 package C4::Patroncards::Lib; Link Here
20
use strict;
20
use strict;
21
use warnings;
21
use warnings;
22
22
23
use autouse 'Data::Dumper' => qw(Dumper);
24
25
use C4::Context;
23
use C4::Context;
26
use C4::Debug;
27
24
28
BEGIN {
25
BEGIN {
29
    use base qw(Exporter);
26
    use base qw(Exporter);
(-)a/C4/Reports.pm (-1 lines)
Lines 22-28 use CGI qw ( -utf8 ); Link Here
22
22
23
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
23
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
24
use C4::Context;
24
use C4::Context;
25
use C4::Debug;
26
25
27
BEGIN {
26
BEGIN {
28
    require Exporter;
27
    require Exporter;
(-)a/C4/Reports/Guided.pm (-5 / +8 lines)
Lines 30-40 use Koha::DateUtils; Link Here
30
use Koha::Patrons;
30
use Koha::Patrons;
31
use Koha::Reports;
31
use Koha::Reports;
32
use C4::Output;
32
use C4::Output;
33
use C4::Debug;
34
use C4::Log;
33
use C4::Log;
35
use Koha::Notice::Templates;
34
use Koha::Notice::Templates;
36
use C4::Letters;
35
use C4::Letters;
37
36
37
use Koha::Logger;
38
use Koha::AuthorisedValues;
38
use Koha::AuthorisedValues;
39
use Koha::Patron::Categories;
39
use Koha::Patron::Categories;
40
use Koha::SharedContent;
40
use Koha::SharedContent;
Lines 550-556 sub execute_query { Link Here
550
    }
550
    }
551
    $offset = 0    unless $offset;
551
    $offset = 0    unless $offset;
552
    $limit  = 999999 unless $limit;
552
    $limit  = 999999 unless $limit;
553
    $debug and print STDERR "execute_query($sql, $offset, $limit)\n";
553
554
    Koha::Logger->get->debug("Report - execute_query($sql, $offset, $limit)");
554
555
555
    my ( $is_sql_valid, $errors ) = Koha::Report->new({ savedsql => $sql })->is_sql_valid;
556
    my ( $is_sql_valid, $errors ) = Koha::Report->new({ savedsql => $sql })->is_sql_valid;
556
    return (undef, @{$errors}[0]) unless $is_sql_valid;
557
    return (undef, @{$errors}[0]) unless $is_sql_valid;
Lines 571-579 sub execute_query { Link Here
571
572
572
    # Grab offset/limit from user supplied LIMIT and drop the LIMIT so we can control pagination
573
    # Grab offset/limit from user supplied LIMIT and drop the LIMIT so we can control pagination
573
    ($sql, $useroffset, $userlimit) = strip_limit($sql);
574
    ($sql, $useroffset, $userlimit) = strip_limit($sql);
574
    $debug and warn sprintf "User has supplied (OFFSET,) LIMIT = %s, %s",
575
575
        $useroffset,
576
    Koha::Logger->get->debug(
576
        (defined($userlimit ) ? $userlimit  : 'UNDEF');
577
        sprintf "User has supplied (OFFSET,) LIMIT = %s, %s",
578
        $useroffset, ( defined($userlimit) ? $userlimit : 'UNDEF' ) );
579
577
    $offset += $useroffset;
580
    $offset += $useroffset;
578
    if (defined($userlimit)) {
581
    if (defined($userlimit)) {
579
        if ($offset + $limit > $userlimit ) {
582
        if ($offset + $limit > $userlimit ) {
(-)a/C4/SIP/ILS/Item.pm (-2 lines)
Lines 19-25 use C4::SIP::Sip qw(add_field); Link Here
19
use C4::Biblio;
19
use C4::Biblio;
20
use C4::Circulation;
20
use C4::Circulation;
21
use C4::Context;
21
use C4::Context;
22
use C4::Debug;
23
use C4::Items;
22
use C4::Items;
24
use C4::Members;
23
use C4::Members;
25
use C4::Reserves;
24
use C4::Reserves;
Lines 372-378 sub available { Link Here
372
	my ($self, $for_patron) = @_;
371
	my ($self, $for_patron) = @_;
373
	my $count  = (defined $self->{pending_queue}) ? scalar @{$self->{pending_queue}} : 0;
372
	my $count  = (defined $self->{pending_queue}) ? scalar @{$self->{pending_queue}} : 0;
374
    my $count2 = (defined $self->{hold_attached}   ) ? scalar @{$self->{hold_attached}   } : 0;
373
    my $count2 = (defined $self->{hold_attached}   ) ? scalar @{$self->{hold_attached}   } : 0;
375
    $debug and print STDERR "availability check: pending_queue size $count, hold_attached size $count2\n";
376
    if (defined($self->{borrowernumber})) {
374
    if (defined($self->{borrowernumber})) {
377
        ($self->{borrowernumber} eq $for_patron) or return 0;
375
        ($self->{borrowernumber} eq $for_patron) or return 0;
378
		return ($count ? 0 : 1);
376
		return ($count ? 0 : 1);
(-)a/C4/SIP/ILS/Patron.pm (-5 lines)
Lines 17-23 use Data::Dumper; Link Here
17
17
18
use C4::SIP::Sip qw(add_field maybe_add);
18
use C4::SIP::Sip qw(add_field maybe_add);
19
19
20
use C4::Debug;
21
use C4::Context;
20
use C4::Context;
22
use C4::Koha;
21
use C4::Koha;
23
use C4::Members;
22
use C4::Members;
Lines 53-59 sub new { Link Here
53
            || Koha::Patrons->find( { userid => $patron_id } );
52
            || Koha::Patrons->find( { userid => $patron_id } );
54
    }
53
    }
55
54
56
    $debug and warn "new Patron: " . Dumper($patron->unblessed) if $patron;
57
    unless ($patron) {
55
    unless ($patron) {
58
        siplog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
56
        siplog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
59
        return;
57
        return;
Lines 62-68 sub new { Link Here
62
    my $pw        = $kp->{password};
60
    my $pw        = $kp->{password};
63
    my $flags     = C4::Members::patronflags( $kp );
61
    my $flags     = C4::Members::patronflags( $kp );
64
    my $debarred  = $patron->is_debarred;
62
    my $debarred  = $patron->is_debarred;
65
    $debug and warn sprintf("Debarred = %s : ", ($debarred||'undef')); # Do we need more debug info here?
66
    my ($day, $month, $year) = (localtime)[3,4,5];
63
    my ($day, $month, $year) = (localtime)[3,4,5];
67
    my $today    = sprintf '%04d-%02d-%02d', $year+1900, $month+1, $day;
64
    my $today    = sprintf '%04d-%02d-%02d', $year+1900, $month+1, $day;
68
    my $expired  = ($today gt $kp->{dateexpiry}) ? 1 : 0;
65
    my $expired  = ($today gt $kp->{dateexpiry}) ? 1 : 0;
Lines 134-140 sub new { Link Here
134
        userid          => $kp->{userid},
131
        userid          => $kp->{userid},
135
    );
132
    );
136
    }
133
    }
137
    $debug and warn "patron fines: $ilspatron{fines} ... amountoutstanding: $kp->{amountoutstanding} ... CHARGES->amount: $flags->{CHARGES}->{amount}";
138
134
139
    if ( $patron->is_debarred and $patron->debarredcomment ) {
135
    if ( $patron->is_debarred and $patron->debarredcomment ) {
140
        $ilspatron{screen_msg} .= " -- " . $patron->debarredcomment;
136
        $ilspatron{screen_msg} .= " -- " . $patron->debarredcomment;
Lines 165-171 sub new { Link Here
165
    $ilspatron{items} = \@barcodes;
161
    $ilspatron{items} = \@barcodes;
166
162
167
    $self = \%ilspatron;
163
    $self = \%ilspatron;
168
    $debug and warn Dumper($self);
169
    siplog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
164
    siplog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id});
170
    bless $self, $type;
165
    bless $self, $type;
171
    return $self;
166
    return $self;
(-)a/C4/SIP/ILS/Transaction/Checkin.pm (-2 lines)
Lines 12-18 use strict; Link Here
12
use C4::SIP::ILS::Transaction;
12
use C4::SIP::ILS::Transaction;
13
13
14
use C4::Circulation;
14
use C4::Circulation;
15
use C4::Debug;
16
use C4::Items qw( ModItemTransfer );
15
use C4::Items qw( ModItemTransfer );
17
use C4::Reserves qw( ModReserveAffect );
16
use C4::Reserves qw( ModReserveAffect );
18
use Koha::DateUtils qw( dt_from_string );
17
use Koha::DateUtils qw( dt_from_string );
Lines 90-96 sub do_checkin { Link Here
90
89
91
    my $checkin_blocked_by_holds = $holds_block_checkin && $item->biblio->holds->count;
90
    my $checkin_blocked_by_holds = $holds_block_checkin && $item->biblio->holds->count;
92
91
93
    $debug and warn "do_checkin() calling AddReturn($barcode, $branch)";
94
    ( $return, $messages, $issue, $borrower ) =
92
    ( $return, $messages, $issue, $borrower ) =
95
      AddReturn( $barcode, $branch, undef, $return_date )
93
      AddReturn( $barcode, $branch, undef, $return_date )
96
      unless $human_required || $checkin_blocked_by_holds;
94
      unless $human_required || $checkin_blocked_by_holds;
(-)a/C4/SIP/ILS/Transaction/Checkout.pm (-11 lines)
Lines 18-31 use C4::Context; Link Here
18
use C4::Circulation;
18
use C4::Circulation;
19
use C4::Members;
19
use C4::Members;
20
use C4::Reserves qw(ModReserveFill);
20
use C4::Reserves qw(ModReserveFill);
21
use C4::Debug;
22
use Koha::DateUtils;
21
use Koha::DateUtils;
23
22
24
use parent qw(C4::SIP::ILS::Transaction);
23
use parent qw(C4::SIP::ILS::Transaction);
25
24
26
our $debug;
27
28
29
# Most fields are handled by the Transaction superclass
25
# Most fields are handled by the Transaction superclass
30
my %fields = (
26
my %fields = (
31
          security_inhibit => 0,
27
          security_inhibit => 0,
Lines 40-47 sub new { Link Here
40
        $self->{_permitted}->{$element} = $fields{$element};
36
        $self->{_permitted}->{$element} = $fields{$element};
41
    }
37
    }
42
    @{$self}{keys %fields} = values %fields;
38
    @{$self}{keys %fields} = values %fields;
43
#    $self->{'due'} = time() + (60*60*24*14); # two weeks hence
44
    $debug and warn "new ILS::Transaction::Checkout : " . Dumper $self;
45
    return bless $self, $class;
39
    return bless $self, $class;
46
}
40
}
47
41
Lines 54-60 sub do_checkout { Link Here
54
    my $patron         = Koha::Patrons->find($self->{patron}->{borrowernumber});
48
    my $patron         = Koha::Patrons->find($self->{patron}->{borrowernumber});
55
    my $overridden_duedate; # usually passed as undef to AddIssue
49
    my $overridden_duedate; # usually passed as undef to AddIssue
56
    my $prevcheckout_block_checkout  = $account->{prevcheckout_block_checkout};
50
    my $prevcheckout_block_checkout  = $account->{prevcheckout_block_checkout};
57
    $debug and warn "do_checkout borrower: . " . $patron->borrowernumber;
58
    my ($issuingimpossible, $needsconfirmation) = _can_we_issue($patron, $barcode, 0);
51
    my ($issuingimpossible, $needsconfirmation) = _can_we_issue($patron, $barcode, 0);
59
52
60
    my $noerror=1;  # If set to zero we block the issue
53
    my $noerror=1;  # If set to zero we block the issue
Lines 77-83 sub do_checkout { Link Here
77
            } elsif ($confirmation eq 'RESERVE_WAITING'
70
            } elsif ($confirmation eq 'RESERVE_WAITING'
78
                      or $confirmation eq 'TRANSFERRED'
71
                      or $confirmation eq 'TRANSFERRED'
79
                      or $confirmation eq 'PROCESSING') {
72
                      or $confirmation eq 'PROCESSING') {
80
               $debug and warn "Item is on hold for another patron.";
81
               $self->screen_msg("Item is on hold for another patron.");
73
               $self->screen_msg("Item is on hold for another patron.");
82
               $noerror = 0;
74
               $noerror = 0;
83
            } elsif ($confirmation eq 'ISSUED_TO_ANOTHER') {
75
            } elsif ($confirmation eq 'ISSUED_TO_ANOTHER') {
Lines 123-135 sub do_checkout { Link Here
123
        }
115
        }
124
    }
116
    }
125
	unless ($noerror) {
117
	unless ($noerror) {
126
		$debug and warn "cannot issue: " . Dumper($issuingimpossible) . "\n" . Dumper($needsconfirmation);
127
		$self->ok(0);
118
		$self->ok(0);
128
		return $self;
119
		return $self;
129
	}
120
	}
130
	# can issue
121
	# can issue
131
    $debug and warn sprintf("do_checkout: calling AddIssue(%s, %s, %s, 0)\n", $patron->borrowernumber, $barcode, $overridden_duedate)
132
		. "w/ C4::Context->userenv: " . Dumper(C4::Context->userenv);
133
    my $issue = AddIssue( $patron->unblessed, $barcode, $overridden_duedate, 0 );
122
    my $issue = AddIssue( $patron->unblessed, $barcode, $overridden_duedate, 0 );
134
    $self->{due} = $self->duedatefromissue($issue, $itemnumber);
123
    $self->{due} = $self->duedatefromissue($issue, $itemnumber);
135
124
(-)a/C4/Scrubber.pm (-5 lines)
Lines 25-33 use Carp; Link Here
25
use HTML::Scrubber;
25
use HTML::Scrubber;
26
26
27
use C4::Context;
27
use C4::Context;
28
use C4::Debug;
29
30
31
28
32
my %scrubbertypes = (
29
my %scrubbertypes = (
33
    default => {}, # place holder, default settings are below as fallbacks in call to constructor
30
    default => {}, # place holder, default settings are below as fallbacks in call to constructor
Lines 46-52 sub new { Link Here
46
    if ( !exists $scrubbertypes{$type} ) {
43
    if ( !exists $scrubbertypes{$type} ) {
47
        croak "New called with unrecognized type '$type'";
44
        croak "New called with unrecognized type '$type'";
48
    }
45
    }
49
    $debug and carp "Building new Scrubber of type '$type'";
50
    my $settings = $scrubbertypes{$type};
46
    my $settings = $scrubbertypes{$type};
51
    my $scrubber = HTML::Scrubber->new(
47
    my $scrubber = HTML::Scrubber->new(
52
        allow   => exists $settings->{allow} ? $settings->{allow} : [],
48
        allow   => exists $settings->{allow} ? $settings->{allow} : [],
Lines 65-71 __END__ Link Here
65
=head1 C4::Sanitize
61
=head1 C4::Sanitize
66
62
67
Standardized wrapper with settings for building HTML::Scrubber tailored to various koha inputs.
63
Standardized wrapper with settings for building HTML::Scrubber tailored to various koha inputs.
68
More verbose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
69
64
70
The default is to scrub everything, leaving no markup at all.  This is compatible with the expectations
65
The default is to scrub everything, leaving no markup at all.  This is compatible with the expectations
71
for Tags.
66
for Tags.
(-)a/C4/Search.pm (-29 / +15 lines)
Lines 26-33 use Lingua::Stem; Link Here
26
use XML::Simple;
26
use XML::Simple;
27
use C4::XSLT;
27
use C4::XSLT;
28
use C4::Reserves;    # GetReserveStatus
28
use C4::Reserves;    # GetReserveStatus
29
use C4::Debug;
30
use C4::Charset;
29
use C4::Charset;
30
use Koha::Logger;
31
use Koha::AuthorisedValues;
31
use Koha::AuthorisedValues;
32
use Koha::ItemTypes;
32
use Koha::ItemTypes;
33
use Koha::Libraries;
33
use Koha::Libraries;
Lines 37-47 use URI::Escape; Link Here
37
use Business::ISBN;
37
use Business::ISBN;
38
use MARC::Record;
38
use MARC::Record;
39
use MARC::Field;
39
use MARC::Field;
40
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
40
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
41
42
BEGIN {
43
    $DEBUG = ($ENV{DEBUG}) ? 1 : 0;
44
}
45
41
46
=head1 NAME
42
=head1 NAME
47
43
Lines 323-330 sub getRecords { Link Here
323
# if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
319
# if this is a local search, use the $koha-query, if it's a federated one, use the federated-query
324
        my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
320
        my $query_to_use = ($servers[$i] =~ /biblioserver/) ? $koha_query : $simple_query;
325
321
326
        #$query_to_use = $simple_query if $scan;
322
        Koha::Logger->get->debug($simple_query) if $scan;
327
        warn $simple_query if ( $scan and $DEBUG );
328
323
329
        # Check if we've got a query_type defined, if so, use it
324
        # Check if we've got a query_type defined, if so, use it
330
        eval {
325
        eval {
Lines 869-875 sub _build_stemmed_operand { Link Here
869
          unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
864
          unless ( $stem =~ /(and$|or$|not$)/ ) || ( length($stem) < 3 );
870
        $stemmed_operand .= " ";
865
        $stemmed_operand .= " ";
871
    }
866
    }
872
    warn "STEMMED OPERAND: $stemmed_operand" if $DEBUG;
867
868
    Koha::Logger->get->debug("STEMMED OPERAND: $stemmed_operand");
873
    return $stemmed_operand;
869
    return $stemmed_operand;
874
}
870
}
875
871
Lines 1186-1192 See verbose embedded documentation. Link Here
1186
1182
1187
sub buildQuery {
1183
sub buildQuery {
1188
    my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1184
    my ( $operators, $operands, $indexes, $limits, $sort_by, $scan, $lang) = @_;
1189
    warn "---------\nEnter buildQuery\n---------" if $DEBUG;
1190
1185
1191
    my $query_desc;
1186
    my $query_desc;
1192
1187
Lines 1351-1357 sub buildQuery { Link Here
1351
						$operand=join(" ",map{
1346
						$operand=join(" ",map{
1352
											(index($_,"*")>0?"$_":"$_*")
1347
											(index($_,"*")>0?"$_":"$_*")
1353
											 }split (/\s+/,$operand));
1348
											 }split (/\s+/,$operand));
1354
						warn $operand if $DEBUG;
1355
					}
1349
					}
1356
				}
1350
				}
1357
1351
Lines 1360-1368 sub buildQuery { Link Here
1360
                my( $nontruncated, $righttruncated, $lefttruncated,
1354
                my( $nontruncated, $righttruncated, $lefttruncated,
1361
                    $rightlefttruncated, $regexpr
1355
                    $rightlefttruncated, $regexpr
1362
                ) = _detect_truncation( $operand, $index );
1356
                ) = _detect_truncation( $operand, $index );
1363
                warn
1357
1364
"TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<"
1358
                Koha::Logger->get->debug(
1365
                  if $DEBUG;
1359
                    "TRUNCATION: NON:>@$nontruncated< RIGHT:>@$righttruncated< LEFT:>@$lefttruncated< RIGHTLEFT:>@$rightlefttruncated< REGEX:>@$regexpr<");
1366
1360
1367
                # Apply Truncation
1361
                # Apply Truncation
1368
                if (
1362
                if (
Lines 1395-1408 sub buildQuery { Link Here
1395
                    }
1389
                    }
1396
                }
1390
                }
1397
                $operand = $truncated_operand if $truncated_operand;
1391
                $operand = $truncated_operand if $truncated_operand;
1398
                warn "TRUNCATED OPERAND: >$truncated_operand<" if $DEBUG;
1392
                Koha::Logger->get->debug("TRUNCATED OPERAND: >$truncated_operand<");
1399
1393
1400
                # Handle Stemming
1394
                # Handle Stemming
1401
                my $stemmed_operand;
1395
                my $stemmed_operand;
1402
                $stemmed_operand = _build_stemmed_operand($operand, $lang)
1396
                $stemmed_operand = _build_stemmed_operand($operand, $lang)
1403
										if $stemming;
1397
										if $stemming;
1404
1398
1405
                warn "STEMMED OPERAND: >$stemmed_operand<" if $DEBUG;
1399
                Koha::Logger->get->debug("STEMMED OPERAND: >$stemmed_operand<");
1406
1400
1407
                # Handle Field Weighting
1401
                # Handle Field Weighting
1408
                my $weighted_operand;
1402
                my $weighted_operand;
Lines 1412-1418 sub buildQuery { Link Here
1412
                    $indexes_set = 1;
1406
                    $indexes_set = 1;
1413
                }
1407
                }
1414
1408
1415
                warn "FIELD WEIGHTED OPERAND: >$weighted_operand<" if $DEBUG;
1409
                Koha::Logger->get->debug("FIELD WEIGHTED OPERAND: >$weighted_operand<");
1416
1410
1417
                #Use relevance ranking when not using a weighted query (which adds relevance ranking of its own)
1411
                #Use relevance ranking when not using a weighted query (which adds relevance ranking of its own)
1418
1412
Lines 1437-1443 sub buildQuery { Link Here
1437
            }    #/if $operands
1431
            }    #/if $operands
1438
        }    # /for
1432
        }    # /for
1439
    }
1433
    }
1440
    warn "QUERY BEFORE LIMITS: >$query<" if $DEBUG;
1434
    Koha::Logger->get->debug("QUERY BEFORE LIMITS: >$query<");
1441
1435
1442
    # add limits
1436
    # add limits
1443
    my %group_OR_limits;
1437
    my %group_OR_limits;
Lines 1532-1547 sub buildQuery { Link Here
1532
    # append the limit to the query
1526
    # append the limit to the query
1533
    $query .= " " . $limit;
1527
    $query .= " " . $limit;
1534
1528
1535
    # Warnings if DEBUG
1529
    Koha::Logger->get->debug(
1536
    if ($DEBUG) {
1530
        sprintf "buildQuery returns\nQUERY:%s\nQUERY CGI:%s\nQUERY DESC:%s\nLIMIT:%s\nLIMIT CGI:%s\nLIMIT DESC:%s",
1537
        warn "QUERY:" . $query;
1531
        $query, $query_cgi, $query_desc, $limit, $limit_cgi, $limit_desc );
1538
        warn "QUERY CGI:" . $query_cgi;
1539
        warn "QUERY DESC:" . $query_desc;
1540
        warn "LIMIT:" . $limit;
1541
        warn "LIMIT CGI:" . $limit_cgi;
1542
        warn "LIMIT DESC:" . $limit_desc;
1543
        warn "---------\nLeave buildQuery\n---------";
1544
    }
1545
1532
1546
    return (
1533
    return (
1547
        undef,              $query, $simple_query, $query_cgi,
1534
        undef,              $query, $simple_query, $query_cgi,
Lines 2198-2204 sub GetDistinctValues { Link Here
2198
    if ($fieldname=~/\./){
2185
    if ($fieldname=~/\./){
2199
			my ($table,$column)=split /\./, $fieldname;
2186
			my ($table,$column)=split /\./, $fieldname;
2200
			my $dbh = C4::Context->dbh;
2187
			my $dbh = C4::Context->dbh;
2201
			warn "select DISTINCT($column) as value, count(*) as cnt from $table group by lib order by $column " if $DEBUG;
2202
			my $sth = $dbh->prepare("select DISTINCT($column) as value, count(*) as cnt from $table ".($string?" where $column like \"$string%\"":"")."group by value order by $column ");
2188
			my $sth = $dbh->prepare("select DISTINCT($column) as value, count(*) as cnt from $table ".($string?" where $column like \"$string%\"":"")."group by value order by $column ");
2203
			$sth->execute;
2189
			$sth->execute;
2204
			my $elements=$sth->fetchall_arrayref({});
2190
			my $elements=$sth->fetchall_arrayref({});
(-)a/C4/Serials.pm (-6 lines)
Lines 27-33 use Date::Calc qw(:all); Link Here
27
use POSIX qw(strftime);
27
use POSIX qw(strftime);
28
use C4::Biblio;
28
use C4::Biblio;
29
use C4::Log;    # logaction
29
use C4::Log;    # logaction
30
use C4::Debug;
31
use C4::Serials::Frequency;
30
use C4::Serials::Frequency;
32
use C4::Serials::Numberpattern;
31
use C4::Serials::Numberpattern;
33
use Koha::AdditionalFieldValues;
32
use Koha::AdditionalFieldValues;
Lines 197-203 sub GetSerialInformation { Link Here
197
196
198
                #It is ASSUMED that GetMarcItem ALWAYS WORK...
197
                #It is ASSUMED that GetMarcItem ALWAYS WORK...
199
                #Maybe GetMarcItem should return values on failure
198
                #Maybe GetMarcItem should return values on failure
200
                $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
201
                my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
199
                my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
202
                $itemprocessed->{'itemnumber'}   = $itemnum->[0];
200
                $itemprocessed->{'itemnumber'}   = $itemnum->[0];
203
                $itemprocessed->{'itemid'}       = $itemnum->[0];
201
                $itemprocessed->{'itemid'}       = $itemnum->[0];
Lines 266-272 sub GetSubscription { Link Here
266
       WHERE subscription.subscriptionid = ?
264
       WHERE subscription.subscriptionid = ?
267
    );
265
    );
268
266
269
    $debug and warn "query : $query\nsubsid :$subscriptionid";
270
    my $sth = $dbh->prepare($query);
267
    my $sth = $dbh->prepare($query);
271
    $sth->execute($subscriptionid);
268
    $sth->execute($subscriptionid);
272
    my $subscription = $sth->fetchrow_hashref;
269
    my $subscription = $sth->fetchrow_hashref;
Lines 320-326 sub GetFullSubscription { Link Here
320
          IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
317
          IF(serial.publisheddate IS NULL,serial.planneddate,serial.publisheddate) DESC,
321
          serial.subscriptionid
318
          serial.subscriptionid
322
          |;
319
          |;
323
    $debug and warn "GetFullSubscription query: $query";
324
    my $sth = $dbh->prepare($query);
320
    my $sth = $dbh->prepare($query);
325
    $sth->execute($subscriptionid);
321
    $sth->execute($subscriptionid);
326
    my $subscriptions = $sth->fetchall_arrayref( {} );
322
    my $subscriptions = $sth->fetchall_arrayref( {} );
Lines 732-738 sub GetSerials2 { Link Here
732
            . q|
728
            . q|
733
                 ORDER BY publisheddate,serialid DESC
729
                 ORDER BY publisheddate,serialid DESC
734
    |;
730
    |;
735
    $debug and warn "GetSerials2 query: $query";
736
    my $sth = $dbh->prepare($query);
731
    my $sth = $dbh->prepare($query);
737
    $sth->execute( $subscription, @$statuses );
732
    $sth->execute( $subscription, @$statuses );
738
    my @serials;
733
    my @serials;
Lines 1575-1581 sub ReNewSubscription { Link Here
1575
    $sth = $dbh->prepare($query);
1570
    $sth = $dbh->prepare($query);
1576
    $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1571
    $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1577
    my $enddate = GetExpirationDate($subscriptionid);
1572
    my $enddate = GetExpirationDate($subscriptionid);
1578
	$debug && warn "enddate :$enddate";
1579
    $query = qq|
1573
    $query = qq|
1580
        UPDATE subscription
1574
        UPDATE subscription
1581
        SET    enddate=?
1575
        SET    enddate=?
(-)a/C4/Stats.pm (-3 lines)
Lines 22-28 use Modern::Perl; Link Here
22
require Exporter;
22
require Exporter;
23
use Carp;
23
use Carp;
24
use C4::Context;
24
use C4::Context;
25
use C4::Debug;
26
25
27
use Koha::DateUtils qw( dt_from_string );
26
use Koha::DateUtils qw( dt_from_string );
28
use Koha::Statistics;
27
use Koha::Statistics;
Lines 30-37 use Koha::PseudonymizedTransactions; Link Here
30
29
31
use vars qw(@ISA @EXPORT);
30
use vars qw(@ISA @EXPORT);
32
31
33
our $debug;
34
35
BEGIN {
32
BEGIN {
36
	@ISA    = qw(Exporter);
33
	@ISA    = qw(Exporter);
37
	@EXPORT = qw(
34
	@EXPORT = qw(
(-)a/C4/Suggestions.pm (-2 lines)
Lines 23-29 use CGI qw ( -utf8 ); Link Here
23
23
24
use C4::Context;
24
use C4::Context;
25
use C4::Output;
25
use C4::Output;
26
use C4::Debug;
27
use C4::Letters;
26
use C4::Letters;
28
use C4::Biblio qw( GetMarcFromKohaField );
27
use C4::Biblio qw( GetMarcFromKohaField );
29
use Koha::DateUtils;
28
use Koha::DateUtils;
Lines 210-216 sub SearchSuggestion { Link Here
210
        push @query, q{ AND suggestions.archived = 0 };
209
        push @query, q{ AND suggestions.archived = 0 };
211
    }
210
    }
212
211
213
    $debug && warn "@query";
214
    my $sth = $dbh->prepare("@query");
212
    my $sth = $dbh->prepare("@query");
215
    $sth->execute(@sql_params);
213
    $sth->execute(@sql_params);
216
    my @results;
214
    my @results;
(-)a/C4/Tags.pm (-32 lines)
Lines 24-30 use Carp; Link Here
24
use Exporter;
24
use Exporter;
25
25
26
use C4::Context;
26
use C4::Context;
27
use C4::Debug;
28
use Module::Load::Conditional qw/check_install/;
27
use Module::Load::Conditional qw/check_install/;
29
#use Data::Dumper;
28
#use Data::Dumper;
30
use constant TAG_FIELDS => qw(tag_id borrowernumber biblionumber term language date_created);
29
use constant TAG_FIELDS => qw(tag_id borrowernumber biblionumber term language date_created);
Lines 55-77 BEGIN { Link Here
55
        warn "Ignoring TagsExternalDictionary, because Lingua::Ispell is not installed.";
54
        warn "Ignoring TagsExternalDictionary, because Lingua::Ispell is not installed.";
56
        $ext_dict = q{};
55
        $ext_dict = q{};
57
    }
56
    }
58
	if ($debug) {
59
		require Data::Dumper;
60
		import Data::Dumper qw(:DEFAULT);
61
		print STDERR __PACKAGE__ . " external dictionary = " . ($ext_dict||'none') . "\n";
62
	}
63
	if ($ext_dict) {
57
	if ($ext_dict) {
64
		require Lingua::Ispell;
58
		require Lingua::Ispell;
65
        import Lingua::Ispell qw(spellcheck add_word_lc);
59
        import Lingua::Ispell qw(spellcheck add_word_lc);
66
        $Lingua::Ispell::path = $ext_dict;
60
        $Lingua::Ispell::path = $ext_dict;
67
        $debug and print STDERR "\$Lingua::Ispell::path = $Lingua::Ispell::path\n";
68
	}
61
	}
69
}
62
}
70
63
71
=head1 C4::Tags.pm - Support for user tagging of biblios.
64
=head1 C4::Tags.pm - Support for user tagging of biblios.
72
65
73
More verose debugging messages are sent in the presence of non-zero $ENV{"DEBUG"}.
74
75
=cut
66
=cut
76
67
77
sub get_filters {
68
sub get_filters {
Lines 100-106 sub approval_counts { Link Here
100
	$sth->execute;
91
	$sth->execute;
101
	my $result = $sth->fetchrow_hashref();
92
	my $result = $sth->fetchrow_hashref();
102
	$result->{approved_total} = $result->{approved_count} + $result->{rejected_count} + $result->{unapproved_count};
93
	$result->{approved_total} = $result->{approved_count} + $result->{rejected_count} + $result->{unapproved_count};
103
	$debug and warn "counts returned: " . Dumper $result;
104
	return $result;
94
	return $result;
105
}
95
}
106
96
Lines 134-142 sub remove_tag { Link Here
134
	($tag_id == $row->{tag_id}) or return 0;
124
	($tag_id == $row->{tag_id}) or return 0;
135
	my $tags = get_tags({term=>$row->{term}, biblionumber=>$row->{biblionumber}});
125
	my $tags = get_tags({term=>$row->{term}, biblionumber=>$row->{biblionumber}});
136
	my $index = shift(@$tags);
126
	my $index = shift(@$tags);
137
	$debug and print STDERR
138
		sprintf "remove_tag: tag_id=>%s, biblionumber=>%s, weight=>%s, weight_total=>%s\n",
139
			$row->{tag_id}, $row->{biblionumber}, $index->{weight}, $index->{weight_total};
140
	if ($index->{weight} <= 1) {
127
	if ($index->{weight} <= 1) {
141
		delete_tag_index($row->{term},$row->{biblionumber});
128
		delete_tag_index($row->{term},$row->{biblionumber});
142
	} else {
129
	} else {
Lines 187-193 sub get_tag_rows { Link Here
187
	my $limit  = "";
174
	my $limit  = "";
188
	my @exe_args = ();
175
	my @exe_args = ();
189
	foreach my $key (keys %$hash) {
176
	foreach my $key (keys %$hash) {
190
		$debug and print STDERR "get_tag_rows arg. '$key' = ", $hash->{$key}, "\n";
191
		unless (length $key) {
177
		unless (length $key) {
192
			carp "Empty argument key to get_tag_rows: ignoring!";
178
			carp "Empty argument key to get_tag_rows: ignoring!";
193
			next;
179
			next;
Lines 209-216 sub get_tag_rows { Link Here
209
		}
195
		}
210
	}
196
	}
211
    my $query = TAG_SELECT . ($wheres||'') . $limit;
197
    my $query = TAG_SELECT . ($wheres||'') . $limit;
212
	$debug and print STDERR "get_tag_rows query:\n $query\n",
213
							"get_tag_rows query args: ", join(',', @exe_args), "\n";
214
	my $sth = C4::Context->dbh->prepare($query);
198
	my $sth = C4::Context->dbh->prepare($query);
215
	if (@exe_args) {
199
	if (@exe_args) {
216
		$sth->execute(@exe_args);
200
		$sth->execute(@exe_args);
Lines 228-234 sub get_tags { # i.e., from tags_index Link Here
228
	my $order  = "";
212
	my $order  = "";
229
	my @exe_args = ();
213
	my @exe_args = ();
230
	foreach my $key (keys %$hash) {
214
	foreach my $key (keys %$hash) {
231
		$debug and print STDERR "get_tags arg. '$key' = ", $hash->{$key}, "\n";
232
		unless (length $key) {
215
		unless (length $key) {
233
			carp "Empty argument key to get_tags: ignoring!";
216
			carp "Empty argument key to get_tags: ignoring!";
234
			next;
217
			next;
Lines 278-285 sub get_tags { # i.e., from tags_index Link Here
278
	LEFT JOIN tags_approval 
261
	LEFT JOIN tags_approval 
279
	ON        tags_index.term = tags_approval.term
262
	ON        tags_index.term = tags_approval.term
280
	" . ($wheres||'') . $order . $limit;
263
	" . ($wheres||'') . $order . $limit;
281
	$debug and print STDERR "get_tags query:\n $query\n",
282
							"get_tags query args: ", join(',', @exe_args), "\n";
283
	my $sth = C4::Context->dbh->prepare($query);
264
	my $sth = C4::Context->dbh->prepare($query);
284
	if (@exe_args) {
265
	if (@exe_args) {
285
		$sth->execute(@exe_args);
266
		$sth->execute(@exe_args);
Lines 297-303 sub get_approval_rows { # i.e., from tags_approval Link Here
297
	my $order  = "";
278
	my $order  = "";
298
	my @exe_args = ();
279
	my @exe_args = ();
299
	foreach my $key (keys %$hash) {
280
	foreach my $key (keys %$hash) {
300
		$debug and print STDERR "get_approval_rows arg. '$key' = ", $hash->{$key}, "\n";
301
		unless (length $key) {
281
		unless (length $key) {
302
			carp "Empty argument key to get_approval_rows: ignoring!";
282
			carp "Empty argument key to get_approval_rows: ignoring!";
303
			next;
283
			next;
Lines 353-360 sub get_approval_rows { # i.e., from tags_approval Link Here
353
	LEFT JOIN borrowers
333
	LEFT JOIN borrowers
354
	ON      tags_approval.approved_by = borrowers.borrowernumber ";
334
	ON      tags_approval.approved_by = borrowers.borrowernumber ";
355
	$query .= ($wheres||'') . $order . $limit;
335
	$query .= ($wheres||'') . $order . $limit;
356
	$debug and print STDERR "get_approval_rows query:\n $query\n",
357
							"get_approval_rows query args: ", join(',', @exe_args), "\n";
358
	my $sth = C4::Context->dbh->prepare($query);
336
	my $sth = C4::Context->dbh->prepare($query);
359
	if (@exe_args) {
337
	if (@exe_args) {
360
		$sth->execute(@exe_args);
338
		$sth->execute(@exe_args);
Lines 442-448 sub remove_filter { Link Here
442
}
420
}
443
421
444
sub add_tag_approval {	# or disapproval
422
sub add_tag_approval {	# or disapproval
445
	$debug and warn "add_tag_approval(" . join(", ",map {defined($_) ? $_ : 'UNDEF'} @_) . ")";
446
	my $term = shift or return;
423
	my $term = shift or return;
447
	my $query = "SELECT * FROM tags_approval WHERE term = ?";
424
	my $query = "SELECT * FROM tags_approval WHERE term = ?";
448
	my $sth = C4::Context->dbh->prepare($query);
425
	my $sth = C4::Context->dbh->prepare($query);
Lines 460-466 sub add_tag_approval { # or disapproval Link Here
460
	} else {
437
	} else {
461
		$query = "INSERT INTO tags_approval (term,date_approved) VALUES (?,NOW())";
438
		$query = "INSERT INTO tags_approval (term,date_approved) VALUES (?,NOW())";
462
	}
439
	}
463
	$debug and print STDERR "add_tag_approval query: $query\nadd_tag_approval args: (" . join(", ", @exe_args) . ")\n";
464
	$sth = C4::Context->dbh->prepare($query);
440
	$sth = C4::Context->dbh->prepare($query);
465
	$sth->execute(@exe_args);
441
	$sth->execute(@exe_args);
466
	return $sth->rows;
442
	return $sth->rows;
Lines 472-478 sub mod_tag_approval { Link Here
472
	my $term     = shift or return;
448
	my $term     = shift or return;
473
	my $approval = (scalar @_ ? shift : 1);	# default is to approve
449
	my $approval = (scalar @_ ? shift : 1);	# default is to approve
474
	my $query = "UPDATE tags_approval SET approved_by=?, approved=?, date_approved=NOW() WHERE term = ?";
450
	my $query = "UPDATE tags_approval SET approved_by=?, approved=?, date_approved=NOW() WHERE term = ?";
475
	$debug and print STDERR "mod_tag_approval query: $query\nmod_tag_approval args: ($operator,$approval,$term)\n";
476
	my $sth = C4::Context->dbh->prepare($query);
451
	my $sth = C4::Context->dbh->prepare($query);
477
	$sth->execute($operator,$approval,$term);
452
	$sth->execute($operator,$approval,$term);
478
}
453
}
Lines 485-491 sub add_tag_index { Link Here
485
	$sth->execute($term,$biblionumber);
460
	$sth->execute($term,$biblionumber);
486
	($sth->rows) and return increment_weight($term,$biblionumber);
461
	($sth->rows) and return increment_weight($term,$biblionumber);
487
	$query = "INSERT INTO tags_index (term,biblionumber) VALUES (?,?)";
462
	$query = "INSERT INTO tags_index (term,biblionumber) VALUES (?,?)";
488
	$debug and print STDERR "add_tag_index query: $query\nadd_tag_index args: ($term,$biblionumber)\n";
489
	$sth = C4::Context->dbh->prepare($query);
463
	$sth = C4::Context->dbh->prepare($query);
490
	$sth->execute($term,$biblionumber);
464
	$sth->execute($term,$biblionumber);
491
	return $sth->rows;
465
	return $sth->rows;
Lines 548-557 sub add_tag { # biblionumber,term,[borrowernumber,approvernumber] Link Here
548
	my $query = "INSERT INTO tags_all
522
	my $query = "INSERT INTO tags_all
549
	(borrowernumber,biblionumber,term,date_created)
523
	(borrowernumber,biblionumber,term,date_created)
550
	VALUES (?,?,?,NOW())";
524
	VALUES (?,?,?,NOW())";
551
	$debug and print STDERR "add_tag query: $query\n",
552
							"add_tag query args: ($borrowernumber,$biblionumber,$term)\n";
553
	if (scalar @$rows) {
525
	if (scalar @$rows) {
554
		$debug and carp "Duplicate tag detected.  Tag not added.";	
555
		return;
526
		return;
556
	}
527
	}
557
	# add to tags_all regardless of approaval
528
	# add to tags_all regardless of approaval
Lines 561-575 sub add_tag { # biblionumber,term,[borrowernumber,approvernumber] Link Here
561
	# then 
532
	# then 
562
	if (scalar @_) { 	# if arg remains, it is the borrowernumber of the approver: tag is pre-approved.
533
	if (scalar @_) { 	# if arg remains, it is the borrowernumber of the approver: tag is pre-approved.
563
		my $approver = shift;
534
		my $approver = shift;
564
		$debug and print STDERR "term '$term' pre-approved by borrower #$approver\n";
565
		add_tag_approval($term,$approver,1);
535
		add_tag_approval($term,$approver,1);
566
		add_tag_index($term,$biblionumber,$approver);
536
		add_tag_index($term,$biblionumber,$approver);
567
	} elsif (is_approved($term) >= 1) {
537
	} elsif (is_approved($term) >= 1) {
568
		$debug and print STDERR "term '$term' approved by whitelist\n";
569
		add_tag_approval($term,0,1);
538
		add_tag_approval($term,0,1);
570
		add_tag_index($term,$biblionumber,1);
539
		add_tag_index($term,$biblionumber,1);
571
	} else {
540
	} else {
572
		$debug and print STDERR "term '$term' NOT approved (yet)\n";
573
		add_tag_approval($term);
541
		add_tag_approval($term);
574
		add_tag_index($term,$biblionumber);
542
		add_tag_index($term,$biblionumber);
575
	}
543
	}
(-)a/Koha/Patron/Files.pm (-2 lines)
Lines 22-29 use Modern::Perl; Link Here
22
22
23
use C4::Context;
23
use C4::Context;
24
use C4::Output;
24
use C4::Output;
25
use C4::Debug;
26
27
25
28
=head1 NAME
26
=head1 NAME
29
27
(-)a/acqui/acqui-home.pl (-1 lines)
Lines 34-40 use C4::Output; Link Here
34
use C4::Acquisition;
34
use C4::Acquisition;
35
use C4::Budgets;
35
use C4::Budgets;
36
use C4::Members;
36
use C4::Members;
37
use C4::Debug;
38
use Koha::Acquisition::Currencies;
37
use Koha::Acquisition::Currencies;
39
use Koha::Patrons;
38
use Koha::Patrons;
40
use Koha::Suggestions;
39
use Koha::Suggestions;
(-)a/acqui/basket.pl (-5 lines)
Lines 28-34 use CGI qw ( -utf8 ); Link Here
28
use C4::Acquisition;
28
use C4::Acquisition;
29
use C4::Budgets;
29
use C4::Budgets;
30
use C4::Contract;
30
use C4::Contract;
31
use C4::Debug;
32
use C4::Biblio;
31
use C4::Biblio;
33
use C4::Items;
32
use C4::Items;
34
use C4::Suggestions;
33
use C4::Suggestions;
Lines 313-322 if ( $op eq 'list' ) { Link Here
313
    # if new basket, pre-fill infos
312
    # if new basket, pre-fill infos
314
    $basket->{creationdate} = ""            unless ( $basket->{creationdate} );
313
    $basket->{creationdate} = ""            unless ( $basket->{creationdate} );
315
    $basket->{authorisedby} = $loggedinuser unless ( $basket->{authorisedby} );
314
    $basket->{authorisedby} = $loggedinuser unless ( $basket->{authorisedby} );
316
    $debug
317
      and warn sprintf
318
      "loggedinuser: $loggedinuser; creationdate: %s; authorisedby: %s",
319
      $basket->{creationdate}, $basket->{authorisedby};
320
315
321
    my @basketusers_ids = GetBasketUsers($basketno);
316
    my @basketusers_ids = GetBasketUsers($basketno);
322
    my @basketusers;
317
    my @basketusers;
(-)a/acqui/histsearch.pl (-1 lines)
Lines 54-60 use CGI qw ( -utf8 ); Link Here
54
use C4::Auth;    # get_template_and_user
54
use C4::Auth;    # get_template_and_user
55
use C4::Output;
55
use C4::Output;
56
use C4::Acquisition;
56
use C4::Acquisition;
57
use C4::Debug;
58
use C4::Koha;
57
use C4::Koha;
59
use Koha::AdditionalFields;
58
use Koha::AdditionalFields;
60
use Koha::DateUtils;
59
use Koha::DateUtils;
(-)a/admin/aqbudgetperiods.pl (-1 lines)
Lines 56-62 use C4::Auth; Link Here
56
use C4::Output;
56
use C4::Output;
57
use C4::Acquisition;
57
use C4::Acquisition;
58
use C4::Budgets;
58
use C4::Budgets;
59
use C4::Debug;
60
use Koha::Acquisition::Currencies;
59
use Koha::Acquisition::Currencies;
61
60
62
my $dbh = C4::Context->dbh;
61
my $dbh = C4::Context->dbh;
(-)a/admin/aqbudgets.pl (-1 lines)
Lines 32-38 use C4::Budgets; Link Here
32
use C4::Context;
32
use C4::Context;
33
use C4::Output;
33
use C4::Output;
34
use C4::Koha;
34
use C4::Koha;
35
use C4::Debug;
36
use Koha::Acquisition::Currencies;
35
use Koha::Acquisition::Currencies;
37
use Koha::Patrons;
36
use Koha::Patrons;
38
37
(-)a/admin/aqplan.pl (-1 lines)
Lines 33-39 use C4::Context; Link Here
33
use C4::Output;
33
use C4::Output;
34
use C4::Koha;
34
use C4::Koha;
35
use C4::Auth;
35
use C4::Auth;
36
use C4::Debug;
37
use Koha::Acquisition::Currencies;
36
use Koha::Acquisition::Currencies;
38
37
39
our $input = CGI->new;
38
our $input = CGI->new;
(-)a/admin/clone-rules.pl (-1 lines)
Lines 31-37 use C4::Context; Link Here
31
use C4::Output;
31
use C4::Output;
32
use C4::Auth;
32
use C4::Auth;
33
use C4::Koha;
33
use C4::Koha;
34
use C4::Debug;
35
use Koha::CirculationRules;
34
use Koha::CirculationRules;
36
35
37
my $input = CGI->new;
36
my $input = CGI->new;
(-)a/admin/smart-rules.pl (-3 lines)
Lines 23-29 use C4::Context; Link Here
23
use C4::Output;
23
use C4::Output;
24
use C4::Auth;
24
use C4::Auth;
25
use C4::Koha;
25
use C4::Koha;
26
use C4::Debug;
27
use Koha::DateUtils;
26
use Koha::DateUtils;
28
use Koha::Database;
27
use Koha::Database;
29
use Koha::Logger;
28
use Koha::Logger;
Lines 72-78 $cache->clear_from_cache( Koha::CirculationRules::GUESSED_ITEMTYPES_KEY ); Link Here
72
if ($op eq 'delete') {
71
if ($op eq 'delete') {
73
    my $itemtype     = $input->param('itemtype');
72
    my $itemtype     = $input->param('itemtype');
74
    my $categorycode = $input->param('categorycode');
73
    my $categorycode = $input->param('categorycode');
75
    $debug and warn "deleting $1 $2 $branch";
76
74
77
    Koha::CirculationRules->set_rules(
75
    Koha::CirculationRules->set_rules(
78
        {
76
        {
Lines 289-295 elsif ($op eq 'add') { Link Here
289
    my $cap_fine_to_replacement_price = ($input->param('cap_fine_to_replacement_price') || '') eq 'on';
287
    my $cap_fine_to_replacement_price = ($input->param('cap_fine_to_replacement_price') || '') eq 'on';
290
    my $note = $input->param('note');
288
    my $note = $input->param('note');
291
    my $decreaseloanholds = $input->param('decreaseloanholds') || undef;
289
    my $decreaseloanholds = $input->param('decreaseloanholds') || undef;
292
    $debug and warn "Adding $br, $bor, $itemtype, $fine, $maxissueqty, $maxonsiteissueqty, $cap_fine_to_replacement_price";
293
290
294
    my $rules = {
291
    my $rules = {
295
        maxissueqty                   => $maxissueqty,
292
        maxissueqty                   => $maxissueqty,
(-)a/admin/transport-cost-matrix.pl (-1 lines)
Lines 23-29 use C4::Context; Link Here
23
use C4::Output;
23
use C4::Output;
24
use C4::Auth;
24
use C4::Auth;
25
use C4::Koha;
25
use C4::Koha;
26
use C4::Debug;
27
use C4::HoldsQueue qw(TransportCostMatrix UpdateTransportCostMatrix);
26
use C4::HoldsQueue qw(TransportCostMatrix UpdateTransportCostMatrix);
28
27
29
use Koha::Libraries;
28
use Koha::Libraries;
(-)a/circ/bookcount.pl (-1 lines)
Lines 22-28 Link Here
22
22
23
use Modern::Perl;
23
use Modern::Perl;
24
use CGI qw ( -utf8 );
24
use CGI qw ( -utf8 );
25
use C4::Debug;
26
use C4::Context;
25
use C4::Context;
27
use C4::Circulation;
26
use C4::Circulation;
28
use C4::Output;
27
use C4::Output;
(-)a/circ/branchoverdues.pl (-2 lines)
Lines 24-30 use C4::Auth; Link Here
24
use C4::Overdues;
24
use C4::Overdues;
25
use C4::Biblio;
25
use C4::Biblio;
26
use C4::Koha;
26
use C4::Koha;
27
use C4::Debug;
28
use Koha::DateUtils;
27
use Koha::DateUtils;
29
use Koha::BiblioFrameworks;
28
use Koha::BiblioFrameworks;
30
use Data::Dumper;
29
use Data::Dumper;
Lines 62-68 my $location = $input->param('location'); Link Here
62
61
63
my @overduesloop;
62
my @overduesloop;
64
my @getoverdues = GetOverduesForBranch( $default, $location );
63
my @getoverdues = GetOverduesForBranch( $default, $location );
65
$debug and warn "HERE : $default / $location" . Dumper(@getoverdues);
66
# search for location authorised value
64
# search for location authorised value
67
my ($tag,$subfield) = GetMarcFromKohaField( 'items.location' );
65
my ($tag,$subfield) = GetMarcFromKohaField( 'items.location' );
68
my $tagslib = &GetMarcStructure(1,'');
66
my $tagslib = &GetMarcStructure(1,'');
(-)a/circ/overdue.pl (-8 lines)
Lines 24-30 use C4::Context; Link Here
24
use C4::Output;
24
use C4::Output;
25
use CGI qw(-oldstyle_urls -utf8);
25
use CGI qw(-oldstyle_urls -utf8);
26
use C4::Auth;
26
use C4::Auth;
27
use C4::Debug;
28
use Text::CSV_XS;
27
use Text::CSV_XS;
29
use Koha::DateUtils;
28
use Koha::DateUtils;
30
use DateTime;
29
use DateTime;
Lines 112-118 for my $attrcode (grep { /^patron_attr_filter_/ } $input->multi_param) { Link Here
112
    if (my @attrvalues = grep { length($_) > 0 } $input->multi_param($attrcode)) {
111
    if (my @attrvalues = grep { length($_) > 0 } $input->multi_param($attrcode)) {
113
        $attrcode =~ s/^patron_attr_filter_//;
112
        $attrcode =~ s/^patron_attr_filter_//;
114
        $cgi_attrcode_to_attrvalues{$attrcode} = \@attrvalues;
113
        $cgi_attrcode_to_attrvalues{$attrcode} = \@attrvalues;
115
        print STDERR ">>>param($attrcode)[@{[scalar @attrvalues]}] = '@attrvalues'\n" if $debug;
116
    }
114
    }
117
}
115
}
118
my $have_pattr_filter_data = keys(%cgi_attrcode_to_attrvalues) > 0;
116
my $have_pattr_filter_data = keys(%cgi_attrcode_to_attrvalues) > 0;
Lines 180-191 if (@patron_attr_filter_loop) { Link Here
180
                last;
178
                last;
181
            }
179
            }
182
        }
180
        }
183
        if ($debug) {
184
            my $showkeep = $keep ? 'keep' : 'do NOT keep';
185
            print STDERR ">>> patron $bn: $showkeep attributes: ";
186
            for (sort keys %$pattrs) { my @a=map { "$_->[0]/$_->[1]  " } @{$pattrs->{$_}}; print STDERR "attrcode $_ = [@a] " }
187
            print STDERR "\n";
188
        }
189
        delete $borrowernumber_to_attributes{$bn} if !$keep;
181
        delete $borrowernumber_to_attributes{$bn} if !$keep;
190
    }
182
    }
191
}
183
}
(-)a/circ/pendingreserves.pl (-1 lines)
Lines 28-34 use C4::Context; Link Here
28
use C4::Output;
28
use C4::Output;
29
use CGI qw ( -utf8 );
29
use CGI qw ( -utf8 );
30
use C4::Auth;
30
use C4::Auth;
31
use C4::Debug;
32
use C4::Items qw( ModItemTransfer );
31
use C4::Items qw( ModItemTransfer );
33
use C4::Reserves qw( ModReserveCancelAll );
32
use C4::Reserves qw( ModReserveCancelAll );
34
use Koha::Biblios;
33
use Koha::Biblios;
(-)a/circ/reserveratios.pl (-2 lines)
Lines 27-33 use POSIX qw( ceil ); Link Here
27
use C4::Context;
27
use C4::Context;
28
use C4::Output;
28
use C4::Output;
29
use C4::Auth;
29
use C4::Auth;
30
use C4::Debug;
31
use C4::Acquisition qw/GetOrdersByBiblionumber/;
30
use C4::Acquisition qw/GetOrdersByBiblionumber/;
32
use Koha::DateUtils;
31
use Koha::DateUtils;
33
use Koha::Acquisition::Baskets;
32
use Koha::Acquisition::Baskets;
Lines 84-90 if ($ratio <= 0) { Link Here
84
83
85
my $dbh    = C4::Context->dbh;
84
my $dbh    = C4::Context->dbh;
86
my $sqldatewhere = "";
85
my $sqldatewhere = "";
87
$debug and warn output_pref({ dt => $startdate, dateformat => 'iso', dateonly => 1 }) . "\n" . output_pref({ dt => $enddate, dateformat => 'iso', dateonly => 1 });
88
my @query_params = ();
86
my @query_params = ();
89
87
90
$sqldatewhere .= " AND reservedate >= ?";
88
$sqldatewhere .= " AND reservedate >= ?";
(-)a/installer/data/mysql/backfill_statistics.pl (-6 / +1 lines)
Lines 12-22 use Getopt::Long; Link Here
12
# Koha modules
12
# Koha modules
13
use C4::Context;
13
use C4::Context;
14
use C4::Items;
14
use C4::Items;
15
use C4::Debug;
16
use Data::Dumper;
15
use Data::Dumper;
17
16
18
use vars qw($debug $dbh);
17
my $dbh = C4::Context->dbh;
19
$dbh = C4::Context->dbh;
20
18
21
sub get_counts() {
19
sub get_counts() {
22
	my $query = q(
20
	my $query = q(
Lines 69-80 print "This operation may take a while.\n"; Link Here
69
print "\nAttempting to populate missing data.\n";
67
print "\nAttempting to populate missing data.\n";
70
68
71
my (@itemnumbers) = (scalar @ARGV) ? @ARGV : &itemnumber_array;
69
my (@itemnumbers) = (scalar @ARGV) ? @ARGV : &itemnumber_array;
72
$debug and print "itemnumbers: ", Dumper(\@itemnumbers);
73
print "Number of distinct itemnumbers paired with NULL_ITEMTYPE: ", scalar(@itemnumbers), "\n";
70
print "Number of distinct itemnumbers paired with NULL_ITEMTYPE: ", scalar(@itemnumbers), "\n";
74
71
75
my $query = "UPDATE statistics SET itemtype = ? WHERE itemnumber = ?";
72
my $query = "UPDATE statistics SET itemtype = ? WHERE itemnumber = ?";
76
my $update = $dbh->prepare($query);
73
my $update = $dbh->prepare($query);
77
# $debug and print "Update Query: $query\n";
78
foreach (@itemnumbers) {
74
foreach (@itemnumbers) {
79
    my $item = Koha::Items->find($_);
75
    my $item = Koha::Items->find($_);
80
    unless ($item) {
76
    unless ($item) {
Lines 90-96 my $old_issues = $dbh->prepare("SELECT * FROM old_issues WHERE timestamp = ? AND Link Here
90
my     $issues = $dbh->prepare("SELECT * FROM     issues WHERE timestamp = ? AND itemnumber = ?");
86
my     $issues = $dbh->prepare("SELECT * FROM     issues WHERE timestamp = ? AND itemnumber = ?");
91
$update = $dbh->prepare("UPDATE statistics SET borrowernumber = ? WHERE datetime = ? AND itemnumber = ?");
87
$update = $dbh->prepare("UPDATE statistics SET borrowernumber = ? WHERE datetime = ? AND itemnumber = ?");
92
my $nullborrs = null_borrower_lines;
88
my $nullborrs = null_borrower_lines;
93
$debug and print Dumper($nullborrs);
94
foreach (@$nullborrs) {
89
foreach (@$nullborrs) {
95
	$old_issues->execute($_->{datetime},$_->{itemnumber});
90
	$old_issues->execute($_->{datetime},$_->{itemnumber});
96
	my $issue;
91
	my $issue;
(-)a/koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-review.tt (-4 / +1 lines)
Lines 10-18 Link Here
10
                <div class="col order-first order-md-first order-lg-2">
10
                <div class="col order-first order-md-first order-lg-2">
11
                    <div id="userreview" class="maincontent">
11
                    <div id="userreview" class="maincontent">
12
                        <h1>Reviews</h1>
12
                        <h1>Reviews</h1>
13
                        [% IF ( cgi_debug ) %]
14
                            <div class="debug">CGI debug is on.</div>
15
                        [% END %]
16
                        [% IF ( ERRORS ) %]
13
                        [% IF ( ERRORS ) %]
17
                            <div class="alert alert-warning">
14
                            <div class="alert alert-warning">
18
                                [% FOREACH ERROR IN ERRORS %]
15
                                [% FOREACH ERROR IN ERRORS %]
Lines 42-48 Link Here
42
39
43
                        <h2>Comments on <em>[% INCLUDE 'biblio-title.inc' %]</em></h2>
40
                        <h2>Comments on <em>[% INCLUDE 'biblio-title.inc' %]</em></h2>
44
                        [% IF ( biblio.author ) %]<h3>[% biblio.author | html %]</h3>[% END %]
41
                        [% IF ( biblio.author ) %]<h3>[% biblio.author | html %]</h3>[% END %]
45
                        <form id="reviewf" action="/cgi-bin/koha/opac-review.pl[% IF ( cgi_debug ) %]?debug=1[% END %]" method="post">
42
                        <form id="reviewf" action="/cgi-bin/koha/opac-review.pl" method="post">
46
                            <input type="hidden" name="biblionumber" value="[% biblio.biblionumber | html %]" />
43
                            <input type="hidden" name="biblionumber" value="[% biblio.biblionumber | html %]" />
47
                            [% IF ( reviewid ) %]<input type="hidden" name="reviewid" value="[% reviewid | html %]" />[% END %]
44
                            [% IF ( reviewid ) %]<input type="hidden" name="reviewid" value="[% reviewid | html %]" />[% END %]
48
                            <fieldset>
45
                            <fieldset>
(-)a/labels/label-create-csv.pl (-1 lines)
Lines 24-30 use CGI qw ( -utf8 ); Link Here
24
use Text::CSV_XS;
24
use Text::CSV_XS;
25
use Data::Dumper;
25
use Data::Dumper;
26
26
27
use C4::Debug;
28
use C4::Creators;
27
use C4::Creators;
29
use C4::Labels;
28
use C4::Labels;
30
29
(-)a/labels/label-create-pdf.pl (-1 lines)
Lines 22-28 use Modern::Perl; Link Here
22
22
23
use CGI qw ( -utf8 );
23
use CGI qw ( -utf8 );
24
use C4::Auth;
24
use C4::Auth;
25
use C4::Debug;
26
use C4::Creators;
25
use C4::Creators;
27
use C4::Labels;
26
use C4::Labels;
28
27
(-)a/labels/label-create-xml.pl (-1 lines)
Lines 24-30 use CGI qw ( -utf8 ); Link Here
24
use XML::Simple;
24
use XML::Simple;
25
use Data::Dumper;
25
use Data::Dumper;
26
26
27
use C4::Debug;
28
use C4::Creators;
27
use C4::Creators;
29
use C4::Labels;
28
use C4::Labels;
30
29
(-)a/labels/label-item-search.pl (-11 / +2 lines)
Lines 18-24 Link Here
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
use vars qw($debug $cgi_debug);
22
21
23
use CGI qw ( -utf8 );
22
use CGI qw ( -utf8 );
24
use List::Util qw( max min );
23
use List::Util qw( max min );
Lines 30-50 use C4::Context; Link Here
30
use C4::Search qw(SimpleSearch);
29
use C4::Search qw(SimpleSearch);
31
use C4::Biblio qw(TransformMarcToKoha);
30
use C4::Biblio qw(TransformMarcToKoha);
32
use C4::Creators::Lib qw(html_table);
31
use C4::Creators::Lib qw(html_table);
33
use C4::Debug;
34
32
33
use Koha::Logger;
35
use Koha::DateUtils;
34
use Koha::DateUtils;
36
use Koha::Items;
35
use Koha::Items;
37
use Koha::ItemTypes;
36
use Koha::ItemTypes;
38
use Koha::SearchEngine::Search;
37
use Koha::SearchEngine::Search;
39
38
40
BEGIN {
41
    $debug = $debug || $cgi_debug;
42
    if ($debug) {
43
        require Data::Dumper;
44
        import Data::Dumper qw(Dumper);
45
    }
46
}
47
48
my $query = CGI->new;
39
my $query = CGI->new;
49
40
50
my $type      = $query->param('type');
41
my $type      = $query->param('type');
Lines 102-108 if ( $op eq "do_search" ) { Link Here
102
        $show_results = @{$marcresults};
93
        $show_results = @{$marcresults};
103
    }
94
    }
104
    else {
95
    else {
105
        $debug and warn "ERROR label-item-search: no results from simple_search_compat";
96
        Koha::Logger->get->warn("ERROR label-item-search: no results from simple_search_compat");
106
97
107
        # leave $show_results undef
98
        # leave $show_results undef
108
    }
99
    }
(-)a/members/files.pl (-1 lines)
Lines 24-30 use CGI qw ( -utf8 ); Link Here
24
use C4::Auth;
24
use C4::Auth;
25
use C4::Output;
25
use C4::Output;
26
use C4::Members;
26
use C4::Members;
27
use C4::Debug;
28
27
29
use Koha::DateUtils;
28
use Koha::DateUtils;
30
use Koha::Patrons;
29
use Koha::Patrons;
(-)a/misc/cronjobs/gather_print_notices.pl (-1 lines)
Lines 12-18 BEGIN { Link Here
12
use CGI qw( utf8 ); # NOT a CGI script, this is just to keep C4::Templates::gettemplate happy
12
use CGI qw( utf8 ); # NOT a CGI script, this is just to keep C4::Templates::gettemplate happy
13
use Koha::Script -cron;
13
use Koha::Script -cron;
14
use C4::Context;
14
use C4::Context;
15
use C4::Debug;
16
use C4::Letters;
15
use C4::Letters;
17
use C4::Templates;
16
use C4::Templates;
18
use File::Spec;
17
use File::Spec;
(-)a/misc/cronjobs/serialsUpdate.pl (-1 lines)
Lines 30-36 BEGIN { Link Here
30
30
31
use Koha::Script -cron;
31
use Koha::Script -cron;
32
use C4::Context;
32
use C4::Context;
33
use C4::Debug;
34
use C4::Serials;
33
use C4::Serials;
35
use C4::Log;
34
use C4::Log;
36
use Koha::DateUtils;
35
use Koha::DateUtils;
(-)a/misc/cronjobs/staticfines.pl (-1 lines)
Lines 43-49 use C4::Circulation; Link Here
43
use C4::Overdues;
43
use C4::Overdues;
44
use C4::Calendar qw();    # don't need any exports from Calendar
44
use C4::Calendar qw();    # don't need any exports from Calendar
45
use C4::Biblio;
45
use C4::Biblio;
46
use C4::Debug;            # supplying $debug and $cgi_debug
47
use C4::Log;
46
use C4::Log;
48
use Getopt::Long;
47
use Getopt::Long;
49
use List::MoreUtils qw/none/;
48
use List::MoreUtils qw/none/;
(-)a/misc/load_testing/benchmark_staff.pl (-2 lines)
Lines 17-23 use LWP::UserAgent; Link Here
17
use Data::Dumper;
17
use Data::Dumper;
18
use HTTP::Cookies;
18
use HTTP::Cookies;
19
use C4::Context;
19
use C4::Context;
20
use C4::Debug;
21
use URI::Escape;
20
use URI::Escape;
22
use Koha::Patrons;
21
use Koha::Patrons;
23
22
Lines 82-88 if( $resp->is_success and $resp->content =~ m|<status>ok</status>| ) { Link Here
82
    $cookie = $cookie_jar->as_string;
81
    $cookie = $cookie_jar->as_string;
83
    unless ($short_print) {
82
    unless ($short_print) {
84
        print "Authentication successful\n";
83
        print "Authentication successful\n";
85
        print "Auth:\n $resp->content" if $debug;
86
    }
84
    }
87
} elsif ( $resp->is_success ) {
85
} elsif ( $resp->is_success ) {
88
    die "Authentication failure: bad login/password";
86
    die "Authentication failure: bad login/password";
(-)a/misc/migration_tools/bulkmarcimport.pl (-8 / +7 lines)
Lines 22-28 use Koha::Script; Link Here
22
use C4::Context;
22
use C4::Context;
23
use C4::Biblio;
23
use C4::Biblio;
24
use C4::Koha;
24
use C4::Koha;
25
use C4::Debug;
26
use C4::Charset;
25
use C4::Charset;
27
use C4::Items;
26
use C4::Items;
28
use C4::MarcModificationTemplates;
27
use C4::MarcModificationTemplates;
Lines 34-39 use Getopt::Long; Link Here
34
use IO::File;
33
use IO::File;
35
use Pod::Usage;
34
use Pod::Usage;
36
35
36
use Koha::Logger;
37
use Koha::Biblios;
37
use Koha::Biblios;
38
use Koha::SearchEngine;
38
use Koha::SearchEngine;
39
use Koha::SearchEngine::Search;
39
use Koha::SearchEngine::Search;
Lines 259-264 if ($logfile){ Link Here
259
   print $loghandle "id;operation;status\n";
259
   print $loghandle "id;operation;status\n";
260
}
260
}
261
261
262
my $logger = Koha::Logger->get;
262
my $schema = Koha::Database->schema;
263
my $schema = Koha::Database->schema;
263
$schema->txn_begin;
264
$schema->txn_begin;
264
RECORD: while (  ) {
265
RECORD: while (  ) {
Lines 317-323 RECORD: while ( ) { Link Here
317
        require C4::Search;
318
        require C4::Search;
318
        my $query = build_query( $match, $record );
319
        my $query = build_query( $match, $record );
319
        my $server = ( $authorities ? 'authorityserver' : 'biblioserver' );
320
        my $server = ( $authorities ? 'authorityserver' : 'biblioserver' );
320
        $debug && warn $query;
321
        my ( $error, $results, $totalhits ) = $searcher->simple_search_compat( $query, 0, 3, [$server] );
321
        my ( $error, $results, $totalhits ) = $searcher->simple_search_compat( $query, 0, 3, [$server] );
322
        # changed to warn so able to continue with one broken record
322
        # changed to warn so able to continue with one broken record
323
        if ( defined $error ) {
323
        if ( defined $error ) {
Lines 325-331 RECORD: while ( ) { Link Here
325
            printlog( { id => $id || $originalid || $match, op => "match", status => "ERROR" } ) if ($logfile);
325
            printlog( { id => $id || $originalid || $match, op => "match", status => "ERROR" } ) if ($logfile);
326
            next RECORD;
326
            next RECORD;
327
        }
327
        }
328
        $debug && warn "$query $server : $totalhits";
329
        if ( $results && scalar(@$results) == 1 ) {
328
        if ( $results && scalar(@$results) == 1 ) {
330
            my $marcrecord = C4::Search::new_record_from_zebra( $server, $results->[0] );
329
            my $marcrecord = C4::Search::new_record_from_zebra( $server, $results->[0] );
331
            SetUTF8Flag($marcrecord);
330
            SetUTF8Flag($marcrecord);
Lines 350-358 RECORD: while ( ) { Link Here
350
                }
349
                }
351
            }
350
            }
352
        } elsif ( $results && scalar(@$results) > 1 ) {
351
        } elsif ( $results && scalar(@$results) > 1 ) {
353
            $debug && warn "more than one match for $query";
352
            $logger->debug("more than one match for $query");
354
        } else {
353
        } else {
355
            $debug && warn "nomatch for $query";
354
            $logger->debug("nomatch for $query");
356
        }
355
        }
357
    }
356
    }
358
    if ($keepids && $originalid) {
357
    if ($keepids && $originalid) {
Lines 369-375 RECORD: while ( ) { Link Here
369
        if ( length($stringfilter) == 3 ) {
368
        if ( length($stringfilter) == 3 ) {
370
            foreach my $field ( $record->field($stringfilter) ) {
369
            foreach my $field ( $record->field($stringfilter) ) {
371
                $record->delete_field($field);
370
                $record->delete_field($field);
372
                $debug && warn "removed : ", $field->as_string;
371
                $logger->debug("removed : ", $field->as_string);
373
            }
372
            }
374
        } elsif ($stringfilter =~ /([0-9]{3})([a-z0-9])(.*)/) {
373
        } elsif ($stringfilter =~ /([0-9]{3})([a-z0-9])(.*)/) {
375
            my $removetag = $1;
374
            my $removetag = $1;
Lines 378-384 RECORD: while ( ) { Link Here
378
            if ( ( $removetag > "010" ) && $removesubfield ) {
377
            if ( ( $removetag > "010" ) && $removesubfield ) {
379
                foreach my $field ( $record->field($removetag) ) {
378
                foreach my $field ( $record->field($removetag) ) {
380
                    $field->delete_subfield( code => "$removesubfield", match => $removematch );
379
                    $field->delete_subfield( code => "$removesubfield", match => $removematch );
381
                    $debug && warn "Potentially removed : ", $field->subfield($removesubfield);
380
                    $logger->debug("Potentially removed : ", $field->subfield($removesubfield));
382
                }
381
                }
383
            }
382
            }
384
        }
383
        }
Lines 634-640 sub get_heading_fields{ Link Here
634
    if ($authtypes){
633
    if ($authtypes){
635
        $headingfields = YAML::XS::LoadFile($authtypes);
634
        $headingfields = YAML::XS::LoadFile($authtypes);
636
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
635
        $headingfields={C4::Context->preference('marcflavour')=>$headingfields};
637
        $debug && warn Encode::decode_utf8(YAML::XS::Dump($headingfields));
636
        $logger->debug(Encode::decode_utf8(YAML::XS::Dump($headingfields)));
638
    }
637
    }
639
    unless ($headingfields){
638
    unless ($headingfields){
640
        $headingfields=$dbh->selectall_hashref("SELECT auth_tag_to_report, authtypecode from auth_types",'auth_tag_to_report',{Slice=>{}});
639
        $headingfields=$dbh->selectall_hashref("SELECT auth_tag_to_report, authtypecode from auth_types",'auth_tag_to_report',{Slice=>{}});
(-)a/opac/opac-discharge.pl (-1 lines)
Lines 25-31 use CGI qw( -utf8 ); Link Here
25
use C4::Context;
25
use C4::Context;
26
use C4::Output;
26
use C4::Output;
27
use C4::Log;
27
use C4::Log;
28
use C4::Debug;
29
use Koha::Patrons;
28
use Koha::Patrons;
30
use Koha::Patron::Discharge;
29
use Koha::Patron::Discharge;
31
use Koha::DateUtils;
30
use Koha::DateUtils;
(-)a/opac/opac-ratings-ajax.pl (-1 lines)
Lines 30-36 use CGI::Cookie; # need to check cookies before having CGI parse the POST reque Link Here
30
30
31
use C4::Auth qw(:DEFAULT check_cookie_auth);
31
use C4::Auth qw(:DEFAULT check_cookie_auth);
32
use C4::Context;
32
use C4::Context;
33
use C4::Debug;
34
use C4::Output qw(:html :ajax pagination_bar);
33
use C4::Output qw(:html :ajax pagination_bar);
35
34
36
use Koha::Ratings;
35
use Koha::Ratings;
(-)a/opac/opac-ratings.pl (-1 lines)
Lines 30-36 use CGI qw ( -utf8 ); Link Here
30
30
31
use C4::Auth;
31
use C4::Auth;
32
use C4::Context;
32
use C4::Context;
33
use C4::Debug;
34
33
35
use Koha::Ratings;
34
use Koha::Ratings;
36
35
(-)a/opac/opac-reserve.pl (-1 lines)
Lines 31-37 use C4::Output; Link Here
31
use C4::Context;
31
use C4::Context;
32
use C4::Members;
32
use C4::Members;
33
use C4::Overdues;
33
use C4::Overdues;
34
use C4::Debug;
35
34
36
use Koha::AuthorisedValues;
35
use Koha::AuthorisedValues;
37
use Koha::Biblios;
36
use Koha::Biblios;
(-)a/opac/opac-review.pl (-2 lines)
Lines 24-30 use C4::Koha; Link Here
24
use C4::Output;
24
use C4::Output;
25
use C4::Biblio;
25
use C4::Biblio;
26
use C4::Scrubber;
26
use C4::Scrubber;
27
use C4::Debug;
28
27
29
use Koha::Biblios;
28
use Koha::Biblios;
30
use Koha::DateUtils;
29
use Koha::DateUtils;
Lines 93-99 if( !@errors && defined $review ) { Link Here
93
	}
92
	}
94
}
93
}
95
(@errors   ) and $template->param(   ERRORS=>\@errors);
94
(@errors   ) and $template->param(   ERRORS=>\@errors);
96
($cgi_debug) and $template->param(cgi_debug=>1       );
97
$review = $clean;
95
$review = $clean;
98
$review ||= $savedreview->review if $savedreview;
96
$review ||= $savedreview->review if $savedreview;
99
$template->param(
97
$template->param(
(-)a/opac/opac-search-history.pl (-1 lines)
Lines 25-31 use C4::Context; Link Here
25
use C4::Output;
25
use C4::Output;
26
use C4::Log;
26
use C4::Log;
27
use C4::Items;
27
use C4::Items;
28
use C4::Debug;
29
use C4::Search::History;
28
use C4::Search::History;
30
29
31
use URI::Escape;
30
use URI::Escape;
(-)a/opac/opac-tags.pl (-8 / +2 lines)
Lines 37-43 use CGI::Cookie; # need to check cookies before having CGI parse the POST reques Link Here
37
37
38
use C4::Auth qw(:DEFAULT check_cookie_auth);
38
use C4::Auth qw(:DEFAULT check_cookie_auth);
39
use C4::Context;
39
use C4::Context;
40
use C4::Debug;
41
use C4::Output qw(:html :ajax );
40
use C4::Output qw(:html :ajax );
42
use C4::Scrubber;
41
use C4::Scrubber;
43
use C4::Biblio;
42
use C4::Biblio;
Lines 47-52 use C4::XSLT; Link Here
47
46
48
use Data::Dumper;
47
use Data::Dumper;
49
48
49
use Koha::Logger;
50
use Koha::Biblios;
50
use Koha::Biblios;
51
use Koha::CirculationRules;
51
use Koha::CirculationRules;
52
52
Lines 65-80 sub ajax_auth_cgi { # returns CGI object Link Here
65
	my $input = CGI->new;
65
	my $input = CGI->new;
66
    my $sessid = $cookies{'CGISESSID'}->value;
66
    my $sessid = $cookies{'CGISESSID'}->value;
67
	my ($auth_status, $auth_sessid) = check_cookie_auth($sessid, $needed_flags);
67
	my ($auth_status, $auth_sessid) = check_cookie_auth($sessid, $needed_flags);
68
	$debug and
69
	print STDERR "($auth_status, $auth_sessid) = check_cookie_auth($sessid," . Dumper($needed_flags) . ")\n";
70
	if ($auth_status ne "ok") {
68
	if ($auth_status ne "ok") {
71
		output_with_http_headers $input, undef,
69
		output_with_http_headers $input, undef,
72
		"window.alert('Your CGI session cookie ($sessid) is not current.  " .
70
		"window.alert('Your CGI session cookie ($sessid) is not current.  " .
73
		"Please refresh the page and try again.');\n", 'js';
71
		"Please refresh the page and try again.');\n", 'js';
74
		exit 0;
72
		exit 0;
75
	}
73
	}
76
	$debug and print STDERR "AJAX request: " . Dumper($input),
77
		"\n(\$auth_status,\$auth_sessid) = ($auth_status,$auth_sessid)\n";
78
	return $input;
74
	return $input;
79
}
75
}
80
76
Lines 91-97 foreach ($query->param) { Link Here
91
    if (/^newtag(.*)/) {
87
    if (/^newtag(.*)/) {
92
        my $biblionumber = $1;
88
        my $biblionumber = $1;
93
        unless ($biblionumber =~ /^\d+$/) {
89
        unless ($biblionumber =~ /^\d+$/) {
94
            $debug and warn "$_ references non numerical biblionumber '$biblionumber'";
95
            push @errors, {+'badparam' => $_ };
90
            push @errors, {+'badparam' => $_ };
96
            push @globalErrorIndexes, $#errors;
91
            push @globalErrorIndexes, $#errors;
97
            next;
92
            next;
Lines 106-112 my $add_op = (scalar(keys %newtags) + scalar(@deltags)) ? 1 : 0; Link Here
106
my ($template, $loggedinuser, $cookie);
101
my ($template, $loggedinuser, $cookie);
107
if ($is_ajax) {
102
if ($is_ajax) {
108
	$loggedinuser = C4::Context->userenv->{'number'};  # must occur AFTER auth
103
	$loggedinuser = C4::Context->userenv->{'number'};  # must occur AFTER auth
109
	$debug and print STDERR "op: $loggedinuser\n";
110
} else {
104
} else {
111
	($template, $loggedinuser, $cookie) = get_template_and_user({
105
	($template, $loggedinuser, $cookie) = get_template_and_user({
112
        template_name   => "opac-tags.tt",
106
        template_name   => "opac-tags.tt",
Lines 159-165 if (scalar @newtags_keys) { Link Here
159
			} else {
153
			} else {
160
				push @errors, {failed_add_tag=>$clean_tag};
154
				push @errors, {failed_add_tag=>$clean_tag};
161
				push @{$bibResults->{errors}}, {failed_add_tag=>$clean_tag};
155
				push @{$bibResults->{errors}}, {failed_add_tag=>$clean_tag};
162
				$debug and warn "add_tag($biblionumber,$clean_tag,$loggedinuser...) returned bad result (" . (defined $result ? $result : 'UNDEF') .")";
156
                Koha::Logger->get->warn("add_tag($biblionumber,$clean_tag,$loggedinuser...) returned bad result (" . (defined $result ? $result : 'UNDEF') .")");
163
			}
157
			}
164
		}
158
		}
165
        $perBibResults->{$biblionumber} = $bibResults;
159
        $perBibResults->{$biblionumber} = $bibResults;
(-)a/patroncards/create-pdf.pl (-1 lines)
Lines 26-32 use POSIX qw(ceil); Link Here
26
use Storable qw(dclone);
26
use Storable qw(dclone);
27
use autouse 'Data::Dumper' => qw(Dumper);
27
use autouse 'Data::Dumper' => qw(Dumper);
28
28
29
use C4::Debug;
30
use C4::Context;
29
use C4::Context;
31
use C4::Creators;
30
use C4::Creators;
32
use C4::Patroncards;
31
use C4::Patroncards;
(-)a/patroncards/image-manage.pl (-1 lines)
Lines 9-15 use POSIX qw(ceil); Link Here
9
use C4::Context;
9
use C4::Context;
10
use C4::Auth;
10
use C4::Auth;
11
use C4::Output;
11
use C4::Output;
12
use C4::Debug;
13
use C4::Creators;
12
use C4::Creators;
14
use C4::Patroncards;
13
use C4::Patroncards;
15
14
(-)a/plugins/plugins-home.pl (-1 lines)
Lines 27-33 use LWP::Simple qw(get); Link Here
27
use Koha::Plugins;
27
use Koha::Plugins;
28
use C4::Auth;
28
use C4::Auth;
29
use C4::Output;
29
use C4::Output;
30
use C4::Debug;
31
use C4::Context;
30
use C4::Context;
32
31
33
my $plugins_enabled = C4::Context->config("enable_plugins");
32
my $plugins_enabled = C4::Context->config("enable_plugins");
(-)a/plugins/plugins-uninstall.pl (-1 lines)
Lines 26-32 use C4::Context; Link Here
26
use C4::Auth;
26
use C4::Auth;
27
use C4::Output;
27
use C4::Output;
28
use C4::Members;
28
use C4::Members;
29
use C4::Debug;
30
use Koha::Plugins::Handler;
29
use Koha::Plugins::Handler;
31
30
32
die("Koha plugins are disabled!") unless C4::Context->config("enable_plugins");
31
die("Koha plugins are disabled!") unless C4::Context->config("enable_plugins");
(-)a/plugins/plugins-upload.pl (-4 / +1 lines)
Lines 28-34 use C4::Context; Link Here
28
use C4::Auth;
28
use C4::Auth;
29
use C4::Output;
29
use C4::Output;
30
use C4::Members;
30
use C4::Members;
31
use C4::Debug;
31
use Koha::Logger;
32
use Koha::Plugins;
32
use Koha::Plugins;
33
33
34
my $plugins_enabled = C4::Context->config("enable_plugins");
34
my $plugins_enabled = C4::Context->config("enable_plugins");
Lines 58-71 if ($plugins_enabled) { Link Here
58
        $plugins_dir = ref($plugins_dir) eq 'ARRAY' ? $plugins_dir->[0] : $plugins_dir;
58
        $plugins_dir = ref($plugins_dir) eq 'ARRAY' ? $plugins_dir->[0] : $plugins_dir;
59
59
60
        my $dirname = File::Temp::tempdir( CLEANUP => 1 );
60
        my $dirname = File::Temp::tempdir( CLEANUP => 1 );
61
        $debug and warn "dirname = $dirname";
62
61
63
        my $filesuffix;
62
        my $filesuffix;
64
        $filesuffix = $1 if $uploadfilename =~ m/(\..+)$/i;
63
        $filesuffix = $1 if $uploadfilename =~ m/(\..+)$/i;
65
        ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
64
        ( $tfh, $tempfile ) = File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
66
65
67
        $debug and warn "tempfile = $tempfile";
68
69
        $errors{'NOTKPZ'} = 1 if ( $uploadfilename !~ /\.kpz$/i );
66
        $errors{'NOTKPZ'} = 1 if ( $uploadfilename !~ /\.kpz$/i );
70
        $errors{'NOWRITETEMP'}    = 1 unless ( -w $dirname );
67
        $errors{'NOWRITETEMP'}    = 1 unless ( -w $dirname );
71
        $errors{'NOWRITEPLUGINS'} = 1 unless ( -w $plugins_dir );
68
        $errors{'NOWRITEPLUGINS'} = 1 unless ( -w $plugins_dir );
(-)a/plugins/run.pl (-1 lines)
Lines 24-30 use CGI qw ( -utf8 ); Link Here
24
use Koha::Plugins::Handler;
24
use Koha::Plugins::Handler;
25
use C4::Auth;
25
use C4::Auth;
26
use C4::Output;
26
use C4::Output;
27
use C4::Debug;
28
use C4::Context;
27
use C4::Context;
29
28
30
my $plugins_enabled = C4::Context->config("enable_plugins");
29
my $plugins_enabled = C4::Context->config("enable_plugins");
(-)a/reports/catalogue_out.pl (-10 lines)
Lines 22-28 use CGI qw ( -utf8 ); Link Here
22
22
23
use C4::Auth;
23
use C4::Auth;
24
use C4::Context;
24
use C4::Context;
25
use C4::Debug;
26
use C4::Output;
25
use C4::Output;
27
# use Date::Manip;  # TODO: add not borrowed since date X criteria
26
# use Date::Manip;  # TODO: add not borrowed since date X criteria
28
use Data::Dumper;
27
use Data::Dumper;
Lines 102-108 sub calculate { Link Here
102
        }
101
        }
103
        $strsth2 .= " GROUP BY $column ORDER BY $column ";    # needed for count
102
        $strsth2 .= " GROUP BY $column ORDER BY $column ";    # needed for count
104
        push @loopfilter, { crit => 'SQL', sql => 1, filter => $strsth2 };
103
        push @loopfilter, { crit => 'SQL', sql => 1, filter => $strsth2 };
105
        $debug and warn "catalogue_out SQL: " . $strsth2;
106
        my $sth2 = $dbh->prepare($strsth2);
104
        my $sth2 = $dbh->prepare($strsth2);
107
        $sth2->execute;
105
        $sth2->execute;
108
106
Lines 151-159 sub calculate { Link Here
151
    }
149
    }
152
    $query .= " ORDER BY items.itemcallnumber DESC, barcode";
150
    $query .= " ORDER BY items.itemcallnumber DESC, barcode";
153
    $query .= " LIMIT 0,$limit" if ($limit);
151
    $query .= " LIMIT 0,$limit" if ($limit);
154
    $debug and warn "SQL : $query";
155
152
156
    # warn "SQL : $query";
157
    push @loopfilter, { crit => 'SQL', sql => 1, filter => $query };
153
    push @loopfilter, { crit => 'SQL', sql => 1, filter => $query };
158
    my $dbcalc = $dbh->prepare($query);
154
    my $dbcalc = $dbh->prepare($query);
159
155
Lines 185-196 sub calculate { Link Here
185
        my (@temptable);
181
        my (@temptable);
186
        my $i = 0;
182
        my $i = 0;
187
        foreach my $cell ( @{ $tables{$tablename} } ) {
183
        foreach my $cell ( @{ $tables{$tablename} } ) {
188
            if ( 0 == $i++ and $debug ) {
189
                my $dump = Dumper($cell);
190
                $dump =~ s/\n/ /gs;
191
                $dump =~ s/\s+/ /gs;
192
                print STDERR "first cell for $tablename: $dump";
193
            }
194
            push @temptable, $cell;
184
            push @temptable, $cell;
195
        }
185
        }
196
        my $count    = scalar(@temptable);
186
        my $count    = scalar(@temptable);
(-)a/reports/guided_reports.pl (-1 lines)
Lines 27-33 use C4::Reports::Guided; Link Here
27
use Koha::Reports;
27
use Koha::Reports;
28
use C4::Auth qw/:DEFAULT get_session/;
28
use C4::Auth qw/:DEFAULT get_session/;
29
use C4::Output;
29
use C4::Output;
30
use C4::Debug;
31
use C4::Context;
30
use C4::Context;
32
use Koha::Caches;
31
use Koha::Caches;
33
use C4::Log;
32
use C4::Log;
(-)a/reports/issues_stats.pl (-9 lines)
Lines 23-29 use CGI qw ( -utf8 ); Link Here
23
use Date::Manip;
23
use Date::Manip;
24
24
25
use C4::Auth;
25
use C4::Auth;
26
use C4::Debug;
27
use C4::Context;
26
use C4::Context;
28
use C4::Koha;
27
use C4::Koha;
29
use C4::Output;
28
use C4::Output;
Lines 46-52 Plugin that shows circulation stats Link Here
46
45
47
=cut
46
=cut
48
47
49
# my $debug = 1;	# override for now.
50
my $input = CGI->new;
48
my $input = CGI->new;
51
my $fullreportname = "reports/issues_stats.tt";
49
my $fullreportname = "reports/issues_stats.tt";
52
my $do_it    = $input->param('do_it');
50
my $do_it    = $input->param('do_it');
Lines 245-251 sub calculate { Link Here
245
    push @loopfilter, { crit => "Select Month", filter => $monthsel } if ($monthsel);
243
    push @loopfilter, { crit => "Select Month", filter => $monthsel } if ($monthsel);
246
244
247
    my @linefilter;
245
    my @linefilter;
248
    $debug and warn "filtres " . join "|", @$filters;
249
    my ( $colsource, $linesource ) = ('', '');
246
    my ( $colsource, $linesource ) = ('', '');
250
    $linefilter[1] = @$filters[1] if ( $line =~ /datetime/ );
247
    $linefilter[1] = @$filters[1] if ( $line =~ /datetime/ );
251
    $linefilter[0] =
248
    $linefilter[0] =
Lines 337-343 sub calculate { Link Here
337
        $strsth .= " AND $line LIKE ? ";
334
        $strsth .= " AND $line LIKE ? ";
338
    }
335
    }
339
    $strsth .= " group by $linefield order by $lineorder ";
336
    $strsth .= " group by $linefield order by $lineorder ";
340
    $debug and warn $strsth;
341
    push @loopfilter, { crit => 'SQL =', sql => 1, filter => $strsth };
337
    push @loopfilter, { crit => 'SQL =', sql => 1, filter => $strsth };
342
    my $sth = $dbh->prepare($strsth);
338
    my $sth = $dbh->prepare($strsth);
343
    if ( (@linefilter) and ($linefilter[0]) and ($linefilter[1]) ) {
339
    if ( (@linefilter) and ($linefilter[0]) and ($linefilter[1]) ) {
Lines 427-433 sub calculate { Link Here
427
    }
423
    }
428
424
429
    $strsth2 .= " group by $colfield order by $colorder ";
425
    $strsth2 .= " group by $colfield order by $colorder ";
430
    $debug and warn $strsth2;
431
    push @loopfilter, { crit => 'SQL =', sql => 1, filter => $strsth2 };
426
    push @loopfilter, { crit => 'SQL =', sql => 1, filter => $strsth2 };
432
    my $sth2 = $dbh->prepare($strsth2);
427
    my $sth2 = $dbh->prepare($strsth2);
433
    if ( (@colfilter) and ($colfilter[0]) and ($colfilter[1]) ) {
428
    if ( (@colfilter) and ($colfilter[0]) and ($colfilter[1]) ) {
Lines 470-476 sub calculate { Link Here
470
    my %table;
465
    my %table;
471
    foreach my $row (@loopline) {
466
    foreach my $row (@loopline) {
472
        foreach my $col (@loopcol) {
467
        foreach my $col (@loopcol) {
473
            $debug and warn " init table : $row->{rowtitle} ( $row->{rowtitle_display} ) / $col->{coltitle} ( $col->{coltitle_display} )  ";
474
            table_set(\%table, $row->{rowtitle}, $col->{coltitle}, 0);
468
            table_set(\%table, $row->{rowtitle}, $col->{coltitle}, 0);
475
        }
469
        }
476
        table_set(\%table, $row->{rowtitle}, 'totalrow', 0);
470
        table_set(\%table, $row->{rowtitle}, 'totalrow', 0);
Lines 568-580 sub calculate { Link Here
568
        $strcalc .= " $colorder ";
562
        $strcalc .= " $colorder ";
569
    }
563
    }
570
564
571
    ($debug) and warn $strcalc;
572
    my $dbcalc = $dbh->prepare($strcalc);
565
    my $dbcalc = $dbh->prepare($strcalc);
573
    push @loopfilter, { crit => 'SQL =', sql => 1, filter => $strcalc };
566
    push @loopfilter, { crit => 'SQL =', sql => 1, filter => $strcalc };
574
    $dbcalc->execute;
567
    $dbcalc->execute;
575
    my ( $emptycol, $emptyrow );
568
    my ( $emptycol, $emptyrow );
576
    while ( my ( $row, $col, $value ) = $dbcalc->fetchrow ) {
569
    while ( my ( $row, $col, $value ) = $dbcalc->fetchrow ) {
577
        ($debug) and warn "filling table $row / $col / $value ";
578
        unless ( defined $col ) {
570
        unless ( defined $col ) {
579
            $emptycol = 1;
571
            $emptycol = 1;
580
        }
572
        }
Lines 608-614 sub calculate { Link Here
608
        my $total = 0;
600
        my $total = 0;
609
        foreach my $row (@looprow) {
601
        foreach my $row (@looprow) {
610
            $total += table_get(\%table, $row->{rowtitle}, $col->{coltitle}) || 0;
602
            $total += table_get(\%table, $row->{rowtitle}, $col->{coltitle}) || 0;
611
            $debug and warn "value added " . table_get(\%table, $row->{rowtitle}, $col->{coltitle}) . "for line " . $row->{rowtitle};
612
        }
603
        }
613
        push @loopfooter, { 'totalcol' => $total };
604
        push @loopfooter, { 'totalcol' => $total };
614
    }
605
    }
(-)a/reports/reserves_stats.pl (-4 lines)
Lines 22-28 use Modern::Perl; Link Here
22
use CGI qw ( -utf8 );
22
use CGI qw ( -utf8 );
23
23
24
use C4::Auth;
24
use C4::Auth;
25
use C4::Debug;
26
use C4::Context;
25
use C4::Context;
27
use C4::Koha;
26
use C4::Koha;
28
use C4::Output;
27
use C4::Output;
Lines 45-51 Plugin that shows reserve stats Link Here
45
44
46
=cut
45
=cut
47
46
48
# my $debug = 1;	# override for now.
49
my $input = CGI->new;
47
my $input = CGI->new;
50
my $fullreportname = "reports/reserves_stats.tt";
48
my $fullreportname = "reports/reserves_stats.tt";
51
my $do_it    = $input->param('do_it');
49
my $do_it    = $input->param('do_it');
Lines 248-254 sub calculate { Link Here
248
	$strcalc .= " WHERE ".join(" AND ",@sqlwhere) if (@sqlwhere);
246
	$strcalc .= " WHERE ".join(" AND ",@sqlwhere) if (@sqlwhere);
249
	$strcalc .= " AND (".join(" OR ",@sqlor).")" if (@sqlor);
247
	$strcalc .= " AND (".join(" OR ",@sqlor).")" if (@sqlor);
250
	$strcalc .= " GROUP BY line, col )";
248
	$strcalc .= " GROUP BY line, col )";
251
	($debug) and print STDERR $strcalc;
252
	my $dbcalc = $dbh->prepare($strcalc);
249
	my $dbcalc = $dbh->prepare($strcalc);
253
	push @loopfilter, {crit=>'SQL =', sql=>1, filter=>$strcalc};
250
	push @loopfilter, {crit=>'SQL =', sql=>1, filter=>$strcalc};
254
	@sqlparams=(@sqlparams,@sqlorparams);
251
	@sqlparams=(@sqlparams,@sqlorparams);
Lines 284-290 sub calculate { Link Here
284
		my $total = 0;
281
		my $total = 0;
285
		foreach my $row (@loopline) {
282
		foreach my $row (@loopline) {
286
			$total += $data->{$row}{$col}{calculation} if $data->{$row}{$col}{calculation};
283
			$total += $data->{$row}{$col}{calculation} if $data->{$row}{$col}{calculation};
287
			$debug and warn "value added ".$$data{$row}{$col}{calculation}. "for line ".$row;
288
		}
284
		}
289
		push @loopfooter, {'totalcol' => $total};
285
		push @loopfooter, {'totalcol' => $total};
290
		push @loopcol, {'coltitle' => $col,
286
		push @loopcol, {'coltitle' => $col,
(-)a/serials/subscription-bib-search.pl (-2 lines)
Lines 55-61 use C4::Context; Link Here
55
use C4::Output;
55
use C4::Output;
56
use C4::Search;
56
use C4::Search;
57
use C4::Biblio;
57
use C4::Biblio;
58
use C4::Debug;
59
58
60
use Koha::ItemTypes;
59
use Koha::ItemTypes;
61
use Koha::SearchEngine;
60
use Koha::SearchEngine;
Lines 93-99 if ( $op eq "do_search" && $query ) { Link Here
93
    my $op = 'and';
92
    my $op = 'and';
94
    $query .= " $op $itype_or_itemtype:$itemtypelimit" if $itemtypelimit;
93
    $query .= " $op $itype_or_itemtype:$itemtypelimit" if $itemtypelimit;
95
    $query .= " $op ccode:$ccodelimit" if $ccodelimit;
94
    $query .= " $op ccode:$ccodelimit" if $ccodelimit;
96
    $debug && warn $query;
97
    $resultsperpage = $input->param('resultsperpage');
95
    $resultsperpage = $input->param('resultsperpage');
98
    $resultsperpage = 20 if ( !defined $resultsperpage );
96
    $resultsperpage = 20 if ( !defined $resultsperpage );
99
97
(-)a/suggestion/suggestion.pl (-1 lines)
Lines 27-33 use C4::Koha; Link Here
27
use C4::Budgets;
27
use C4::Budgets;
28
use C4::Search;
28
use C4::Search;
29
use C4::Members;
29
use C4::Members;
30
use C4::Debug;
31
use Koha::DateUtils qw( dt_from_string );
30
use Koha::DateUtils qw( dt_from_string );
32
use Koha::AuthorisedValues;
31
use Koha::AuthorisedValues;
33
use Koha::Acquisition::Currencies;
32
use Koha::Acquisition::Currencies;
(-)a/t/Debug.t (-19 lines)
Lines 1-19 Link Here
1
#!/usr/bin/perl
2
3
use Modern::Perl;
4
use Test::More tests => 7;
5
6
use vars qw($debug $cgi_debug);
7
8
BEGIN {
9
    $ENV{'KOHA_CGI_DEBUG'}='2';
10
    $ENV{'KOHA_DEBUG'}='5';
11
    is($debug,    undef,"    \$debug is undefined as expected.");
12
    is($cgi_debug,undef,"\$cgi_debug is undefined as expected.");
13
    use_ok('C4::Debug');
14
}
15
16
ok(defined     $debug, "    \$debug defined and imported.");
17
ok(defined $cgi_debug, "\$cgi_debug defined and imported.");
18
is($cgi_debug,2,"cgi_debug gets the ENV{'KOHA_CGI_DEBUG'}");
19
is($debug,5,"debug gets the ENV{'KOHA_DEBUG'}");
(-)a/t/db_dependent/Search.t (-1 lines)
Lines 19-25 use Modern::Perl; Link Here
19
19
20
use utf8;
20
use utf8;
21
21
22
use C4::Debug;
23
use C4::AuthoritiesMarc qw( SearchAuthorities );
22
use C4::AuthoritiesMarc qw( SearchAuthorities );
24
use C4::XSLT;
23
use C4::XSLT;
25
require C4::Context;
24
require C4::Context;
(-)a/t/db_dependent/Serials.t (-1 lines)
Lines 8-14 use Modern::Perl; Link Here
8
use C4::Serials;
8
use C4::Serials;
9
use C4::Serials::Frequency;
9
use C4::Serials::Frequency;
10
use C4::Serials::Numberpattern;
10
use C4::Serials::Numberpattern;
11
use C4::Debug;
12
use C4::Biblio;
11
use C4::Biblio;
13
use C4::Budgets;
12
use C4::Budgets;
14
use C4::Items;
13
use C4::Items;
(-)a/tags/review.pl (-8 lines)
Lines 30-36 use C4::Context; Link Here
30
use Koha::DateUtils;
30
use Koha::DateUtils;
31
# use C4::Koha;
31
# use C4::Koha;
32
use C4::Output qw(:html :ajax pagination_bar);
32
use C4::Output qw(:html :ajax pagination_bar);
33
use C4::Debug;
34
use C4::Tags qw(get_tags get_approval_rows approval_counts whitelist blacklist is_approved);
33
use C4::Tags qw(get_tags get_approval_rows approval_counts whitelist blacklist is_approved);
35
34
36
my $script_name = "/cgi-bin/koha/tags/review.pl";
35
my $script_name = "/cgi-bin/koha/tags/review.pl";
Lines 42-64 sub ajax_auth_cgi { # returns CGI object Link Here
42
    my $input = CGI->new;
41
    my $input = CGI->new;
43
    my $sessid = $cookies{'CGISESSID'}->value;
42
    my $sessid = $cookies{'CGISESSID'}->value;
44
    my ($auth_status, $auth_sessid) = check_cookie_auth($sessid, $needed_flags);
43
    my ($auth_status, $auth_sessid) = check_cookie_auth($sessid, $needed_flags);
45
    $debug and
46
    print STDERR "($auth_status, $auth_sessid) = check_cookie_auth($sessid," . Dumper($needed_flags) . ")\n";
47
    if ($auth_status ne "ok") {
44
    if ($auth_status ne "ok") {
48
        output_with_http_headers $input, undef,
45
        output_with_http_headers $input, undef,
49
            "window.alert('Your CGI session cookie ($sessid) is not current.  " .
46
            "window.alert('Your CGI session cookie ($sessid) is not current.  " .
50
            "Please refresh the page and try again.');\n", 'js';
47
            "Please refresh the page and try again.');\n", 'js';
51
        exit 0;
48
        exit 0;
52
    }
49
    }
53
    $debug and print STDERR "AJAX request: " . Dumper($input),
54
        "\n(\$auth_status,\$auth_sessid) = ($auth_status,$auth_sessid)\n";
55
    return $input;
50
    return $input;
56
}
51
}
57
52
58
if (is_ajax()) {
53
if (is_ajax()) {
59
    my $input = &ajax_auth_cgi($needed_flags);
54
    my $input = &ajax_auth_cgi($needed_flags);
60
    my $operator = C4::Context->userenv->{'number'};  # must occur AFTER auth
55
    my $operator = C4::Context->userenv->{'number'};  # must occur AFTER auth
61
    $debug and print STDERR "op: " . Dumper($operator) . "\n";
62
    my ($tag, $js_reply);
56
    my ($tag, $js_reply);
63
    if ($tag = $input->param('test')) {
57
    if ($tag = $input->param('test')) {
64
        my $check = is_approved($tag);
58
        my $check = is_approved($tag);
Lines 200-212 if ($filter = $input->param('approved_by')) { # borrowernumber from link Link Here
200
        push @errors, {approved_by=>$filter};
194
        push @errors, {approved_by=>$filter};
201
    }
195
    }
202
}
196
}
203
$debug and print STDERR "filters: " . Dumper(\%filters);
204
my $tagloop = get_approval_rows(\%filters);
197
my $tagloop = get_approval_rows(\%filters);
205
my $qstring = $input->query_string;
198
my $qstring = $input->query_string;
206
$qstring =~ s/([&;])*\blimit=\d+//;         # remove pagination var
199
$qstring =~ s/([&;])*\blimit=\d+//;         # remove pagination var
207
$qstring =~ s/^;+//;                        # remove leading delims
200
$qstring =~ s/^;+//;                        # remove leading delims
208
$qstring = "limit=$pagesize" . ($qstring ? '&amp;' . $qstring : '');
201
$qstring = "limit=$pagesize" . ($qstring ? '&amp;' . $qstring : '');
209
$debug and print STDERR "number of approval_rows: " . scalar(@$tagloop) . "rows\n";
210
(scalar @errors) and $template->param(message_loop=>\@errors);
202
(scalar @errors) and $template->param(message_loop=>\@errors);
211
$template->param(
203
$template->param(
212
    offset => $offset,  # req'd for EXPR
204
    offset => $offset,  # req'd for EXPR
(-)a/tools/batchMod.pl (-1 lines)
Lines 31-37 use C4::Context; Link Here
31
use C4::Koha;
31
use C4::Koha;
32
use C4::BackgroundJob;
32
use C4::BackgroundJob;
33
use C4::ClassSource;
33
use C4::ClassSource;
34
use C4::Debug;
35
use C4::Members;
34
use C4::Members;
36
use MARC::File::XML;
35
use MARC::File::XML;
37
use List::MoreUtils qw/uniq/;
36
use List::MoreUtils qw/uniq/;
(-)a/tools/picture-upload.pl (-28 / +21 lines)
Lines 29-36 use C4::Context; Link Here
29
use C4::Auth;
29
use C4::Auth;
30
use C4::Output;
30
use C4::Output;
31
use C4::Members;
31
use C4::Members;
32
use C4::Debug;
33
32
33
use Koha::Logger;
34
use Koha::Patrons;
34
use Koha::Patrons;
35
use Koha::Patron::Images;
35
use Koha::Patron::Images;
36
use Koha::Token;
36
use Koha::Token;
Lines 61-67 my $op = $input->param('op') || ''; Link Here
61
#       Other parts of this code could be optimized as well, I think. Perhaps the file upload could be done with YUI's upload
61
#       Other parts of this code could be optimized as well, I think. Perhaps the file upload could be done with YUI's upload
62
#       coded. -fbcit
62
#       coded. -fbcit
63
63
64
$debug and warn "Params are: filetype=$filetype, cardnumber=$cardnumber, borrowernumber=$borrowernumber, uploadfile=$uploadfilename";
64
our $logger = Koha::Logger->get;
65
$logger->debug("Params are: filetype=$filetype, cardnumber=$cardnumber, borrowernumber=$borrowernumber, uploadfile=$uploadfilename");
65
66
66
=head1 NAME
67
=head1 NAME
67
68
Lines 78-85 Files greater than 100K will be refused. Images should be 140x200 pixels. If the Link Here
78
79
79
=cut
80
=cut
80
81
81
$debug and warn "Operation requested: $op";
82
83
my ( $total, $handled, $tempfile, $tfh );
82
my ( $total, $handled, $tempfile, $tfh );
84
our @counts = ();
83
our @counts = ();
85
our %errors = ();
84
our %errors = ();
Lines 94-107 if ( ( $op eq 'Upload' ) && $uploadfile ) { Link Here
94
        });
93
        });
95
94
96
    my $dirname = File::Temp::tempdir( CLEANUP => 1 );
95
    my $dirname = File::Temp::tempdir( CLEANUP => 1 );
97
    $debug and warn "dirname = $dirname";
98
    my $filesuffix;
96
    my $filesuffix;
99
    if ( $uploadfilename =~ m/(\..+)$/i ) {
97
    if ( $uploadfilename =~ m/(\..+)$/i ) {
100
        $filesuffix = $1;
98
        $filesuffix = $1;
101
    }
99
    }
102
    ( $tfh, $tempfile ) =
100
    ( $tfh, $tempfile ) =
103
      File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
101
      File::Temp::tempfile( SUFFIX => $filesuffix, UNLINK => 1 );
104
    $debug and warn "tempfile = $tempfile";
105
    my ( @directories, $results );
102
    my ( @directories, $results );
106
103
107
    $errors{'NOTZIP'} = 1
104
    $errors{'NOTZIP'} = 1
Lines 134-140 if ( ( $op eq 'Upload' ) && $uploadfile ) { Link Here
134
            while ( my $entry = readdir RECDIR ) {
131
            while ( my $entry = readdir RECDIR ) {
135
                push @directories, "$recursive_dir/$entry"
132
                push @directories, "$recursive_dir/$entry"
136
                  if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
133
                  if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
137
                $debug and warn "$recursive_dir/$entry";
138
            }
134
            }
139
            closedir RECDIR;
135
            closedir RECDIR;
140
        }
136
        }
Lines 158-165 if ( ( $op eq 'Upload' ) && $uploadfile ) { Link Here
158
    else {
154
    else {
159
        my $filecount;
155
        my $filecount;
160
        map { $filecount += $_->{count} } @counts;
156
        map { $filecount += $_->{count} } @counts;
161
        $debug and warn "Total directories processed: $total";
157
        $logger->debug("Total directories processed: $total");
162
        $debug and warn "Total files processed: $filecount";
158
        $logger->debug("Total files processed: $filecount");
163
        $template->param(
159
        $template->param(
164
            TOTAL   => $total,
160
            TOTAL   => $total,
165
            HANDLED => $handled,
161
            HANDLED => $handled,
Lines 205-216 else { Link Here
205
sub handle_dir {
201
sub handle_dir {
206
    my ( $dir, $suffix, $template, $cardnumber, $source ) = @_;
202
    my ( $dir, $suffix, $template, $cardnumber, $source ) = @_;
207
    my ( %counts, %direrrors );
203
    my ( %counts, %direrrors );
208
    $debug and warn "Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix";
204
    $logger->debug("Entering sub handle_dir; passed \$dir=$dir, \$suffix=$suffix");
209
    if ( $suffix =~ m/zip/i ) {
205
    if ( $suffix =~ m/zip/i ) {
210
        # If we were sent a zip file, process any included data/idlink.txt files
206
        # If we were sent a zip file, process any included data/idlink.txt files
211
        my ( $file, $filename );
207
        my ( $file, $filename );
212
        undef $cardnumber;
208
        undef $cardnumber;
213
        $debug and warn "Passed a zip file.";
209
        $logger->debug("Passed a zip file.");
214
        opendir DIR, $dir;
210
        opendir DIR, $dir;
215
        while ( my $filename = readdir DIR ) {
211
        while ( my $filename = readdir DIR ) {
216
            $file = "$dir/$filename"
212
            $file = "$dir/$filename"
Lines 227-237 sub handle_dir { Link Here
227
        }
223
        }
228
224
229
        while ( my $line = <$fh> ) {
225
        while ( my $line = <$fh> ) {
230
            $debug and warn "Reading contents of $file";
226
            $logger->debug("Reading contents of $file");
231
            chomp $line;
227
            chomp $line;
232
            $debug and warn "Examining line: $line";
228
            $logger->debug("Examining line: $line");
233
            my $delim = ( $line =~ /\t/ ) ? "\t" : ( $line =~ /,/ ) ? "," : "";
229
            my $delim = ( $line =~ /\t/ ) ? "\t" : ( $line =~ /,/ ) ? "," : "";
234
            $debug and warn "Delimeter is \'$delim\'";
230
            $logger->debug("Delimeter is \'$delim\'");
235
            unless ( $delim eq "," || $delim eq "\t" ) {
231
            unless ( $delim eq "," || $delim eq "\t" ) {
236
                warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
232
                warn "Unrecognized or missing field delimeter. Please verify that you are using either a ',' or a 'tab'";
237
                $direrrors{'DELERR'} = 1;
233
                $direrrors{'DELERR'} = 1;
Lines 242-248 sub handle_dir { Link Here
242
            ( $cardnumber, $filename ) = split $delim, $line;
238
            ( $cardnumber, $filename ) = split $delim, $line;
243
            $cardnumber =~ s/[\"\r\n]//g; # remove offensive characters
239
            $cardnumber =~ s/[\"\r\n]//g; # remove offensive characters
244
            $filename   =~ s/[\"\r\n\s]//g;
240
            $filename   =~ s/[\"\r\n\s]//g;
245
            $debug and warn "Cardnumber: $cardnumber Filename: $filename";
241
            $logger->debug("Cardnumber: $cardnumber Filename: $filename");
246
            $source = "$dir/$filename";
242
            $source = "$dir/$filename";
247
            %counts = handle_file( $cardnumber, $source, $template, %counts );
243
            %counts = handle_file( $cardnumber, $source, $template, %counts );
248
        }
244
        }
Lines 258-264 sub handle_dir { Link Here
258
254
259
sub handle_file {
255
sub handle_file {
260
    my ( $cardnumber, $source, $template, %count ) = @_;
256
    my ( $cardnumber, $source, $template, %count ) = @_;
261
    $debug and warn "Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source";
257
    $logger->debug("Entering sub handle_file; passed \$cardnumber=$cardnumber, \$source=$source");
262
    $count{filenames} = ()      if !$count{filenames};
258
    $count{filenames} = ()      if !$count{filenames};
263
    $count{source}    = $source if !$count{source};
259
    $count{source}    = $source if !$count{source};
264
    $count{count}     = 0       unless exists $count{count};
260
    $count{count}     = 0       unless exists $count{count};
Lines 272-278 sub handle_file { Link Here
272
    }
268
    }
273
    if ( $cardnumber && $source ) {
269
    if ( $cardnumber && $source ) {
274
        # Now process any imagefiles
270
        # Now process any imagefiles
275
        $debug and warn "Source: $source";
271
        $logger->debug("Source: $source");
276
        my $size = ( stat($source) )[7];
272
        my $size = ( stat($source) )[7];
277
        if ( $size > 550000 ) {
273
        if ( $size > 550000 ) {
278
            # This check is necessary even with image resizing to avoid possible security/performance issues...
274
            # This check is necessary even with image resizing to avoid possible security/performance issues...
Lines 299-308 sub handle_file { Link Here
299
                # we will convert all to PNG which is lossless...
295
                # we will convert all to PNG which is lossless...
300
                # Check the pixel size of the image we are about to import...
296
                # Check the pixel size of the image we are about to import...
301
                my ( $width, $height ) = $srcimage->getBounds();
297
                my ( $width, $height ) = $srcimage->getBounds();
302
                $debug and warn "$filename is $width pix X $height pix.";
298
                $logger->debug("$filename is $width pix X $height pix.");
303
                if ( $width > 200 || $height > 300 ) {
299
                if ( $width > 200 || $height > 300 ) {
304
                    # MAX pixel dims are 200 X 300...
300
                    # MAX pixel dims are 200 X 300...
305
                    $debug and warn "$filename exceeds the maximum pixel dimensions of 200 X 300. Resizing...";
301
                    $logger->debug("$filename exceeds the maximum pixel dimensions of 200 X 300. Resizing...");
306
                    # Percent we will reduce the image dimensions by...
302
                    # Percent we will reduce the image dimensions by...
307
                    my $percent_reduce;
303
                    my $percent_reduce;
308
                    if ( $width > 200 ) {
304
                    if ( $width > 200 ) {
Lines 317-347 sub handle_file { Link Here
317
                      sprintf( "%.0f", ( $width * $percent_reduce ) );
313
                      sprintf( "%.0f", ( $width * $percent_reduce ) );
318
                    my $height_reduce =
314
                    my $height_reduce =
319
                      sprintf( "%.0f", ( $height * $percent_reduce ) );
315
                      sprintf( "%.0f", ( $height * $percent_reduce ) );
320
                    $debug
316
                      $logger->debug("Reducing $filename by "
321
                      and warn "Reducing $filename by "
322
                      . ( $percent_reduce * 100 )
317
                      . ( $percent_reduce * 100 )
323
                      . "\% or to $width_reduce pix X $height_reduce pix";
318
                      . "\% or to $width_reduce pix X $height_reduce pix");
324
                    #'1' creates true color image...
319
                    #'1' creates true color image...
325
                    $image = GD::Image->new( $width_reduce, $height_reduce, 1 );
320
                    $image = GD::Image->new( $width_reduce, $height_reduce, 1 );
326
                    $image->copyResampled( $srcimage, 0, 0, 0, 0, $width_reduce,
321
                    $image->copyResampled( $srcimage, 0, 0, 0, 0, $width_reduce,
327
                        $height_reduce, $width, $height );
322
                        $height_reduce, $width, $height );
328
                    $imgfile = $image->png();
323
                    $imgfile = $image->png();
329
                    $debug
324
                    $logger->debug("$filename is "
330
                      and warn "$filename is "
331
                      . length($imgfile)
325
                      . length($imgfile)
332
                      . " bytes after resizing.";
326
                      . " bytes after resizing.");
333
                    undef $image;
327
                    undef $image;
334
                    undef $srcimage; # This object can get big...
328
                    undef $srcimage; # This object can get big...
335
                }
329
                }
336
                else {
330
                else {
337
                    $image   = $srcimage;
331
                    $image   = $srcimage;
338
                    $imgfile = $image->png();
332
                    $imgfile = $image->png();
339
                    $debug
333
                    $logger->debug("$filename is " . length($imgfile) . " bytes.");
340
                      and warn "$filename is " . length($imgfile) . " bytes.";
341
                    undef $image;
334
                    undef $image;
342
                    undef $srcimage; # This object can get big...
335
                    undef $srcimage; # This object can get big...
343
                }
336
                }
344
                $debug and warn "Image is of mimetype $mimetype";
337
                $logger->debug("Image is of mimetype $mimetype");
345
                if ($mimetype) {
338
                if ($mimetype) {
346
                    my $patron = Koha::Patrons->find({ cardnumber => $cardnumber });
339
                    my $patron = Koha::Patrons->find({ cardnumber => $cardnumber });
347
                    if ( $patron ) {
340
                    if ( $patron ) {
(-)a/tools/viewlog.pl (-5 lines)
Lines 28-34 use C4::Koha; Link Here
28
use C4::Output;
28
use C4::Output;
29
use C4::Items;
29
use C4::Items;
30
use C4::Serials;
30
use C4::Serials;
31
use C4::Debug;
32
use C4::Search;    # enabled_staff_search_views
31
use C4::Search;    # enabled_staff_search_views
33
32
34
use Koha::ActionLogs;
33
use Koha::ActionLogs;
Lines 37-43 use Koha::DateUtils; Link Here
37
use Koha::Items;
36
use Koha::Items;
38
use Koha::Patrons;
37
use Koha::Patrons;
39
38
40
use vars qw($debug $cgi_debug);
41
39
42
=head1 viewlog.pl
40
=head1 viewlog.pl
43
41
Lines 47-53 plugin that shows stats Link Here
47
45
48
my $input = CGI->new;
46
my $input = CGI->new;
49
47
50
$debug or $debug = $cgi_debug;
51
my $do_it    = $input->param('do_it');
48
my $do_it    = $input->param('do_it');
52
my @modules  = $input->multi_param("modules");
49
my @modules  = $input->multi_param("modules");
53
my $user     = $input->param("user") // '';
50
my $user     = $input->param("user") // '';
Lines 87-93 if ( $src eq 'circ' ) { Link Here
87
}
84
}
88
85
89
$template->param(
86
$template->param(
90
    debug => $debug,
91
    C4::Search::enabled_staff_search_views,
87
    C4::Search::enabled_staff_search_views,
92
    subscriptionsnumber => ( $object ? CountSubscriptionFromBiblionumber($object) : 0 ),
88
    subscriptionsnumber => ( $object ? CountSubscriptionFromBiblionumber($object) : 0 ),
93
    object => $object,
89
    object => $object,
94
- 

Return to bug 28572