File Coverage

blib/lib/Filter/Util/Call.pm
Criterion Covered Total %
statement 14 24 58.3
branch 1 6 16.6
condition 2 12 16.6
subroutine 4 5 80.0
pod 2 2 100.0
total 23 49 46.9


line stmt bran cond sub pod time code
1             # Call.pm
2             #
3             # Copyright (c) 1995-2011 Paul Marquess. All rights reserved.
4             # Copyright (c) 2011-2014, 2018-2022 Reini Urban. All rights reserved.
5             # Copyright (c) 2014-2017 cPanel Inc. All rights reserved.
6             #
7             # This program is free software; you can redistribute it and/or
8             # modify it under the same terms as Perl itself.
9            
10             package Filter::Util::Call ;
11              
12             require 5.006 ; # our
13             require Exporter;
14              
15 1     1   1713 use XSLoader ();
  1         6  
  1         20  
16 1     1   4 use strict;
  1         1  
  1         17  
17 1     1   4 use warnings;
  1         1  
  1         299  
18              
19             our @ISA = qw(Exporter);
20             our @EXPORT = qw( filter_add filter_del filter_read filter_read_exact) ;
21             our $VERSION = "1.62" ;
22             our $XS_VERSION = $VERSION;
23             $VERSION = eval $VERSION;
24              
25             sub filter_read_exact($)
26             {
27 0     0 1 0 my ($size) = @_ ;
28 0         0 my ($left) = $size ;
29 0         0 my ($status) ;
30              
31 0 0       0 unless ( $size > 0 ) {
32 0         0 require Carp;
33 0         0 Carp::croak("filter_read_exact: size parameter must be > 0");
34             }
35              
36             # try to read a block which is exactly $size bytes long
37 0   0     0 while ($left and ($status = filter_read($left)) > 0) {
38 0         0 $left = $size - length $_ ;
39             }
40              
41             # EOF with pending data is a special case
42 0 0 0     0 return 1 if $status == 0 and length $_ ;
43              
44 0         0 return $status ;
45             }
46              
47             sub filter_add($)
48             {
49 1     1 1 154 my($obj) = @_ ;
50              
51             # Did we get a code reference?
52 1         3 my $coderef = (ref $obj eq 'CODE');
53              
54             # If the parameter isn't already a reference, make it one.
55 1 50 33     11 if (!$coderef and (!ref($obj) or ref($obj) =~ /^ARRAY|HASH$/)) {
      33        
56 1         3 $obj = bless (\$obj, (caller)[0]);
57             }
58              
59             # finish off the installation of the filter in C.
60 1         8 Filter::Util::Call::real_import($obj, (caller)[0], $coderef) ;
61             }
62              
63             XSLoader::load('Filter::Util::Call');
64              
65             1;
66             __END__