File Coverage

blib/lib/String/BOM.pm
Criterion Covered Total %
statement 37 39 94.8
branch 17 22 77.2
condition 2 3 66.6
subroutine 5 6 83.3
pod 4 4 100.0
total 65 74 87.8


line stmt bran cond sub pod time code
1             package String::BOM;
2              
3             # use warnings;
4             # use strict;
5              
6             $String::BOM::VERSION = '0.3';
7              
8             # http://www.unicode.org/faq/utf_bom.html#BOM
9             # http://search.cpan.org/perldoc?PPI::Token::BOM
10             %String::BOM::bom_types = (
11             "\x00\x00\xfe\xff" => 'UTF-32',
12             "\xff\xfe\x00\x00" => 'UTF-32',
13             "\xfe\xff" => 'UTF-16',
14             "\xff\xfe" => 'UTF-16',
15             "\xef\xbb\xbf" => 'UTF-8',
16             );
17              
18             sub string_has_bom {
19 50 100   50 1 1239 if ( $_[0] =~ m/^(\x00\x00\xfe\xff|\xff\xfe\x00\x00|\xfe\xff|\xff\xfe|\xef\xbb\xbf)/s ) {
20 20         146 return $String::BOM::bom_types{$1};
21             }
22 30         171 return;
23             }
24              
25             sub strip_bom_from_string {
26 10     10 1 24 my $copy = $_[0]; # Modification of a read-only value attempted at ...
27 10         48 $copy =~ s/^(\x00\x00\xfe\xff|\xff\xfe\x00\x00|\xfe\xff|\xff\xfe|\xef\xbb\xbf)//s;
28 10         139 return $copy;
29             }
30              
31             sub file_has_bom {
32              
33             # Would rather not bring in >0.5MB Fcntl just for this so we do a read() of characters instead of a sysread() of bytes()
34             # sysopen(my $fh, $_[0],&Fcntl::O_RDONLY) or return;
35             # sysread($fh, my $buf, $length_in_bytes_of_biggest_bom);
36 51 100   51 1 22271 open( my $fh, '<', $_[0] ) or return;
37 40         84 $! = 0; # yes this happens
38 40 50       401 read( $fh, my $buf, 4 ) or return; # 4 "characters" should be big enough to bring in enough anything in bom_types
39 40         68 $! = 0; # yes this happens
40 40 50       560 close($fh) or return;
41 40         61 $! = 0; # yes this happens
42 40         82 return string_has_bom($buf);
43             }
44              
45             sub strip_bom_from_file {
46 26 100   26 1 328 if ( file_has_bom( $_[0] ) ) {
47              
48             # there is [probabaly] a better way to do this (faster, w/ out .bak file, etc), suggestions/patches welcome
49              
50             # in-place edit
51 10         15 my $inplace_error = 0;
52             {
53 10         11 local $^I = '.bak';
  10         38  
54 10         28 local @ARGV = ( $_[0] );
55             local $SIG{'__WARN__'} = sub {
56 0     0   0 $inplace_error++;
57              
58             # my $err = shift();
59             # $inplace_error = {
60             # 'errno_int' => int($!),
61             # 'errno_str' => "$!",
62             # 'raw_warn' => $err,
63             # };
64 10         62 };
65              
66 10         1797 while () {
67 10 50       45 if ( $. == 1 ) {
68 10         22 print strip_bom_from_string($_); # ... write stripped line back to the file
69 10         516 next;
70             }
71 0         0 print; # ... write the line back to the file
72             }
73             }
74              
75 10 50       25 return if $inplace_error;
76              
77 10 100       328 unlink "$_[0].bak" unless $_[1];
78              
79 10         65 return 1;
80             }
81             else {
82 16 100       80 return if $!; # file_has_bom() must've returned false due to FS issue (hence the "yes this happens" bits above)
83 10         55 return 1;
84             }
85             }
86              
87             sub import {
88 1     1   7 shift;
89 1 50       7 return if !@_;
90              
91 1         3 my $caller = caller();
92              
93             # no strict 'refs';
94 1         2 for (@_) {
95 2 100 66     8 next if !defined &{$_} || m/\:\'/;
  2         25  
96 1         2 *{"$caller\::$_"} = \&{$_};
  1         6  
  1         2  
97             }
98             }
99              
100             1;
101              
102             __END__