File-BOM-0.18000755000765000024 013652756333 13212 5ustar00mlawrencestaff000000000000File-BOM-0.18/Build.PL000444000765000024 226213652756333 14645 0ustar00mlawrencestaff000000000000#!/usr/bin/perl =head1 NAME Build.PL - Build script generator for File::BOM =head1 SYNOPSIS perl Build.PL ./Build test ./Build install or perl Makefile.PL make test make install =cut use lib 'lib'; use strict; use warnings; use Module::Build; my $build = Module::Build->new ( module_name => 'File::BOM', dist_version_from => 'lib/File/BOM.pm', create_readme => 1, create_makefile_pl => 'passthrough', license => 'perl', requires => { 'perl' => '5.8.3', 'Readonly' => '0.06', 'Encode' => '1.99', # This shipped with perl 5.8.3 }, build_requires => { 'Test::More' => '0.10', 'Test::Exception' => '0.20', 'Module::Build' => '0.20', }, meta_merge => { meta_spec => { version => 2, }, resources => { repository => 'https://github.com/mattlaw/File-BOM.git', web => 'https://github.com/mattlaw/File-BOM', type => 'git', }, }, ); $build->create_build_script; __END__ =head1 SEE ALSO L =head1 AUTHOR Matt Lawrence =cut File-BOM-0.18/Changes000444000765000024 334013652756333 14642 0ustar00mlawrencestaff000000000000File::BOM changes document 0.18 - Fri May 2020 1 - Update manifest to include testrules.yml 0.17 - Fri May 1 2020 - Fix tests to be runnable in parallel. Thanks to Tom Hukins. - Fix documentation typos. Thanks again to Tom Hukins. 0.16 - Wed Feb 6 2019 - Fix tests failing under Encode 2.99. Thanks to Petr Pisar. 0.15 - Mon Dec 14 2015 - Fix spelling errors spotted by debian team. Thanks to Gregor Herrmann. 0.14 - Wed Oct 4 2006 - More workarounds for platforms with odd read() behaviour. 0.13 - Tue Oct 3 2006 - Tried to workaround platforms where read doesn't return undef on failure. - Added Encode to dependencies so that the version number can be seen in test reports. 0.12 - Tue Jul 11 2006 - Added a description section to docs - Added information about test failures on cygwin - Added overridable test skipping for tests that cause hangs on cygwin 0.11 - Added Test::Pod and Test::Pod::Coverage tests at the behest of CPANTS 0.10 - Changed open_bom to work more like open() - Added defuse function to process BOMs on open handles - Updated tests to cope with PerlIO::via's limitations - Removed most test files, they will now be generated by the test framework, so that they have native line endings 0.09 - Added tell() support to work with seek() properly - Hopefully fixed compatibility with older versions of Encode - PerlIO::via should now work with the latest perl 0.08 - Added TODO document - Added tests (now at 100% coverage for non PerlIO::via code) - Added diagnostics documentation - Fixed bugs in unseekable spillage handling 0.07 - Added Changes document - Added support for seek() in PerlIO::via interface File-BOM-0.18/MANIFEST000444000765000024 44413652756333 14462 0ustar00mlawrencestaff000000000000Build.PL Changes lib/File/BOM.pm Makefile.PL MANIFEST META.json META.yml Module meta-data (added by MakeMaker) README README-cygwin t/00..setup.t t/01..bom.t t/02..perlio-via.t t/03..exceptions.t t/04..pod.t t/99..shutdown.t t/data/broken_bom.txt t/lib/Test/Framework.pm testrules.yml TODO File-BOM-0.18/META.json000444000765000024 254713652756333 15000 0ustar00mlawrencestaff000000000000{ "abstract" : "Utilities for handling Byte Order Marks", "author" : [ "Matt Lawrence Emattlaw@cpan.orgE" ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4229", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "File-BOM", "prereqs" : { "build" : { "requires" : { "Module::Build" : "0.20", "Test::Exception" : "0.20", "Test::More" : "0.10" } }, "configure" : { "requires" : { "Module::Build" : "0.42" } }, "runtime" : { "requires" : { "Encode" : "1.99", "Readonly" : "0.06", "perl" : "v5.8.3" } } }, "provides" : { "File::BOM" : { "file" : "lib/File/BOM.pm", "version" : "0.18" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/mattlaw/File-BOM.git" }, "x_type" : "git", "x_web" : "https://github.com/mattlaw/File-BOM" }, "version" : "0.18", "x_meta_spec" : { "version" : 2 }, "x_serialization_backend" : "JSON::PP version 2.97001" } File-BOM-0.18/META.yml000444000765000024 153013652756333 14617 0ustar00mlawrencestaff000000000000--- abstract: 'Utilities for handling Byte Order Marks' author: - 'Matt Lawrence Emattlaw@cpan.orgE' build_requires: Module::Build: '0.20' Test::Exception: '0.20' Test::More: '0.10' configure_requires: Module::Build: '0.42' dynamic_config: 1 generated_by: 'Module::Build version 0.4229, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: File-BOM provides: File::BOM: file: lib/File/BOM.pm version: '0.18' requires: Encode: '1.99' Readonly: '0.06' perl: v5.8.3 resources: Type: git Web: https://github.com/mattlaw/File-BOM license: http://dev.perl.org/licenses/ repository: https://github.com/mattlaw/File-BOM.git version: '0.18' x_meta_spec: version: 2 x_serialization_backend: 'CPAN::Meta::YAML version 0.018' File-BOM-0.18/Makefile.PL000444000765000024 230513652756333 15321 0ustar00mlawrencestaff000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4229 require 5.008003; unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; Module::Build::Compat->run_build_pl(args => \@ARGV); my $build_script = 'Build'; $build_script .= '.com' if $^O eq 'VMS'; exit(0) unless(-e $build_script); # cpantesters convention require Module::Build; Module::Build::Compat->write_makefile(build_class => 'Module::Build'); File-BOM-0.18/README000444000765000024 3036213652756333 14253 0ustar00mlawrencestaff000000000000NAME File::BOM - Utilities for handling Byte Order Marks SYNOPSIS use File::BOM qw( :all ) high-level functions # read a file with encoding from the BOM: open_bom(FH, $file) open_bom(FH, $file, ':utf8') # the same but with a default encoding # get encoding too $encoding = open_bom(FH, $file, ':utf8'); # open a potentially unseekable file: ($encoding, $spillage) = open_bom(FH, $file, ':utf8'); # change encoding of an open handle according to BOM $encoding = defuse(*HANDLE); ($encoding, $spillage) = defuse(*HANDLE); # Decode a string according to leading BOM: $unicode = decode_from_bom($string_with_bom); # Decode a string and get the encoding: ($unicode, $encoding) = decode_from_bom($string_with_bom) PerlIO::via interface # Read the Right Thing from a unicode file with BOM: open(HANDLE, '<:via(File::BOM)', $filename) # Writing little-endian UTF-16 file with BOM: open(HANDLE, '>:encoding(UTF-16LE):via(File::BOM)', $filename) lower-level functions # read BOM encoding from a filehandle: $encoding = get_encoding_from_filehandle(FH) # Get encoding even if FH is unseekable: ($encoding, $spillage) = get_encoding_from_filehandle(FH); # Get encoding from a known unseekable handle: ($encdoing, $spillage) = get_encoding_from_stream(FH); # get encoding and BOM length from BOM at start of string: ($encoding, $offset) = get_encoding_from_bom($string); variables # print a BOM for a known encoding print FH $enc2bom{$encoding}; # get an encoding from a known BOM $enc = $bom2enc{$bom} DESCRIPTION This module provides functions for handling unicode byte order marks, which are to be found at the beginning of some files and streams. For details about what a byte order mark is, see The intention of File::BOM is for files with BOMs to be readable as seamlessly as possible, regardless of the encoding used. To that end, several different interfaces are available, as shown in the synopsis above. EXPORTS Nothing by default. symbols * open_bom() * defuse() * decode_from_bom() * get_encoding_from_filehandle() * get_encoding_from_stream() * get_encoding_from_bom() * %bom2enc * %enc2bom tags * :all All of the above * :subs subroutines only * :vars just %bom2enc and %enc2bom VARIABLES %bom2enc Maps Byte Order marks to their encodings. The keys of this hash are strings which represent the BOMs, the values are their encodings, in a format which is understood by Encode The encodings represented in this hash are: UTF-8, UTF-16BE, UTF-16LE, UTF-32BE and UTF-32LE %enc2bom A reverse-lookup hash for bom2enc, with a few aliases used in Encode, namely utf8, iso-10646-1 and UCS-2. Note that UTF-16, UTF-32 and UCS-4 are not included in this hash. Mainly because Encode::encode automatically puts BOMs on output. See Encode::Unicode FUNCTIONS open_bom $encoding = open_bom(HANDLE, $filename, $default_mode) ($encoding, $spill) = open_bom(HANDLE, $filename, $default_mode) opens HANDLE for reading on $filename, setting the mode to the appropriate encoding for the BOM stored in the file. On failure, a fatal error is raised, see the DIAGNOSTICS section for details on how to catch these. This is in order to allow the return value(s) to be used for other purposes. If the file doesn't contain a BOM, $default_mode is used instead. Hence: open_bom(FH, 'my_file.txt', ':utf8') Opens my_file.txt for reading in an appropriate encoding found from the BOM in that file, or as a UTF-8 file if none is found. In the absence of a $default_mode argument, the following 2 calls should be equivalent: open_bom(FH, 'no_bom.txt'); open(FH, '<', 'no_bom.txt'); If an undefined value is passed as the handle, a symbol will be generated for it like open() does: # create filehandle on the fly $enc = open_bom(my $fh, $filename, ':utf8'); $line = <$fh>; The filehandle will be cued up to read after the BOM. Unseekable files (e.g. fifos) will cause croaking, unless called in list context to catch spillage from the handle. Any spillage will be automatically decoded from the encoding, if found. e.g. # croak if my_socket is unseekable open_bom(FH, 'my_socket'); # keep spillage if my_socket is unseekable ($encoding, $spillage) = open_bom(FH, 'my_socket'); # discard any spillage from open_bom ($encoding) = open_bom(FH, 'my_socket'); defuse $enc = defuse(FH); ($enc, $spill) = defuse(FH); FH should be a filehandle opened for reading, it will have the relevant encoding layer pushed onto it be binmode if a BOM is found. Spillage should be Unicode, not bytes. Any uncaptured spillage will be silently lost. If the handle is unseekable, use list context to avoid data loss. If no BOM is found, the mode will be unaffected. decode_from_bom $unicode_string = decode_from_bom($string, $default, $check) ($unicode_string, $encoding) = decode_from_bom($string, $default, $check) Reads a BOM from the beginning of $string, decodes $string (minus the BOM) and returns it to you as a perl unicode string. if $string doesn't have a BOM, $default is used instead. $check, if supplied, is passed to Encode::decode as the third argument. If there's no BOM and no default, the original string is returned and encoding is ''. See Encode get_encoding_from_filehandle $encoding = get_encoding_from_filehandle(HANDLE) ($encoding, $spillage) = get_encoding_from_filehandle(HANDLE) Returns the encoding found in the given filehandle. The handle should be opened in a non-unicode way (e.g. mode '<:bytes') so that the BOM can be read in its natural state. After calling, the handle will be set to read at a point after the BOM (or at the beginning of the file if no BOM was found) If called in scalar context, unseekable handles cause a croak(). If called in list context, unseekable handles will be read byte-by-byte and any spillage will be returned. See get_encoding_from_stream() get_encoding_from_stream ($encoding, $spillage) = get_encoding_from_stream(*FH); Read a BOM from an unrewindable source. This means reading the stream one byte at a time until either a BOM is found or every possible BOM is ruled out. Any non-BOM bytes read from the handle will be returned in $spillage. If a BOM is found and the spillage contains a partial character (judging by the expected character width for the encoding) more bytes will be read from the handle to ensure that a complete character is returned. Spillage is always in bytes, not characters. This function is less efficient than get_encoding_from_filehandle, but should work just as well on a seekable handle as on an unseekable one. get_encoding_from_bom ($encoding, $offset) = get_encoding_from_bom($string) Returns the encoding and length in bytes of the BOM in $string. If there is no BOM, an empty string is returned and $offset is zero. To get the data from the string, the following should work: use Encode; my($encoding, $offset) = get_encoding_from_bom($string); if ($encoding) { $string = decode($encoding, substr($string, $offset)) } PerlIO::via interface File::BOM can be used as a PerlIO::via interface. open(HANDLE, '<:via(File::BOM)', 'my_file.txt'); open(HANDLE, '>:encoding(UTF-16LE):via(File::BOM)', 'out_file.txt'); print "foo\n"; # BOM is written to file here This method is less prone to errors on non-seekable files as spillage is incorporated into an internal buffer, but it doesn't give you any information about the encoding being used, or indeed whether or not a BOM was present. There are a few known problems with this interface, especially surrounding seek() and tell(), please see the BUGS section for more details about this. Reading The via(File::BOM) layer must be added before the handle is read from, otherwise any BOM will be missed. If there is no BOM, no decoding will be done. Because of a limitation in PerlIO::via, read() always works on bytes, not characters. BOM decoding will still be done but output will be bytes of UTF-8. open(BOM, '<:via(File::BOM)', $file); $bytes_read = read(BOM, $buffer, $length); $unicode = decode('UTF-8', $buffer, Encode::FB_QUIET); # Now $unicode is valid unicode and $buffer contains any left-over bytes Writing Add the via(File::BOM) layer on top of a unicode encoding layer to print a BOM at the start of the output file. This needs to be done before any data is written. The BOM is written as part of the first print command on the handle, so if you don't print anything to the handle, you won't get a BOM. There is a "Wide character in print" warning generated when the via(File::BOM) layer doesn't receive utf8 on writing. This glitch was resolved in perl version 5.8.7, but if your perl version is older than that, you'll need to make sure that the via(File::BOM) layer receives utf8 like this: # This works OK open(FH, '>:encoding(UTF-16LE):via(File::BOM):utf8', $filename) # This generates warnings with older perls open(FH, '>:encoding(UTF-16LE):via(File::BOM)', $filename) Seeking Seeking with SEEK_SET results in an offset equal to the length of any detected BOM being applied to the position parameter. Thus: # Seek to end of BOM (not start of file!) seek(FILE_BOM_HANDLE, 0, SEEK_SET) Telling In order to work correctly with seek(), tell() also returns a postion adjusted by the length of the BOM. SEE ALSO * Encode * Encode::Unicode * DIAGNOSTICS The following exceptions are raised via croak() * Couldn't read '': $! open_bom() couldn't open the given file for reading * Couldn't set binmode of handle opened on '' to '': $! open_bom() couldn't set the binmode of the handle * No string decode_from_bom called on an undefined value * Unseekable handle: $! get_encoding_from_filehandle() or open_bom() called on an unseekable file or handle in scalar context. * Couldn't read from handle: $! _get_encoding_seekable() couldn't read the handle. This function is called from get_encoding_from_filehandle(), defuse() and open_bom() * Couldn't reset read position: $! _get_encoding_seekable couldn't seek to the position after the BOM. * Couldn't read byte: $! get_encoding_from_stream couldn't read from the handle. This function is called from get_encoding_from_filehandle() and open_bom() when the handle or file is unseekable. BUGS Older versions of PerlIO::via have a few problems with writing, see above. The current version of PerlIO::via has limitations with regard to seek and tell, currently only line-wise seek and tell are supported by this module. If read() is used to read partial lines, tell() will still give the position of the end of the last line read. Under windows, tell() seems to return erroneously when reading files with unix line endings. Under windows, warnings may be generated when using the PerlIO::via interface to read UTF-16LE and UTF-32LE encoded files. This seems to be a bug in the relevant encoding(...) layers. AUTHOR Matt Lawrence With thanks to Mark Fowler and Steve Purkis for additional tests and advice. COPYRIGHT Copyright 2005 Matt Lawrence, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. File-BOM-0.18/README-cygwin000444000765000024 117113652756333 15525 0ustar00mlawrencestaff000000000000Some notes concerning cygwin: It has been brought to my attention that several tests fail under cygwin, for that reason those tests will be disabled by default as of version 0.12. This behaviour can be disabled by setting TEST_FIFO to a true value. e.g. TEST_FIFO=1 ./Build test I have been informed that the the cause of this problem has been remedied in Cygwin dll 1.5.20 It is also worth noting that some exception tests are known to fail under cygwin. This is because the read() call doesn't return undef on a failure. This is a problem with perl under cygwin, not with File::BOM. Matt Lawrence File-BOM-0.18/TODO000444000765000024 134713652756333 14044 0ustar00mlawrencestaff000000000000TODO list for File::BOM Iron out bugs in the PerlIO::via interface. o Investigate bugs in PerlIO::via - patch? - patched XS code and tested locally. o get patch submitted - done! perl 5.8.7 doesn't have this bug o There are still problems with PerlIO::via. seek and tell don't work terribly well. This really needs to get raised via perlbug, I think. Other PerlIO::via modules don't support seek and tell at all. Test coverage o Currently can't get Devel::Cover working on Perlio::via tests. Bizarre copy of HASH in aassign at /usr/local/lib/perl5/5.8.5/i686-linux/B.pm line 225. with newest Devel::Cover: Bizarre copy of ARRAY in aassign at /usr/local/lib/perl5/5.8.5/i686-linux/B.pm line 225. File-BOM-0.18/testrules.yml000444000765000024 25313652756333 16104 0ustar00mlawrencestaff000000000000seq: - seq: t/00..setup.t - par: - t/01..bom.t - t/02..perlio-via.t - t/03..exceptions.t - t/04..pod.t - seq: t/99..shutdown.t File-BOM-0.18/lib000755000765000024 013652756333 13760 5ustar00mlawrencestaff000000000000File-BOM-0.18/lib/File000755000765000024 013652756333 14637 5ustar00mlawrencestaff000000000000File-BOM-0.18/lib/File/BOM.pm000444000765000024 4460613652756333 16001 0ustar00mlawrencestaff000000000000package File::BOM; =head1 NAME File::BOM - Utilities for handling Byte Order Marks =head1 SYNOPSIS use File::BOM qw( :all ) =head2 high-level functions # read a file with encoding from the BOM: open_bom(FH, $file) open_bom(FH, $file, ':utf8') # the same but with a default encoding # get encoding too $encoding = open_bom(FH, $file, ':utf8'); # open a potentially unseekable file: ($encoding, $spillage) = open_bom(FH, $file, ':utf8'); # change encoding of an open handle according to BOM $encoding = defuse(*HANDLE); ($encoding, $spillage) = defuse(*HANDLE); # Decode a string according to leading BOM: $unicode = decode_from_bom($string_with_bom); # Decode a string and get the encoding: ($unicode, $encoding) = decode_from_bom($string_with_bom) =head2 PerlIO::via interface # Read the Right Thing from a unicode file with BOM: open(HANDLE, '<:via(File::BOM)', $filename) # Writing little-endian UTF-16 file with BOM: open(HANDLE, '>:encoding(UTF-16LE):via(File::BOM)', $filename) =head2 lower-level functions # read BOM encoding from a filehandle: $encoding = get_encoding_from_filehandle(FH) # Get encoding even if FH is unseekable: ($encoding, $spillage) = get_encoding_from_filehandle(FH); # Get encoding from a known unseekable handle: ($encdoing, $spillage) = get_encoding_from_stream(FH); # get encoding and BOM length from BOM at start of string: ($encoding, $offset) = get_encoding_from_bom($string); =head2 variables # print a BOM for a known encoding print FH $enc2bom{$encoding}; # get an encoding from a known BOM $enc = $bom2enc{$bom} =head1 DESCRIPTION This module provides functions for handling unicode byte order marks, which are to be found at the beginning of some files and streams. For details about what a byte order mark is, see L The intention of File::BOM is for files with BOMs to be readable as seamlessly as possible, regardless of the encoding used. To that end, several different interfaces are available, as shown in the synopsis above. =cut use strict; use warnings; # We don't want any character semantics at all use bytes; use base qw( Exporter ); use Readonly; use Carp qw( croak ); use Fcntl qw( :seek ); use Encode qw( :DEFAULT :fallbacks is_utf8 ); use Symbol qw( gensym qualify_to_ref ); my @subs = qw( open_bom defuse decode_from_bom get_encoding_from_bom get_encoding_from_filehandle get_encoding_from_stream ); my @vars = qw( %bom2enc %enc2bom ); our $VERSION = '0.18'; our @EXPORT = (); our @EXPORT_OK = ( @subs, @vars ); our %EXPORT_TAGS = ( all => \@EXPORT_OK, subs => \@subs, vars => \@vars ); =head1 EXPORTS Nothing by default. =head2 symbols =over 4 =item * open_bom() =item * defuse() =item * decode_from_bom() =item * get_encoding_from_filehandle() =item * get_encoding_from_stream() =item * get_encoding_from_bom() =item * %bom2enc =item * %enc2bom =back =head2 tags =over 4 =item * :all All of the above =item * :subs subroutines only =item * :vars just %bom2enc and %enc2bom =back =cut =head1 VARIABLES =head2 %bom2enc Maps Byte Order marks to their encodings. The keys of this hash are strings which represent the BOMs, the values are their encodings, in a format which is understood by L The encodings represented in this hash are: UTF-8, UTF-16BE, UTF-16LE, UTF-32BE and UTF-32LE =head2 %enc2bom A reverse-lookup hash for bom2enc, with a few aliases used in L, namely utf8, iso-10646-1 and UCS-2. Note that UTF-16, UTF-32 and UCS-4 are not included in this hash. Mainly because Encode::encode automatically puts BOMs on output. See L =cut our(%bom2enc, %enc2bom, $MAX_BOM_LENGTH, $bom_re); # length in bytes of the longest BOM $MAX_BOM_LENGTH = 4; Readonly %bom2enc => ( map { encode($_, "\x{feff}") => $_ } qw( UTF-8 UTF-16BE UTF-16LE UTF-32BE UTF-32LE ) ); Readonly %enc2bom => ( reverse(%bom2enc), map { $_ => encode($_, "\x{feff}") } qw( UCS-2 iso-10646-1 utf8 ) ); { local $" = '|'; my @bombs = sort { length $b <=> length $a } keys %bom2enc; Readonly $MAX_BOM_LENGTH => length $bombs[0]; Readonly $bom_re => qr/^(@bombs)/o; } =head1 FUNCTIONS =head2 open_bom $encoding = open_bom(HANDLE, $filename, $default_mode) ($encoding, $spill) = open_bom(HANDLE, $filename, $default_mode) opens HANDLE for reading on $filename, setting the mode to the appropriate encoding for the BOM stored in the file. On failure, a fatal error is raised, see the DIAGNOSTICS section for details on how to catch these. This is in order to allow the return value(s) to be used for other purposes. If the file doesn't contain a BOM, $default_mode is used instead. Hence: open_bom(FH, 'my_file.txt', ':utf8') Opens my_file.txt for reading in an appropriate encoding found from the BOM in that file, or as a UTF-8 file if none is found. In the absence of a $default_mode argument, the following 2 calls should be equivalent: open_bom(FH, 'no_bom.txt'); open(FH, '<', 'no_bom.txt'); If an undefined value is passed as the handle, a symbol will be generated for it like open() does: # create filehandle on the fly $enc = open_bom(my $fh, $filename, ':utf8'); $line = <$fh>; The filehandle will be cued up to read after the BOM. Unseekable files (e.g. fifos) will cause croaking, unless called in list context to catch spillage from the handle. Any spillage will be automatically decoded from the encoding, if found. e.g. # croak if my_socket is unseekable open_bom(FH, 'my_socket'); # keep spillage if my_socket is unseekable ($encoding, $spillage) = open_bom(FH, 'my_socket'); # discard any spillage from open_bom ($encoding) = open_bom(FH, 'my_socket'); =cut sub open_bom (*$;$) { my($fh, $filename, $mode) = @_; if (defined $fh) { $fh = qualify_to_ref($fh, caller); } else { $fh = $_[0] = gensym(); } my $enc; my $spill = ''; open($fh, '<', $filename) or croak "Couldn't read '$filename': $!"; if (wantarray) { ($enc, $spill) = get_encoding_from_filehandle($fh); } else { $enc = get_encoding_from_filehandle($fh); } if ($enc) { $mode = ":encoding($enc)"; $spill = decode($enc, $spill, FB_CROAK) if $spill; } if ($mode) { binmode($fh, $mode) or croak "Couldn't set binmode of handle opened on '$filename' " . "to '$mode': $!"; } return wantarray ? ($enc, $spill) : $enc; } =head2 defuse $enc = defuse(FH); ($enc, $spill) = defuse(FH); FH should be a filehandle opened for reading, it will have the relevant encoding layer pushed onto it be binmode if a BOM is found. Spillage should be Unicode, not bytes. Any uncaptured spillage will be silently lost. If the handle is unseekable, use list context to avoid data loss. If no BOM is found, the mode will be unaffected. =cut sub defuse (*) { my $fh = qualify_to_ref(shift, caller); my($enc, $spill) = get_encoding_from_filehandle($fh); if ($enc) { binmode($fh, ":encoding($enc)"); $spill = decode($enc, $spill, FB_CROAK) if $spill; } return wantarray ? ($enc, $spill) : $enc; } =head2 decode_from_bom $unicode_string = decode_from_bom($string, $default, $check) ($unicode_string, $encoding) = decode_from_bom($string, $default, $check) Reads a BOM from the beginning of $string, decodes $string (minus the BOM) and returns it to you as a perl unicode string. if $string doesn't have a BOM, $default is used instead. $check, if supplied, is passed to Encode::decode as the third argument. If there's no BOM and no default, the original string is returned and encoding is ''. See L =cut sub decode_from_bom ($;$$) { my($string, $default, $check) = @_; croak "No string" unless defined $string; my($enc, $off) = get_encoding_from_bom($string); $enc ||= $default; my $out; if (defined $enc) { $out = decode($enc, substr($string, $off), $check); } else { $out = $string; $enc = ''; } return wantarray ? ($out, $enc) : $out; } =head2 get_encoding_from_filehandle $encoding = get_encoding_from_filehandle(HANDLE) ($encoding, $spillage) = get_encoding_from_filehandle(HANDLE) Returns the encoding found in the given filehandle. The handle should be opened in a non-unicode way (e.g. mode '<:bytes') so that the BOM can be read in its natural state. After calling, the handle will be set to read at a point after the BOM (or at the beginning of the file if no BOM was found) If called in scalar context, unseekable handles cause a croak(). If called in list context, unseekable handles will be read byte-by-byte and any spillage will be returned. See get_encoding_from_stream() =cut sub get_encoding_from_filehandle (*) { my $fh = qualify_to_ref(shift, caller); my $enc; my $spill = ''; if (seek($fh, 0, SEEK_SET)) { $enc = _get_encoding_seekable($fh); } elsif (wantarray) { ($enc, $spill) = _get_encoding_unseekable($fh); } else { croak "Unseekable handle: $!"; } return wantarray ? ($enc, $spill) : $enc; } =head2 get_encoding_from_stream ($encoding, $spillage) = get_encoding_from_stream(*FH); Read a BOM from an unrewindable source. This means reading the stream one byte at a time until either a BOM is found or every possible BOM is ruled out. Any non-BOM bytes read from the handle will be returned in $spillage. If a BOM is found and the spillage contains a partial character (judging by the expected character width for the encoding) more bytes will be read from the handle to ensure that a complete character is returned. Spillage is always in bytes, not characters. This function is less efficient than get_encoding_from_filehandle, but should work just as well on a seekable handle as on an unseekable one. =cut sub get_encoding_from_stream (*) { my $fh = qualify_to_ref(shift, caller); _get_encoding_unseekable($fh); } # internal: # # Return encoding and seek to position after BOM sub _get_encoding_seekable (*) { my $fh = shift; # This doesn't work on all platforms: # defined(read($fh, my $bom, $MAX_BOM_LENGTH)) # or croak "Couldn't read from handle: $!"; my $bom = eval { _safe_read($fh, $MAX_BOM_LENGTH) }; croak "Couldn't read from handle: $@" if $@; my($enc, $off) = get_encoding_from_bom($bom); seek($fh, $off, SEEK_SET) or croak "Couldn't reset read position: $!"; return $enc; } # internal: # # Return encoding and non-BOM overspill sub _get_encoding_unseekable (*) { my $fh = shift; my $so_far = ''; for my $c (1 .. $MAX_BOM_LENGTH) { # defined(read($fh, my $byte, 1)) or croak "Couldn't read byte: $!"; my $byte = eval { _safe_read($fh, 1) }; croak "Couldn't read byte: $@" if $@; $so_far .= $byte; # find matching BOMs my @possible = grep { $so_far eq substr($_, 0, $c) } keys %bom2enc; if (@possible == 1 and my $enc = $bom2enc{$so_far}) { # There's only one match, this must be it return ($enc, ''); } elsif (@possible == 0) { # might need to backtrack one byte my $spill = chop $so_far; if (my $enc = $bom2enc{$so_far}) { my $char_length = _get_char_length($enc, $spill); my $extra = eval { _safe_read($fh, $char_length - length $spill); }; croak "Coudln't read byte: $@" if $@; $spill .= $extra; return ($enc, $spill); } else { # no BOM return ('', $so_far . $spill); } } } } sub _safe_read { my ($fh, $count) = @_; # read is supposed to return undef on error, but on some platforms it # seems to just return 0 and set $! local $!; my $status = read($fh, my $out, $count); die $! if !$status && $!; return $out; } =head2 get_encoding_from_bom ($encoding, $offset) = get_encoding_from_bom($string) Returns the encoding and length in bytes of the BOM in $string. If there is no BOM, an empty string is returned and $offset is zero. To get the data from the string, the following should work: use Encode; my($encoding, $offset) = get_encoding_from_bom($string); if ($encoding) { $string = decode($encoding, substr($string, $offset)) } =cut sub get_encoding_from_bom ($) { my $bom = shift; my $encoding = ''; my $offset = 0; if (my($found) = $bom =~ $bom_re) { $encoding = $bom2enc{$found}; $offset = length($found); } return ($encoding, $offset); } # Internal: # Work out character length for given encoding and spillage byte sub _get_char_length ($$) { my($enc, $byte) = @_; if ($enc eq 'UTF-8') { if (($byte & 0x80) == 0) { return 1; } else { my $length = 0; 1 while (($byte << $length++) & 0xc0) == 0xc0; return $length; } } elsif ($enc =~ /^UTF-(16|32)/) { return $1 / 8; } else { return; } } =head1 PerlIO::via interface File::BOM can be used as a PerlIO::via interface. open(HANDLE, '<:via(File::BOM)', 'my_file.txt'); open(HANDLE, '>:encoding(UTF-16LE):via(File::BOM)', 'out_file.txt'); print "foo\n"; # BOM is written to file here This method is less prone to errors on non-seekable files as spillage is incorporated into an internal buffer, but it doesn't give you any information about the encoding being used, or indeed whether or not a BOM was present. There are a few known problems with this interface, especially surrounding seek() and tell(), please see the BUGS section for more details about this. =head2 Reading The via(File::BOM) layer must be added before the handle is read from, otherwise any BOM will be missed. If there is no BOM, no decoding will be done. Because of a limitation in PerlIO::via, read() always works on bytes, not characters. BOM decoding will still be done but output will be bytes of UTF-8. open(BOM, '<:via(File::BOM)', $file); $bytes_read = read(BOM, $buffer, $length); $unicode = decode('UTF-8', $buffer, Encode::FB_QUIET); # Now $unicode is valid unicode and $buffer contains any left-over bytes =head2 Writing Add the via(File::BOM) layer on top of a unicode encoding layer to print a BOM at the start of the output file. This needs to be done before any data is written. The BOM is written as part of the first print command on the handle, so if you don't print anything to the handle, you won't get a BOM. There is a "Wide character in print" warning generated when the via(File::BOM) layer doesn't receive utf8 on writing. This glitch was resolved in perl version 5.8.7, but if your perl version is older than that, you'll need to make sure that the via(File::BOM) layer receives utf8 like this: # This works OK open(FH, '>:encoding(UTF-16LE):via(File::BOM):utf8', $filename) # This generates warnings with older perls open(FH, '>:encoding(UTF-16LE):via(File::BOM)', $filename) =head2 Seeking Seeking with SEEK_SET results in an offset equal to the length of any detected BOM being applied to the position parameter. Thus: # Seek to end of BOM (not start of file!) seek(FILE_BOM_HANDLE, 0, SEEK_SET) =head2 Telling In order to work correctly with seek(), tell() also returns a postion adjusted by the length of the BOM. =cut sub PUSHED { bless({offset => 0}, $_[0]) || -1 } sub UTF8 { # There is a bug with this method previous to 5.8.7 if ($] >= 5.008007) { return 1; } else { return 0; } } sub FILL { my($self, $fh) = @_; my $line; if (not defined $self->{enc}) { ($self->{enc}, my $spill) = get_encoding_from_filehandle($fh); if ($self->{enc} ne '') { binmode($fh, ":encoding($self->{enc})"); $line .= decode($self->{enc}, $spill, FB_CROAK) if $spill; $self->{offset} = length $enc2bom{$self->{enc}}; } $line .= <$fh>; } else { $line = <$fh>; } return $line; } sub WRITE { my($self, $buf, $fh) = @_; if (tell $fh == 0 and not $self->{wrote_bom}) { print $fh "\x{feff}"; $self->{wrote_bom} = 1; } $buf = decode('UTF-8', $buf, FB_CROAK); print $fh $buf; return 1; } sub FLUSH { 0 } sub SEEK { my $self = shift; my($pos, $whence, $fh) = @_; if ($whence == SEEK_SET) { $pos += $self->{offset}; } if (seek($fh, $pos, $whence)) { return 0; } else { return -1; } } sub TELL { my($self, $fh) = @_; my $pos = tell $fh; if ($pos == -1) { return -1; } else { return $pos - $self->{offset}; } } 1; __END__ =head1 SEE ALSO =over 4 =item * L =item * L =item * L =back =head1 DIAGNOSTICS The following exceptions are raised via croak() =over 4 =item * Couldn't read '': $! open_bom() couldn't open the given file for reading =item * Couldn't set binmode of handle opened on '' to '': $! open_bom() couldn't set the binmode of the handle =item * No string decode_from_bom called on an undefined value =item * Unseekable handle: $! get_encoding_from_filehandle() or open_bom() called on an unseekable file or handle in scalar context. =item * Couldn't read from handle: $! _get_encoding_seekable() couldn't read the handle. This function is called from get_encoding_from_filehandle(), defuse() and open_bom() =item * Couldn't reset read position: $! _get_encoding_seekable couldn't seek to the position after the BOM. =item * Couldn't read byte: $! get_encoding_from_stream couldn't read from the handle. This function is called from get_encoding_from_filehandle() and open_bom() when the handle or file is unseekable. =back =head1 BUGS Older versions of PerlIO::via have a few problems with writing, see above. The current version of PerlIO::via has limitations with regard to seek and tell, currently only line-wise seek and tell are supported by this module. If read() is used to read partial lines, tell() will still give the position of the end of the last line read. Under windows, tell() seems to return erroneously when reading files with unix line endings. Under windows, warnings may be generated when using the PerlIO::via interface to read UTF-16LE and UTF-32LE encoded files. This seems to be a bug in the relevant encoding(...) layers. =head1 AUTHOR Matt Lawrence Emattlaw@cpan.orgE With thanks to Mark Fowler and Steve Purkis for additional tests and advice. =head1 COPYRIGHT Copyright 2005 Matt Lawrence, All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut File-BOM-0.18/t000755000765000024 013652756333 13455 5ustar00mlawrencestaff000000000000File-BOM-0.18/t/00..setup.t000444000765000024 27313652756333 15415 0ustar00mlawrencestaff000000000000 use strict; use warnings; use lib qw( t/lib ); use Test::Framework; use Test::Simple tests => 1; # write test files, see Test::Framework make_test_data; ok(1); __END__ vim: ft=perl File-BOM-0.18/t/01..bom.t000444000765000024 1340313652756333 15072 0ustar00mlawrencestaff000000000000#!/usr/bin/perl use strict; use warnings; use lib qw( t/lib ); use Test::More; use Test::Framework; use Encode qw( encode decode :fallback_all ); use Fcntl qw( :seek ); our @encodings; BEGIN { # encodings to use in unseekable test @encodings = qw( UTF-8 UTF-16LE UTF-16BE UTF-32LE UTF-32BE ); plan tests => 11 + (@test_files * 14) + (@encodings * 4); use_ok("File::BOM", ':all'); } # Ignore known harmless warning local $SIG{__WARN__} = sub { my $warning = "@_"; if ($warning !~ /^UTF-(?:16|32)LE:Partial character/) { warn $warning; } }; for my $file (@test_files) { my $file_enc = $file2enc{$file}; is(open_bom(FH, $file2path{$file}), $file2enc{$file}, "$file: open_bom returned encoding"); my $expect = $filecontent{$file}; my $line = ; chomp $line; is($line, $expect, "$file: test content returned OK"); close FH; { # test defuse open BOMB, '<', $file2path{$file} or die "Couldn't read '$file2path{$file}': $!"; my $enc = defuse BOMB; is($enc, $file_enc, "$file: defuse returns correct encoding ($enc)"); $line = ; chomp $line; is($line, $expect, "$file: defused version content OK"); close BOMB; } open FH, '<', $file2path{$file}; my $first_line; { local $/ = $fileeol{$file}; $first_line = ; chomp $first_line; } seek(FH, 0, SEEK_SET); is(get_encoding_from_filehandle(FH), $file_enc, "$file: get_encoding_from_filehandle returned correct encoding"); my($enc, $offset) = get_encoding_from_bom($first_line); is($enc, $file_enc, "$file: get_encoding_from_bom also worked"); { my $decoded = $enc ? decode($enc, substr($first_line, $offset)) : $first_line; is($decoded, $expect, "$file: .. and offset worked with substr()"); } # # decode_from_bom() # my $result = decode_from_bom($first_line, 'UTF-8', FB_CROAK); is($result, $expect, "$file: decode_from_bom() scalar context"); { # with default my $default = 'UTF-8'; my $expect_enc = $file_enc || $default; my($decoded, $got_enc) = decode_from_bom($first_line, $default, FB_CROAK); is($decoded, $expect, "$file: decode_from_bom() list context"); is($got_enc, $expect_enc, "$file: decode_from_bom() list context encoding"); } { # without default my $expect_enc = $file_enc; my($decoded, $got_enc) = decode_from_bom($first_line, undef, FB_CROAK); is($decoded, $expect, "$file: decode_from_bom() list context, no default"); is($got_enc, $expect_enc, "$file: decode_from_bom() list context encoding, no default"); } seek(FH, 0, SEEK_SET); ($enc, my $spill) = get_encoding_from_stream(FH); $line = ; chomp $line; is($enc, $file_enc, "$file: get_encoding_from_stream()"); $line = $spill . $line; $line = decode($enc, $line) if $enc; is($line, $expect, "$file: read OK after get_encoding_from_stream"); close FH; } # Test unseekable SKIP: { my $tests = 4 * @encodings; skip "mkfifo not supported on this platform", $tests unless $fifo_supported; skip "mkfifo tests skipped on cygwin, set TEST_FIFO to enable them", $tests if $^O eq 'cygwin' && !$ENV{'TEST_FIFO'}; for my $encoding (@encodings) { my($pid, $fifo, $enc, $spill, $result); # We need two copies of this as the encode below is destructive! my $expected = my $test = "Testing \x{2170}, \x{2171}, \x{2172}\n"; my $bytes = $enc2bom{$encoding} . encode($encoding, $test, FB_CROAK); ($pid, $fifo) = write_fifo($bytes); ($enc, $spill) = open_bom(my $fh, $fifo); $result = $spill . <$fh>; close $fh; waitpid($pid, 0); unlink $fifo; is($enc, $encoding, "Read BOM correctly in unseekable $encoding file"); is($result, $expected, "Read $encoding data from unseekable source"); # Now test defuse too ($pid, $fifo) = write_fifo($bytes); open($fh, '<:utf8', $fifo) or die "Couldn't read '$fifo': $!"; ($enc, $spill) = defuse $fh; $result = $spill . <$fh>; close $fh; waitpid($pid, 0); unlink $fifo; is($enc, $encoding, "defused fifo OK ($encoding)"); is($result, $expected, "read defused fifo OK ($encoding)") or diag( "Hex dump:\n". "Got: ". hexdump($result) ."\n". "Expected: ". hexdump($expected) ."\n". "Spillage: ". hexdump($spill) ); } } # Test broken BOM { my $broken_content = "\xff\xffThis file has a broken BOM"; my $broken_file = 't/data/broken_bom.txt'; my($enc, $spill) = open_bom(my $fh, $broken_file); is($enc, '', "open_bom on file with broken BOM has no encoding"); { my $line = <$fh>; chomp $line; is($line, $broken_content, "handle with broken BOM returns as expected"); } SKIP: { skip "mkfifo not supported on this platform", 3 unless $fifo_supported; skip "mkfifo tests skipped on cygwin, set TEST_FIFO to enable them", 3 if $^O eq 'cygwin' && !$ENV{'TEST_FIFO'}; my($pid, $fifo) = write_fifo($broken_content); open my $fh, '<', $fifo or die "Cannot read fifo '$fifo': $!"; my($enc, $spill) = get_encoding_from_filehandle($fh); is($enc, '', "get_encoding_from_filehandle() on unseekable file broken bom"); ok($spill, ".. spillage was produced"); is($spill . <$fh>, $broken_content, "spillage + content as expected"); close $fh; waitpid($pid, 0); unlink $fifo; } } # Test internals is(File::BOM::_get_char_length('UTF-8', 0xe5), 3, '_get_char_length() on UTF-8 start byte (3)'); is(File::BOM::_get_char_length('UTF-8', 0xd5), 2, '_get_char_length() on UTF-8 start byte (2)'); is(File::BOM::_get_char_length('UTF-8', 0x7f), 1, '_get_char_langth() on UTF-8 single byte char'); is(File::BOM::_get_char_length('', ''), undef, '_get_char_length() on undef'); is(File::BOM::_get_char_length('UTF-32BE', ''), 4, '_get_char_length() on UTF-32'); __END__ vim: ft=perl File-BOM-0.18/t/02..perlio-via.t000444000765000024 1101513652756333 16362 0ustar00mlawrencestaff000000000000#!/usr/bin/perl use strict; use warnings; use lib qw( t/lib ); use Test::More; use Test::Framework; use Fcntl qw( :seek ); use File::BOM qw( %enc2bom ); # Expected data for "moose" tests (below) our %should_be = ( 'UTF-8' => "\x{ef}\x{bb}\x{bf}m\x{c3}\x{b8}\x{c3}\x{b8}se\x{e2}\x{80}\x{a6}", 'UTF-16BE' => "\x{fe}\x{ff}\x{0}m\x{0}\x{f8}\x{0}\x{f8}\x{0}s\x{0}e &", 'UTF-16LE' => "\x{ff}\x{fe}m\x{0}\x{f8}\x{0}\x{f8}\x{0}s\x{0}e\x{0}& ", 'UTF-32BE' => "\x{0}\x{0}\x{fe}\x{ff}\x{0}\x{0}\x{0}m\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}s\x{0}\x{0}\x{0}e\x{0}\x{0} &", 'UTF-32LE' => "\x{ff}\x{fe}\x{0}\x{0}m\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}\x{f8}\x{0}\x{0}\x{0}s\x{0}\x{0}\x{0}e\x{0}\x{0}\x{0}& \x{0}\x{0}", ); plan tests => 2 * @test_files + 6 * keys(%enc2bom) + keys(%should_be) + 2; # Work around bug in older PerlIO::via # The PerlIO::via version number was not incremented when the bug was fixed. my $compat = $] >= 5.008007 ? '' : ':utf8'; # Ignore known harmless warning local $SIG{__WARN__} = sub { my $warning = "@_"; if ($warning !~ /^UTF-(?:16|32)LE:Partial character/) { warn $warning; } }; for my $test_file (@test_files) { ok( open(FH, "<:via(File::BOM)$compat", $file2path{$test_file}), "$test_file: opened through layer" ) or diag "$test_file: $!"; my $line = ; chomp $line; is($line, $filecontent{$test_file}, "$test_file: read OK through layer") or diag("HEX: ".hexdump($line)); close FH; } for my $enc (sort keys %enc2bom) { my $file = "test_file-$enc.txt"; ok( open(BOM_OUT, ">:encoding($enc):via(File::BOM)$compat", $file), "Opened file for writing $enc via layer" ) or diag "$file: $!"; my $line_one = "Unicode text\x{2026}"; my $test = print(BOM_OUT "$line_one\n"); ok($test, 'print() through layer') or diag("print() returned ". (defined($test)?$test:'undef')); my $line_two = "\x{62cd}\x{8ce3}"; $test = print(BOM_OUT "$line_two\n"); ok($test, 'print() through layer again') or diag("print() returned ". (defined($test)?$test:'undef')); close BOM_OUT; # check BOM if (open my $fh, '<:bytes', $file) { read $fh, my $sample, $File::BOM::MAX_BOM_LENGTH; like($sample, qr/^\Q$enc2bom{$enc}/, "BOM written correctly"); close $fh; } else { diag "Couldn't open $file: $!"; fail(1); } # now re-read my $line; open(BOM_IN, "<:via(File::BOM)$compat", $file); $line = ; chomp $line; is($line, $line_one, 'BOM was written successfully via layer'); $line = ; chomp $line; is($line, $line_two, 'BOM not written in second print call'); close BOM_IN; unlink $file or diag "Couldn't remove $file: $!"; } # Mark Fowler's "moose" test: { # This is 'moose...' (with slashes in the 'o's them, and the '...' # as one char). As the '...' can't be represented in latin-1 then # perl will store the thing internally as a utf8 string with the # utf8 flag enabled. my $moose = "m\x{f8}\x{f8}se\x{2026}"; for my $enc (keys %should_be) { my $file = "moose-$enc.txt"; open(FH, ">:encoding($enc):via(File::BOM)$compat", $file) or die "Can't write to $file: $!\n"; print FH $moose; close FH; open(FH, '<', $file) or die "Can't read $file: $!\n"; local $/ = undef; my $value = ; close FH; is( reasciify($value), reasciify($should_be{$enc}), "check file for $enc" ); unlink $file or diag "Can't remove '$file': $!"; } } # Spurkis' seek test { use utf8; my $file = 't/data/utf8_data.csv'; open my $fh, '>:utf8', $file or die "Can't write $file: $!"; print $fh <<"END_DATA"; \x{feff}id,street,town,pc,country,english,french,chinese,arabic '10,"écoles",zoom,12,france,auctions,"Enchères","拍賣","مزاد" END_DATA open $fh, '<:via(File::BOM)', $file or die "Can't read $file: $!\n"; my $first_line = <$fh>; my $pos = tell($fh); # position of second line my $rest = join('', <$fh>); seek($fh, 0, SEEK_SET) or die "Couldn't seek: $!"; my $new_first_line = <$fh>; seek($fh, $pos, SEEK_SET) or die "Couldn't seek: $!"; my $new_rest = join('', <$fh>); is($new_first_line, $first_line, "seek() works"); is($new_rest, $rest, "tell() works") or diag "Position was $pos"; close $fh; unlink $file or warn "Couldn't remove $file: $!\n"; } # sub for moose test sub reasciify { my $string = shift; $string = join "", map { my $ord = ord($_); ($ord > 127 || ($ord < 32 && $ord != 10)) ? sprintf '\x{%x}', $ord : $_ } split //, $string } __END__ vim: ft=perl File-BOM-0.18/t/03..exceptions.t000444000765000024 462413652756333 16465 0ustar00mlawrencestaff000000000000#!/usr/bin/perl use strict; use warnings; use lib 't/lib'; use Test::Framework; use File::BOM qw( open_bom decode_from_bom get_encoding_from_filehandle ); use File::Temp qw( tmpnam ); use Test::Exception ( tests => 10 ); use Test::More; my $absent = tmpnam(); throws_ok { open_bom(my $fh, $absent) } qr/^Couldn't read/, "open_bom on non-existant file fails"; throws_ok { open_bom(my $fh, ">new_file.txt") } qr(^Couldn't read), "Attempt to open_bom for writing fails"; throws_ok { open_bom(my $fh, "| cat") } qr(^Couldn't read), "Attempt to open_bom as pipe fails"; throws_ok { decode_from_bom(undef) } qr/^No string/, "decode_from_bom with no string fails"; { # The following tests are known to produce warnings local $SIG{__WARN__} = sub {}; my $tmpfile = tmpnam(); open WRITER, '>', $tmpfile or die "Couldn't write to '$tmpfile': $!"; # _get_encoding_* functions don't qualify refs as they are not public # Therefore _get_encoding_seekable(WRITER) will not work throws_ok { File::BOM::_get_encoding_seekable(\*WRITER) } qr/^Couldn't read from handle/, "_get_encoding_seekable on unreadable handle fails"; throws_ok { File::BOM::_get_encoding_unseekable(\*WRITER) } qr/^Couldn't read byte/, "_get_encoding_unseekable() on unreadable handle fails"; close WRITER; unlink $tmpfile; SKIP: { skip "mkfifo not supported on this platform", 3 unless $fifo_supported; skip "mkfifo tests skipped on cygwin, set TEST_FIFO to enable them", 3 if $^O eq 'cygwin' && !$ENV{'TEST_FIFO'}; my($pid, $fifo); ($pid, $fifo) = write_fifo(''); open(STREAM, '<:bytes', $fifo) or die "Couldn't read fifo '$fifo': $!"; throws_ok { File::BOM::_get_encoding_seekable(\*STREAM) } qr/^Couldn't reset read position/, "_get_encoding_seekable on unseekable handle fails"; throws_ok { get_encoding_from_filehandle(STREAM) } qr/^Unseekable handle/, "get_encoding_from_filehandle on unseekable handle fails"; close STREAM; waitpid($pid, 0); unlink $fifo; ($pid, $fifo) = write_fifo(''); lives_ok { my($enc) = open_bom(my $fh, $fifo) } "(\$enc) = open_bom(FH, \$fifo) lives"; waitpid($pid, 0); unlink $fifo; } throws_ok { open_bom(my $fh, 't/data/no_bom.txt', 'invalid') } qr/^Couldn't set binmode of handle opened on/, "open_bom with invalid default encoding fails"; } __END__ vim:ft=perl File-BOM-0.18/t/04..pod.t000444000765000024 141413652756333 15061 0ustar00mlawrencestaff000000000000 BEGIN { our @modules = qw( File::BOM ); } use File::Spec::Functions qw( catfile ); use Test::More tests => our @modules * 2; SKIP: { eval 'use Test::Pod'; skip "Test::Pod not installed", scalar @modules if $@; for my $module (@modules) { my @path = ('lib', split('::', $module)); my $file = pop(@path) . '.pm'; pod_file_ok(catfile(@path, $file), "$module pod ok"); } } SKIP: { eval 'use Test::Pod::Coverage'; skip "Test::Pod::Coverage not installed", scalar @modules if $@; for my $module (@modules) { pod_coverage_ok( $module, { also_private => [ qr(^[[:upper:][:digit:]_]+$) ] }, "$module pod coverage ok" ); } } __END__ vim: ft=perl File-BOM-0.18/t/99..shutdown.t000444000765000024 30013652756333 16141 0ustar00mlawrencestaff000000000000 use strict; use warnings; use lib qw( t/lib ); use Test::Framework; use Test::Simple tests => 1; # unlink test files, see Test::Framework remove_test_data; ok(1); __END__ vim: ft=perl File-BOM-0.18/t/data000755000765000024 013652756333 14366 5ustar00mlawrencestaff000000000000File-BOM-0.18/t/data/broken_bom.txt000444000765000024 3513652756333 17337 0ustar00mlawrencestaff000000000000This file has a broken BOM File-BOM-0.18/t/lib000755000765000024 013652756333 14223 5ustar00mlawrencestaff000000000000File-BOM-0.18/t/lib/Test000755000765000024 013652756333 15142 5ustar00mlawrencestaff000000000000File-BOM-0.18/t/lib/Test/Framework.pm000444000765000024 500613652756333 17573 0ustar00mlawrencestaff000000000000package Test::Framework; # # Common resources for tests # use Encode qw( encode :fallback_all ); use File::Spec::Functions qw( catfile ); use File::Temp qw( tmpnam ); use POSIX qw( mkfifo ); # some of the program text is UTF-8 use utf8; use base qw( Exporter ); our(%file2path, %file2enc, %filecontent, %fileeol, @test_files, $fifo_supported); @EXPORT = qw( make_test_data remove_test_data %file2path %file2enc %filecontent %fileeol @test_files write_fifo $fifo_supported hexdump ); %file2enc = ( 'utf-32le.txt' => 'UTF-32LE', 'utf-32be.txt' => 'UTF-32BE', 'utf-16le.txt' => 'UTF-16LE', 'utf-16be.txt' => 'UTF-16BE', 'utf-8.txt' => 'UTF-8', 'no_bom.txt' => '', ); %filecontent = ( 'utf-32le.txt' => 'Ûñíçôđè', 'utf-32be.txt' => 'Ûñíçôđè', 'utf-16le.txt' => 'Ûñíçôđè', 'utf-16be.txt' => 'Ûñíçôđè', 'utf-8.txt' => 'Ûñíçôđè', 'no_bom.txt' => 'ascii', ); @test_files = keys %file2enc; for (@test_files) { my $enc = $file2enc{$_}; $enc = 'ASCII' if $enc eq ''; my $eol = "\n"; $eol = encode($enc, $eol, FB_CROAK); $fileeol{$_} = $eol; } $file2path{$_} = catfile(qw(t data), $_) for @test_files; # write data into files sub make_test_data { while (my($name, $path) = each %file2path) { my $enc = $file2enc{$name}; my $mode = $enc ? ">:encoding($enc)" : '>'; open my $fh, $mode, $path or die "Can't write '$path': $!\n"; print $fh "\x{feff}" if $enc; print $fh $filecontent{$name}, "\n"; close $fh; } } sub remove_test_data { for my $path (values %file2path) { unlink $path or warn "Couldn't remove '$path': $!"; } } eval { my $tmp = tmpnam; if (mkfifo($tmp, 0700)) { unlink $tmp; } else { die $!; } }; if ($@ =~ /^POSIX::mkfifo not implemented on this architecture/) { $fifo_supported = 0; } else { $fifo_supported = 1; } sub write_fifo ($) { my $bytes = shift; my $fifo = tmpnam(); mkfifo($fifo, 0700) or die "Couldn't create fifo at '$fifo': $!"; my $pid = fork(); if ($pid) { # I'm the parent return ($pid, $fifo); } elsif (!defined $pid) { die "$0: fork: $!"; } else { # I'm the child if (open my $writer, '>', $fifo) { print $writer $bytes; close $writer; } else { unlink $fifo or die "Couldn't write or unlink fifo at '$fifo': $!"; die "Couldn't write to fifo at '$fifo': $!"; } exit 0; } } sub hexdump { use bytes; join(' ', map { unpack("H2", pack("C1", ord)) } split('', $_[0])) } 1;