libperlio-eol-perl-0.14/0000750000175000017500000000000010540662633014760 5ustar bastianbastianlibperlio-eol-perl-0.14/Changes0000640000175000017500000000531210540654464016260 0ustar bastianbastian[Changes for 0.14 - 2006-12-15] * Doc fixes. [Changes for 0.13 - 2004-10-18] * Coupling read() calls with CRLF line endings resulted in false positives in mixed encoding detection, if the read was on the CR/LF boundary. Fixed. [Changes for 0.12 - 2004-10-18] * Building on threaded Perl versions was broken, due to a missing aTHX_ symbol. Reported by Roberto Aguilar. [Changes for 0.11 - 2004-10-16] * Exceptions raised by '!' and '?' now includes the filename. * The exception is reworded as 'Mixed newlines found in "filename", or 'Mixed newlines found' if a filename cannot be obtained. [Changes for 0.10 - 2004-10-16] * In reading "LF!" and "LF?", when an incoming LF is found, simply remember it without altering the input buffer; this saves many Copy() calls. * Add a test on detecting mixed line endings in output streams. [Changes for 0.09 - 2004-10-16] * Mixed line endings may now be detected by appending '!' or '?' symbols to the line ending specifier, eg. ":eol(CRLF!)". * Unified read and write logic into OnceAndOnlyOnce macros. [Changes for 0.08 - 2004-10-15] * Macroize the inner write() loop too. * Further refactor common macros into eol.h. * LF and CR disciplines no longer need to allocate any additional memories during fill(). * Test failures are now displayed in hex code for easier debugging. [Changes for 0.07 - 2004-10-15] * Safely frees allocated buffer memory during reads. * Also safely frees the "eol_r" marker when the layer is pushed. * Correct "unknown eol_w" diagnostics message. [Changes for 0.06 - 2004-10-15] * Macroize the inner fill() loop into fill.h, which saves many cycles. * In particular, 'LF' and 'Native' on LF platforms should now only have minimum overhead over ':raw' if the processed stream does not contain CRs. [Changes for 0.05 - 2004-10-09] * PerlIO_read() calls were returning unneeded errors when the read block is only partially filled. Fix this by taking _read calls into our hands and save some bits of indirection. [Changes for 0.04 - 2004-10-09] * We now optionally exports CR, LF, CRLF and NATIVE constants, at requests from Chia-Liang Kao. * eol_is_mixed is now prototyped as ($). [Changes for 0.03 - 2004-10-08] * Fix building problems on Win32. * Support the "Native" eol style. * Added I/O-specific syntax like "LF-Native", which means reading with LF and writing to Native; this what "svn:eol-style = native" means. * Optionally exports a "eol_is_mixed" function, to determine whether a string has an inconsistent line ending style. [Changes for 0.02 - 2004-10-07] * Fixed the buffer offset problem on non-CRLF settings. * Trailing data for read operations were ignored. Oops. [Changes for 0.01 - 2004-10-07] * Initial release to CPAN. libperlio-eol-perl-0.14/MANIFEST0000640000175000017500000000055110540654464016116 0ustar bastianbastianChanges eol.h eol.pm eol.xs fill.h inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README SIGNATURE t/1-basic.t write.h libperlio-eol-perl-0.14/META.yml0000640000175000017500000000042410540654464016235 0ustar bastianbastianabstract: PerlIO layer for normalizing line endings author: Audrey Tang distribution_type: module generated_by: Module::Install version 0.64 license: perl name: PerlIO-eol no_index: directory: - inc - t requires: perl: 5.7.3 version: 0.14 libperlio-eol-perl-0.14/MANIFEST.SKIP0000640000175000017500000000016110540654464016660 0ustar bastianbastian#defaults ^eol\.(?!pm|xs|h).+$ ^.*\.pdb$ ^MANIFEST.bak$ ^Makefile$ ^Makefile.old$ ^blib/ ^pm_to_blib$ ^blibdirs$ libperlio-eol-perl-0.14/eol.xs0000640000175000017500000001256310540654464016126 0ustar bastianbastian#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "perlio.h" #include "perliol.h" #include "eol.h" #include "fill.h" #include "write.h" IV PerlIOEOL_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { PerlIOEOL *s = PerlIOSelf(f, PerlIOEOL); STDCHAR *p, *eol_w = NULL, *eol_r = NULL; STRLEN len; if (PerlIOBase(PerlIONext(f))->flags & PERLIO_F_UTF8) { PerlIOBase(f)->flags |= PERLIO_F_UTF8; } else { PerlIOBase(f)->flags &= ~PERLIO_F_UTF8; } s->name = NULL; s->read.cr = s->write.cr = 0; s->read.seen = s->write.seen = 0; p = SvPV(arg, len); if (len) { STDCHAR *end = p + len; Newz('e', eol_r, len + 1, char); Copy(p, eol_r, len, char); p = eol_r; end = p + len; for (; p < end; p++) { *p = toLOWER(*p); if ((*p == '-') && (eol_w == NULL)) { *p = '\0'; eol_w = p+1; } } } else { Perl_die(aTHX_ "Must pass CRLF, CR, LF or Native to :eol()."); } if (eol_w == NULL) { eol_w = eol_r; } EOL_AssignEOL( eol_r, s->read ); EOL_AssignEOL( eol_w, s->write ); Safefree( eol_r ); return PerlIOBuf_pushed(aTHX_ f, mode, arg, tab); } STDCHAR * PerlIOEOL_get_base(pTHX_ PerlIO *f) { PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); if (!b->buf) { PerlIOEOL *s = PerlIOSelf(f, PerlIOEOL); if (!b->bufsiz) b->bufsiz = 4096; b->buf = Newz( 'B', b->buf, b->bufsiz * ( (s->read.eol == EOL_CRLF) ? 2 : 1 ), STDCHAR ); if (!b->buf) { b->buf = (STDCHAR *) & b->oneword; b->bufsiz = sizeof(b->oneword); } b->ptr = b->buf; b->end = b->ptr; } return b->buf; } void PerlIOEOL_clearerr(pTHX_ PerlIO *f) { PerlIOEOL *s; if (PerlIOValid(f)) { s = PerlIOSelf(f, PerlIOEOL); if (PerlIOBase(f)->flags & PERLIO_F_EOF) { s->read.cr = s->write.cr = 0; s->read.seen = s->write.seen = 0; } } PerlIOBase_clearerr(aTHX_ f); } SSize_t PerlIOEOL_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { PerlIOEOL *s = PerlIOSelf(f, PerlIOEOL); const STDCHAR *i, *start = vbuf, *end = vbuf; end += (unsigned int)count; EOL_StartUpdate( s->write ); if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) { return 0; } EOL_Dispatch( s->write, WriteWithCR, WriteWithLF, WriteWithCRLF ); if (start >= end) { return count; } return ( (start + PerlIOBuf_write(aTHX_ f, start, end - start)) - (STDCHAR*)vbuf ); } IV PerlIOEOL_fill(pTHX_ PerlIO * f) { IV code = PerlIOBuf_fill(aTHX_ f); PerlIOEOL *s = PerlIOSelf(f, PerlIOEOL); PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); const STDCHAR *i, *start = b->ptr, *end = b->end; STDCHAR *buf = NULL, *ptr = NULL; if (code != 0) { return code; } EOL_StartUpdate( s->read ); EOL_Dispatch( s->read, FillWithCR, FillWithLF, FillWithCRLF ); if (buf == NULL) { return 0; } if (i > start) { Copy(start, ptr, i - start, STDCHAR); ptr += i - start; } b->ptr = b->buf; b->end = b->buf + (ptr - buf); if (buf != b->buf) { Copy(buf, b->buf, ptr - buf, STDCHAR); Safefree(buf); } return 0; } PerlIO * PerlIOEOL_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args) { SV *arg = (narg > 0) ? *args : PerlIOArg; PerlIO *f = PerlIOBuf_open( aTHX_ self, layers, n, mode, fd, imode, perm, old, narg, args ); if (f) { PerlIOEOL *s = PerlIOSelf(f, PerlIOEOL); s->name = savepv( SvPV_nolen(arg) ); } return f; } PerlIO_funcs PerlIO_eol = { sizeof(PerlIO_funcs), "eol", sizeof(PerlIOEOL), PERLIO_K_BUFFERED | PERLIO_K_UTF8, PerlIOEOL_pushed, PerlIOBuf_popped, PerlIOEOL_open, PerlIOBase_binmode, NULL, PerlIOBase_fileno, PerlIOBuf_dup, PerlIOBuf_read, PerlIOBuf_unread, PerlIOEOL_write, PerlIOBuf_seek, PerlIOBuf_tell, PerlIOBuf_close, PerlIOBuf_flush, PerlIOEOL_fill, PerlIOBase_eof, PerlIOBase_error, PerlIOEOL_clearerr, PerlIOBase_setlinebuf, PerlIOEOL_get_base, PerlIOBuf_bufsiz, PerlIOBuf_get_ptr, PerlIOBuf_get_cnt, PerlIOBuf_set_ptrcnt }; MODULE = PerlIO::eol PACKAGE = PerlIO::eol BOOT: #ifdef PERLIO_LAYERS PerlIO_define_layer(aTHX_ &PerlIO_eol); #endif unsigned int eol_is_mixed(arg) SV *arg PROTOTYPE: $ CODE: STRLEN len; register U8 *i, *end; register unsigned int seen = 0; i = (U8*)SvPV(arg, len); end = i + len; RETVAL = 0; for (; i < end; i++) { EOL_CheckForMixedCRLF( seen, EOL_Break, EOL_Seen( seen, EOL_CR, EOL_Break ), break, ( i++ ) ); } OUTPUT: RETVAL char * CR() PROTOTYPE: CODE: RETVAL = "\015"; OUTPUT: RETVAL char * LF() PROTOTYPE: CODE: RETVAL = "\012"; OUTPUT: RETVAL char * CRLF() PROTOTYPE: CODE: RETVAL = "\015\012"; OUTPUT: RETVAL char * NATIVE() PROTOTYPE: CODE: RETVAL = ( (EOL_NATIVE == EOL_CR) ? "\015" : (EOL_NATIVE == EOL_LF) ? "\012" : (EOL_NATIVE == EOL_CRLF) ? "\015\012" : "" ); OUTPUT: RETVAL libperlio-eol-perl-0.14/eol.h0000640000175000017500000000721610540654464015722 0ustar bastianbastiantypedef struct { bool cr; unsigned int eol; unsigned int mixed; unsigned int seen; } PerlIOEOL_Baton; typedef struct { PerlIOBuf base; PerlIOEOL_Baton read; PerlIOEOL_Baton write; STDCHAR *name; } PerlIOEOL; enum { EOL_Mixed_OK, EOL_Mixed_Warn, EOL_Mixed_Fatal }; #define EOL_CR 015 #define EOL_LF 012 #define EOL_CRLF 015 + 012 #ifdef PERLIO_USING_CRLF # define EOL_NATIVE EOL_CRLF #else # ifdef MACOS_TRADITIONAL # define EOL_NATIVE EOL_CR # else # define EOL_NATIVE EOL_LF # endif #endif #define EOL_LoopBegin \ for (i = start; i < end; i++) { #define EOL_LoopEnd \ start = i + 1; \ } #define EOL_LoopForMixed( baton, do_break, do_lf ) \ EOL_LoopBegin; \ EOL_CheckForMixedCRLF( baton.seen, do_break, NOOP, do_lf, NOOP ); #define EOL_CheckForMixedCRLF( seen, do_break, do_cr, do_lf, do_crlf ) \ switch (*i) { \ case EOL_LF: \ EOL_Seen( seen, EOL_LF, do_break ); do_lf; \ case EOL_CR: \ if (i == end - 1) { \ do_cr; \ } \ else if ( i[1] != EOL_LF ) { \ EOL_Seen( seen, EOL_CR, do_break ); \ } \ else { \ EOL_Seen( seen, EOL_CRLF, do_break ); \ do_crlf; \ } \ break; \ default: \ continue; \ } #define EOL_LoopForCR \ EOL_LoopBegin; \ if (*i != EOL_CR) continue; #define EOL_LoopForCRorLF \ EOL_LoopBegin; \ if ( (*i != EOL_CR) && (*i != EOL_LF) ) continue; #define EOL_CheckForCRLF(baton) \ if (i == end - 1) { \ baton.cr = 1; \ } \ else if (i[1] == EOL_LF) { \ i++; \ } #define EOL_AssignEOL(sym, baton) \ if ( strnEQ( sym, "crlf", 4 ) ) { baton.eol = EOL_CRLF; } \ else if ( strnEQ( sym, "cr", 2 ) ) { baton.eol = EOL_CR; } \ else if ( strnEQ( sym, "lf", 2 ) ) { baton.eol = EOL_LF; } \ else if ( strnEQ( sym, "native", 6 ) ) { baton.eol = EOL_NATIVE; } \ else { \ Perl_die(aTHX_ "Unknown eol '%s'; must pass CRLF, CR or LF or Native to :eol().", sym); \ } \ if (strchr( sym, '!' )) { baton.mixed = EOL_Mixed_Fatal; } \ else if (strchr( sym, '?' )) { baton.mixed = EOL_Mixed_Warn; } \ else { baton.mixed = EOL_Mixed_OK; } #define EOL_Dispatch(baton, run_cr, run_lf, run_crlf) \ switch ( baton.eol ) { \ case EOL_LF: \ EOL_Loop( baton, EOL_LoopForCR, run_lf, continue ); break; \ case EOL_CRLF: \ EOL_Loop( baton, EOL_LoopForCRorLF, run_crlf, break ); break; \ case EOL_CR: \ EOL_Loop( baton, EOL_LoopForCRorLF, run_cr, break ); break; \ } #define EOL_StartUpdate(baton) \ if (baton.cr && *start == EOL_LF) { start++; } \ baton.cr = 0; #define EOL_Break \ RETVAL = (i + len - end); break; #define EOL_Break_Error(do_error) \ if (s->name == NULL) { \ do_error(aTHX_ "Mixed newlines"); \ } \ else { \ do_error(aTHX_ "Mixed newlines found in \"%s\"", s->name); \ } #define EOL_Seen(seen, sym, do_break) \ if (seen && (seen != sym)) { do_break; } \ seen = sym; #define EOL_Loop( baton, run_check, run_loop, do_lf ) \ switch ( baton.mixed ) { \ case EOL_Mixed_OK: \ run_check; run_loop; EOL_LoopEnd; break; \ case EOL_Mixed_Fatal: \ EOL_LoopForMixed( baton, EOL_Break_Error(Perl_die), do_lf ); run_loop; EOL_LoopEnd; break; \ case EOL_Mixed_Warn: \ EOL_LoopForMixed( baton, EOL_Break_Error(Perl_warn), do_lf ); run_loop; EOL_LoopEnd; \ } /* vim: set filetype=perl: */ libperlio-eol-perl-0.14/write.h0000640000175000017500000000124110540654464016265 0ustar bastianbastian#define WriteInsert(sym, len) \ if (PerlIOBuf_write(aTHX_ f, sym, len) < len) \ return i - (STDCHAR*)vbuf; #define WriteOutBuffer \ WriteInsert( start, (i - start) ); #define WriteCheckForCRLF \ EOL_CheckForCRLF( s->write ); #define WriteCheckForCRandCRLF \ if (*i == EOL_CR) { WriteCheckForCRLF }; #define WriteWithCRLF \ WriteOutBuffer; \ WriteInsert( "\015\012", 2 ); \ WriteCheckForCRandCRLF; #define WriteWithLF \ WriteOutBuffer; \ WriteInsert( "\012", 1 ); \ WriteCheckForCRLF; #define WriteWithCR \ WriteOutBuffer; \ WriteInsert( "\015", 1 ); \ WriteCheckForCRandCRLF; /* vim: set filetype=perl: */ libperlio-eol-perl-0.14/SIGNATURE0000640000175000017500000000366210540662631016252 0ustar bastianbastianThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 3c9f90ac99d91d22c2af4ed3f567f856ef0bd985 Changes SHA1 b2194d300d13657f6e7ac9b989ad8fc23b83fa2b MANIFEST SHA1 beaeb136bb9b65b5075c1513d3bb3aa6bd25c920 MANIFEST.SKIP SHA1 b7044441c2889305242d3b2bb29fdcbe01413429 META.yml SHA1 c29e4325397f897df803facf302a288232a0f59b Makefile.PL SHA1 f5bb5345d1ca213dc7c6162429637128af3d58df README SHA1 377a237019aa8f8cd2c3ea68534c381d79c490e1 eol.h SHA1 153752ee0c84f1a951c401de94260d9283205135 eol.pm SHA1 fae0a5f704d5832abab2845ef21391fa63d48737 eol.xs SHA1 644099b95cfcaef54d5425bbaaef78b1abe39028 fill.h SHA1 9b2f9d83bcf77860f53a0c07c90a4a59ad9f5df1 inc/Module/Install.pm SHA1 abe32855d75ab13747cf65765af9947b7a8c3057 inc/Module/Install/Base.pm SHA1 95b81d1e91bd634467bf633571eff4420e9c04eb inc/Module/Install/Can.pm SHA1 1fe98c63cf9d7271c8cb4183ba230f152df69e26 inc/Module/Install/Fetch.pm SHA1 2249171a2b72cd73ff2c0a06597d29f86e5df456 inc/Module/Install/Makefile.pm SHA1 381bb98ea3877bba49ae85e7a7ea130645fd3dbf inc/Module/Install/Metadata.pm SHA1 0c2118868ef82ac517eb6d9c3bd93e6eb9bbf83e inc/Module/Install/Win32.pm SHA1 e827d6d43771032fa3df35c0ad5e5698d0e54cda inc/Module/Install/WriteAll.pm SHA1 ea20fbff6699364086030ab417031b910f71027f t/1-basic.t SHA1 6955bc7d682be6e2f07619fc980845dea370f991 write.h -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.3 (Darwin) iD8DBQFFg2WZtLPdNzw1AaARAnoFAJ4mwZAZoCi8mV1sO0vxD3zsDCI7KACgh/Xh O/B5uhGNr4MS2CIsVk4rpb8= =uwyd -----END PGP SIGNATURE----- libperlio-eol-perl-0.14/README0000640000175000017500000000107510540654464015647 0ustar bastianbastianThis is the README file for PerlIO::eol, a PerlIO layer for normalizing line endings. It requires Perl version 5.7.3 or later. * Installation PerlIO::eol uses the standard perl module install process: cpansign -v # optional; see SIGNATURE for details perl Makefile.PL make # or 'nmake' on Win32; see notes below make test make install * Copyright Copyright 2004-2006 by Audrey Tang . All rights reserved. You can redistribute and/or modify this bundle under the same terms as Perl itself. See . libperlio-eol-perl-0.14/fill.h0000640000175000017500000000167410540654464016073 0ustar bastianbastian#define FillCopyBuffer \ Copy(start, ptr, i - start, STDCHAR); \ ptr += i - start; #define FillInitializeBufferCopy \ if (buf == NULL) { \ New('b', buf, (i - start) + ((end - i + 1) * 2), STDCHAR); \ ptr = buf; \ } \ FillCopyBuffer; #define FillInitializeBuffer \ if (buf == NULL) { \ ptr = buf = b->buf; \ } \ FillCopyBuffer; #define FillCheckForCRLF \ EOL_CheckForCRLF( s->read ); #define FillCheckForCRandCRLF \ if (*i == EOL_CR) { FillCheckForCRLF }; #define FillInsertCR \ *ptr++ = EOL_CR; #define FillInsertLF \ *ptr++ = EOL_LF; #define FillWithCRLF \ FillInitializeBufferCopy; \ FillInsertCR; \ FillInsertLF; \ FillCheckForCRandCRLF; #define FillWithLF \ FillInitializeBuffer; \ FillInsertLF; \ FillCheckForCRLF; #define FillWithCR \ FillInitializeBuffer; \ FillInsertCR; \ FillCheckForCRandCRLF; /* vim: set filetype=perl: */ libperlio-eol-perl-0.14/t/0000750000175000017500000000000010540662633015223 5ustar bastianbastianlibperlio-eol-perl-0.14/t/1-basic.t0000640000175000017500000000437710540654463016645 0ustar bastianbastianuse strict; use Test::More tests => 23; BEGIN { use_ok('PerlIO::eol', qw( eol_is_mixed CR LF CRLF NATIVE )) } my ($CR, $LF, $CRLF) = (CR, LF, CRLF); is( eol_is_mixed("."), 0 ); is( eol_is_mixed(".$CRLF."), 0 ); is( eol_is_mixed(".$CR.$LF."), 3 ); is( eol_is_mixed(".$CRLF.$CR"), 4 ); $/ = undef; sub is_hex ($$;$) { @_ = ( join(' ', unpack '(H2)*', $_[0]), join(' ', unpack '(H2)*', $_[1]), $_[2], ); goto &is; } { open my $w, ">:raw", "read" or die "can't create testfile: $!"; print $w "...$CRLF$LF$CR..."; } { ok(open(my $r, "<:raw:eol(CR)", "read"), "open for read"); is_hex(<$r>, "...$CR$CR$CR...", "read"); } { ok(open(my $r, "<:raw:eol(LF)", "read"), "open for read"); is_hex(<$r>, "...$LF$LF$LF...", "read"); } { ok(open(my $r, "<:raw:eol(CRLF)", "read"), "open for read"); is_hex(<$r>, "...$CRLF$CRLF$CRLF...", "read"); } { local $@; ok(open(my $r, "<:raw:eol(CR!)", "read"), "open for read"); is(eval { <$r> }, undef, 'mixed encoding'); like($@, qr/Mixed newlines/, 'raises exception'); } { ok(open(my $r, "<:raw:eol(CRLF?)", "read"), "open for read"); my $warning; local $SIG{__WARN__} = sub { $warning = $_[0] }; is_hex(<$r>, "...$CRLF$CRLF$CRLF...", "read"); like($warning, qr/Mixed newlines found in "read"/, 'raises exception'); } { local $@; open my $w, ">:raw:eol(LF!)", "write" or die "can't create testfile: $!"; eval { print $w "...$CRLF$LF$CR..." }; like($@, qr/Mixed newlines found in "write"/, 'raises exception'); } TODO: { local $@; local $TODO = 'Trailing CR in mixed encodings'; open my $w, ">:raw:eol(LF!)", "write" or die "can't create testfile: $!"; eval { print $w "...$CRLF$CR" }; like($@, qr/Mixed newlines found in "write"/, 'raises exception'); } { ok(open(my $w, ">:raw:eol(CrLf-lf)", "write"), "open for write"); print $w "...$CR$LF..."; } { open my $r, "<:raw", "write" or die "can't read testfile: $!"; is_hex(<$r>, "...$LF...", "write"); } { ok(open(my $w, ">:raw:eol(LF-Native)", "write"), "open for write"); print $w "...$CR"; } { open my $r, "<", "write" or die "can't read testfile: $!"; is_hex(<$r>, "...\n", "write"); } END { unlink "read"; unlink "write"; } libperlio-eol-perl-0.14/eol.pm0000640000175000017500000000434710540654464016111 0ustar bastianbastianpackage PerlIO::eol; use 5.007003; use XSLoader; use Exporter; our $VERSION = '0.14'; our @ISA = qw(Exporter); # symbols to export on request our @EXPORT_OK = qw(eol_is_mixed CR LF CRLF NATIVE); XSLoader::load __PACKAGE__, $VERSION; 1; =head1 NAME PerlIO::eol - PerlIO layer for normalizing line endings =head1 VERSION This document describes version 0.14 of PerlIO::eol, released December 18, 2006. =head1 SYNOPSIS binmode STDIN, ":raw:eol(LF)"; binmode STDOUT, ":raw:eol(CRLF)"; open FH, "+<:raw:eol(LF-Native)", "file"; binmode STDOUT, ":raw:eol(CRLF?)"; # warns on mixed newlines binmode STDOUT, ":raw:eol(CRLF!)"; # dies on mixed newlines use PerlIO::eol qw( eol_is_mixed ); my $pos = eol_is_mixed( "mixed\nstring\r" ); =head1 DESCRIPTION This layer normalizes any of C, C, C and C into the designated line ending. It works for both input and output handles. If you specify two different line endings joined by a C<->, it will use the first one for reading and the second one for writing. For example, the C encoding means that all input should be normalized to C, and all output should be normalized to C. By default, data with mixed newlines are normalized silently. Append a C to the line ending will raise a fatal exception when mixed newlines are spotted. Append a C will raise a warning instead. It is advised to pop any potential C<:crlf> or encoding layers before this layer; this is usually done using a C<:raw> prefix. This module also optionally exports a C function; it takes a string and returns the position of the first inconsistent line ending found in that string, or C<0> if the line endings are consistent. The C, C, C and C constants are also exported at request. =head1 AUTHORS Audrey Tang Eautrijus@autrijus.orgE. Janitorial help by Gaal Yahas Egaal@forum2.orgE. Inspired by L by Ben Morrow, EPerlIO-eol@morrow.me.ukE. =head1 COPYRIGHT Copyright 2004-2006 by Audrey Tang Eaudreyt@audreyt.orgE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut libperlio-eol-perl-0.14/inc/0000750000175000017500000000000010540662633015531 5ustar bastianbastianlibperlio-eol-perl-0.14/inc/Module/0000750000175000017500000000000010540662633016756 5ustar bastianbastianlibperlio-eol-perl-0.14/inc/Module/Install.pm0000640000175000017500000001761110540654464020734 0ustar bastianbastian#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.004; use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.64'; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE"; Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE } # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die << "END_DIE"; Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } use Cwd (); use File::Find (); use File::Path (); use FindBin; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ($self, $1); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; } sub preload { my ($self) = @_; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!"; my $in_pod = 0; while ( ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } close PKGFILE; } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } 1; libperlio-eol-perl-0.14/inc/Module/Install/0000750000175000017500000000000010540662633020364 5ustar bastianbastianlibperlio-eol-perl-0.14/inc/Module/Install/Win32.pm0000640000175000017500000000341610540654464021634 0ustar bastianbastian#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); if (!$rv) { die <<'END_MESSAGE'; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } } 1; libperlio-eol-perl-0.14/inc/Module/Install/Base.pm0000640000175000017500000000203510540654464021600 0ustar bastianbastian#line 1 package Module::Install::Base; $VERSION = '0.64'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 138 libperlio-eol-perl-0.14/inc/Module/Install/Fetch.pm0000640000175000017500000000463010540654464021762 0ustar bastianbastian#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; libperlio-eol-perl-0.14/inc/Module/Install/Makefile.pm0000640000175000017500000001337310540654464022452 0ustar bastianbastian#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join(' ', grep length, $clean->{FILES}, @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join(' ', grep length, $realclean->{FILES}, @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); $args->{VERSION} = $self->version || $self->determine_VERSION($args); $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->build_requires, $self->requires) ); # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; if ($self->admin->preop) { $args{dist} = $self->admin->preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 334 libperlio-eol-perl-0.14/inc/Module/Install/WriteAll.pm0000640000175000017500000000162410540654464022454 0ustar bastianbastian#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_ ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; if ( $0 =~ /Build.PL$/i ) { $self->Build->write; } else { $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{'PL_FILES'} ) { $self->makemaker_args( PL_FILES => {} ); } if ($args{inline}) { $self->Inline->write; } else { $self->Makefile->write; } } } 1; libperlio-eol-perl-0.14/inc/Module/Install/Can.pm0000640000175000017500000000337410540654464021436 0ustar bastianbastian#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 libperlio-eol-perl-0.14/inc/Module/Install/Metadata.pm0000640000175000017500000001747610540654464022465 0ustar bastianbastian#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.64'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests }; my @tuple_keys = qw{ build_requires requires recommends bundles }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key (@tuple_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} unless @_; my @rv; while (@_) { my $module = shift or last; my $version = shift || 0; if ( $module eq 'perl' ) { $version =~ s{^(\d+)\.(\d+)\.(\d+)} {$1 + $2/1_000 + $3/1_000_000}e; $self->perl_version($version); next; } my $rv = [ $module, $version ]; push @rv, $rv; } push @{ $self->{values}{$key} }, @rv; @rv; }; } sub sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and !@_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; return $self; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die "all_from called with no args without setting name() first"; $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; die "all_from: cannot find $file from $name" unless -e $file; } $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; # The remaining probes read from POD sections; if the file # has an accompanying .pod, use that instead my $pod = $file; if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { $file = $pod; } $self->author_from($file) unless $self->author; $self->license_from($file) unless $self->license; $self->abstract_from($file) unless $self->abstract; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides(%{ $build->find_dist_packages || {} }); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML', 0 ); require YAML; my $data = YAML::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { my ( $self, $file ) = @_; require ExtUtils::MM_Unix; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } sub _slurp { my ( $self, $file ) = @_; local *FH; open FH, "< $file" or die "Cannot open $file.pod: $!"; do { local $/; }; } sub perl_version_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ ^ use \s* v? ([\d_\.]+) \s* ; /ixms ) { my $v = $1; $v =~ s{_}{}g; $self->perl_version($1); } else { warn "Cannot determine perl version info from $file\n"; return; } } sub author_from { my ( $self, $file ) = @_; my $content = $self->_slurp($file); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $file\n"; } } sub license_from { my ( $self, $file ) = @_; if ( $self->_slurp($file) =~ m/ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b (.*?) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 'GNU public license' => 'gpl', 'GNU lesser public license' => 'gpl', 'BSD license' => 'bsd', 'Artistic license' => 'artistic', 'GPL' => 'gpl', 'LGPL' => 'lgpl', 'BSD' => 'bsd', 'Artistic' => 'artistic', ); while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { $self->license($license); return 1; } } } warn "Cannot determine license info from $file\n"; return 'unknown'; } 1; libperlio-eol-perl-0.14/Makefile.PL0000640000175000017500000000044410540654464016740 0ustar bastianbastian#!/usr/bin/perl use inc::Module::Install; name ('PerlIO-eol'); author ('Audrey Tang '); abstract ('PerlIO layer for normalizing line endings'); license ('perl'); version_from ('eol.pm'); requires (perl => '5.7.3'); WriteAll (sign => 1);