Acme-InputRecordSeparatorIsRegexp
17 results

 view release on metacpan or  search on metacpan

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN 

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
            carp "Argument list not closed for PerlIO layer \"$irs\"";
            return;
        }
        if ($c eq "\\") {
            $c .= substr($mode,$p1++,1);
        }
        if ($c eq "(") { $nest++ }
        if ($c eq ")") { $nest-- }
        if ($nest) { $irs .= $c; }
    }
    substr($mode,$p0,length($irs)+6, "");
    $_[0] = $mode;
    return $irs;
}
 
sub open (*;$@) {
    no strict 'refs';        # or else bareword file handles will break
    my (undef,$mode,$expr,@list) = @_;
    if (!defined $_[0]) {
        $_[0] = Symbol::gensym;
    }

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN 

179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
 
    if (@{$self->{records}} > 1) {
        $self->{buffer} = pop @{$self->{records}};
    }
    return;
}
 
sub EOF {
    my $self = shift;
    foreach my $rec (@{$self->{records}}, $self->{buffer}) {
        return if length($rec) > 0;
    }
    return eof($self->{handle});
}
 
sub _split {
    my $self = shift;
    if (!defined $self->{can_use_lookbehind}) {
        $self->_compile_rs;
    }
    my $rs = $self->{rsc};
    my @rec = split $rs, $self->{buffer};
    if ($self->{can_use_lookbehind}) {
        return @rec;
    } else {
        return grep length, @rec;
    }
}
 
sub CLOSE {
    my $self = shift;
    $self->_clear_buffer;
    my $z = close $self->{handle};
    # delete $self->{handle};
    return $z;
}

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN 

233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
 
sub FILENO {
    my $self = shift;
    return fileno($self->{handle});
}
 
sub WRITE {
    my ($self, $buf, $len, $offset) = @_;
    $offset ||= 0;
    if (!defined $len) {
        $len = length($buf)-$offset;
    }
    $self->PRINT( substr($buf,$offset,$len) );
}
 
sub PRINT {
    my ($self, @msg) = @_;
    if ($self->TELL() != tell($self->{handle})) {
        $self->SEEK(0,1);
    } else {
        $self->_clear_buffer;

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN 

260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
    $self->PRINT(sprintf($template,@args));
}
 
sub READ {
    my $self = shift;
    my $bufref = \$_[0];
    my (undef, $len, $offset) = @_;
    my $nread = 0;
 
    while ($len > 0 && @{$self->{records}}) {
        if (length($self->{records}[0])>=$len) {
            my $rec = shift @{$self->{records}};
            my $reclen = length($rec);
            substr( $$bufref, $offset, $reclen, $rec);
            $len -= $reclen;
            $offset += $reclen;
            $nread += $reclen;
        } else {
            my $rec = substr($self->{records}[0], 0, $len, "");
            substr( $$bufref, $offset, $len, $rec);
            $offset += $len;
            $nread += $len;
            $len = 0;
        }
    }
    if ($len > 0 && length($self->{buffer}) > 0) {
        my $reclen = length($self->{buffer});
        if ($reclen >= $len) {
            my $rec = substr( $self->{buffer}, 0, $len, "" );
            substr( $$bufref, $offset, $len, $rec );
            $offset += $len;
            $nread += $len;
            $len = 0;
        } else {
            substr( $$bufref, $offset, $reclen, $self->{buffer} );
            $self->{buffer} = "";
            $offset += $reclen;

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN 

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
    }
    if ($len > 0) {
        return $nread + read $self->{handle}, $$bufref, $len, $offset;
    } else {
        return $nread;
    }
}
 
sub GETC {
    my $self = shift;
    if (@{$self->{records}}==0 && 0 == length($self->{buffer})) {
        $self->_populate_buffer;
    }
 
    if (@{$self->{records}}) {
        my $c = substr( $self->{records}[0], 0, 1, "" );
        if (0 == length($self->{records}[0])) {
            shift @{$self->{records}};
        }
        return $c;
    } elsif (0 != length($self->{buffer})) {
        my $c = substr( $self->{buffer}, 0, 1, "" );
        return $c;
    } else {
        # eof?
        return undef;
    }
}
 
sub BINMODE {
    my $self = shift;

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN 

351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
    seek $self->{handle}, $pos, $whence;
 
    # more sophisticated implementation
    #     on a seek forward, remove bytes from the front
    #     of buffered data
}
 
sub TELL {
    my $self = shift;
    # virtual cursor position is actual position on the file handle
    # minus the length of any buffered data
    my $tell = tell $self->{handle};
    $tell -= length($self->{buffer});
    $tell -= length($_) for @{$self->{records}};
    return $tell;
}
 
 
no warnings 'redefine';
sub IO::Handle::input_record_separator {
    my $self = shift;
    if (ref($self) eq 'GLOB' || ref(\$self) eq 'GLOB') {
        if (tied(*$self)) {
            if (ref(tied(*$self)) eq __PACKAGE__) {

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN 

429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
    return 0+$val;
}
 
sub chomp {
    my $self = shift;
    my $removed = 0;
    my $rs = $self->{rs};
    foreach my $line (@_) {
        $line =~ s/($rs)$//;
        if (defined($1)) {
            $removed += length($1);
        }
    }
    return $removed;
}
 
1; # 
 
__END__
 
=head1 NAME

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN 

662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
L<"open"> function, for example:
 
    my $th = Acme::InputRecordSeparatorIsRegexp->open( $regex, '<', $filename,
                        { bufsize => 65336 } );
 
=head2 bufsize
 
The amount of data, in bytes, to read from the input stream at
a time. For performance reasons, this should be at least a few kilobytes.
B<For the module to work correctly, it should also be much larger
than the length of any sequence of characters that could be construed
as a line ending.>
 
=head1 ALIAS
 
The package C<Acme::IRSRegexp> is an alias for
C<Acme::InputRecordSeparatorIsRegexp>, allowing you to write
 
    use Acme::InputRecordSeparatorIsRegexp;
    tie *$fh, 'Acme::IRSRegexp',

lib/Acme/InputRecordSeparatorIsRegexp.pm  view on Meta::CPAN 

803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
 
test plan:
 
    read methods
    ------------
    READLINE
        scalar context
        list context
    READ
        with and without offset
        length < = > buffer allocated
        before and after populate buffer (i.e., after scalar READLINE)
    GETC
        with and without populated buffer (after SCALAR READLINE)
        at eof
    EOF
        with buffer populated
 
    SEEK & TELL
        move around, keep reading

t/02-readline.t  view on Meta::CPAN 

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
ok($z, 'open ok');
ok($t->{handle} && $t->{handle} ne *$fh, 'handle internals set after open');
ok(fileno($fh), '$fh has fileno');
my %le;
my $last;
while (<$fh>) {
    $zz .= $_;
    if ($last) {
        ok($last =~ /123$/ || $last =~ /V45$/ || $last =~ /X67$/,
           'correct line ending')
        or diag length($last), $last;
    }
    $le{ substr($_, -3) }++;
    $last = $_;
}
ok($yy eq $zz, 'output equals expected input');
my $x = <$fh>;
ok(!defined($x), 'no read on exhausted filehandle');
$z = close $fh;
ok($z, 'CLOSE ok');
$x = <$fh>;

t/03-seektell.t  view on Meta::CPAN 

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] =~ /1.3$/ || $seek[-2] =~ /T.4$/ || 
            $seek[-2] =~ /E....D$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
    }
}
 
# don't close
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;
    seek($fh, $t, 0);

t/03b-seektell.t  view on Meta::CPAN 

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] =~ /1.3$/ || $seek[-2] =~ /T.4$/ || 
            $seek[-2] =~ /E....D$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
    }
}
 
# don't close
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;
    seek($fh, $t, 0);

t/04-longline.t  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use Test::More;
use Acme::InputRecordSeparatorIsRegexp 'open';
use strict;
use warnings;
 
# handle the case where the length of a record is much larger
# than the size of the read buffer
 
my $yy = "";
for (1..20) {
    $yy .= "x" x 9999;
    if (rand() < 0.333333) {
        $yy .= "\n";
    } elsif (rand() < 0.5) {
        $yy .= "\r";
    } else {

t/04-longline.t  view on Meta::CPAN 

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] =~ /[\r\n]$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
    }
}
 
# don't close
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;
    seek($fh, $t, 0);

t/04b-longline.t  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use Test::More;
use Acme::InputRecordSeparatorIsRegexp 'binmode';
use strict;
use warnings;
 
# handle the case where the length of a record is much larger
# than the size of the read buffer
 
if ($] < 5.010000) {
    diag "readline on this package is sloooow for Perl $]. ",
        "Skipping this set of tests which is a near duplicate of ",
        "another set of tests.";
    ok(1, "# skip $0 tests on Perl $]");
    done_testing();
    exit;
}

t/04b-longline.t  view on Meta::CPAN 

40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] =~ /[\r\n]$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
    }
}
 
# don't close
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;
    seek($fh, $t, 0);

t/05-readwrite.t  view on Meta::CPAN 

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
}
ok(tell($fh) == 4 * 300, "tell correct after print statements");
$z = seek $fh, 100, 0;
ok($z, 'seek said it was successful');
ok(tell($fh) == 100, 'tell/seek consistent');
my $c = getc($fh);
ok($c eq 'y', 'found "y" as expected at 100 position');
ok(tell($fh) == 101, "tell=101 after read 1 char");
my $x = <$fh>;
ok(defined($x), "readline ok");
ok(length($x) == 99, "read line has correct length");
ok($x =~ /y\n$/, "read line has expected line ending");
ok(tell($fh) == 200, 'got tell after readline');
 
my $newmsg = "A new message at pos 200\n";
$z = print $fh $newmsg;
ok($z, 'print ok');
$x = <$fh>;
ok(defined($x), 'readline after print ok');
ok(length($x) == 100 - length($newmsg), 'expected line length')
    or diag length($x)," ",$x;
ok($x =~ /z\r\n/, 'expected line ending');
 
$z = seek($fh,0,0);
ok($z, 'seek 0,0 ok');
ok(tell($fh) == 0, 'seek 0 0 worked');
$x = <$fh>;
ok($x =~ /xxxx\r$/, 'read line correctly');
ok(tell($fh) == 100, 'tell correct after 1 readline');
$x = <$fh>;
ok($x =~ /yyyyy\n$/, 'read line 2');
ok(tell($fh) == 200, 'tell after 2 readline');
$x = <$fh>;
ok($x eq $newmsg, 'read line 3: new message');
ok(tell($fh) == 200 + length($newmsg), 'tell after 3 newline');
$x = <$fh>;
ok($x =~ /zzz\r\n$/, 'readline 4');
ok(tell($fh) == 300, 'tell after 4 readline');
ok(close $fh, 'close ok');
ok(unlink "t/test05.txt", 'remove test file');
 
done_testing();

t/06-DATA.t  view on Meta::CPAN 

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
my (@tell, @seek);
 
push @tell, tell(DAT);
while (<DAT>) {
    push @seek, $_;
    push @tell, tell(DAT);
    if (@seek > 1) {
        ok( $seek[-2] =~ /1.43$/ || $seek[-2] =~ /T.44$/ || 
            $seek[-2] =~ /E....XD$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
    }
}
 
# don't close
 
while (@seek) {
    my ($s,$t);
    my $i = int(rand(@seek));
    $t = splice @tell, $i, 1;
    $s = splice @seek, $i, 1;

t/06b-DATA.t  view on Meta::CPAN 

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
my (@tell, @seek);
 
push @tell, tell(DATA);
while (<DATA>) {
    push @seek, $_;
    push @tell, tell(DATA);
    if (@seek > 1) {
        ok( $seek[-2] =~ /1.43$/ || $seek[-2] =~ /T.44$/ || 
            $seek[-2] =~ /E....XD$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
    }
}
 
# don't close
 
while (@seek) {
    my ($s,$t);
    my $i = int(rand(@seek));
    $t = splice @tell, $i, 1;
    $s = splice @seek, $i, 1;

t/07-memory.t  view on Meta::CPAN 

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] =~ /1.3$/ || $seek[-2] =~ /T.4$/ || 
            $seek[-2] =~ /E....D$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
    }
}
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;
    seek($fh, $t, 0);
    my $u = readline($fh);

t/07b-memory.t  view on Meta::CPAN 

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] =~ /1.3$/ || $seek[-2] =~ /T.4$/ || 
            $seek[-2] =~ /E....D$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
    }
}
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;
    seek($fh, $t, 0);
    my $u = readline($fh);

t/08-chomp.t  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use Test::More;
use Acme::InputRecordSeparatorIsRegexp 'open';
use strict;
use warnings;
 
# handle the case where the length of a record is much larger
# than the size of the read buffer
 
my $yy = "";
for (1..20) {
    $yy .= "x" x 9999;
    if (rand() < 0.333333) {
        $yy .= "\n";
    } elsif (rand() < 0.5) {
        $yy .= "\r";
    } else {

t/08-chomp.t  view on Meta::CPAN 

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] =~ /[\r\n]$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
 
        my $x = $seek[-2];
        my $u = tied(*$fh)->chomp($x);
 
        ok($u==1 || $u==2, 'chomp line');
        ok($x !~ /[\r\n]$/, 'line ending was chomped')
            or diag "\$u on failed chomp was $u\n";
        ok(length($x) == 9999, 'length after chomp');
    }
}
 
# don't close
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;
    seek($fh, $t, 0);

t/08b-chomp.t  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use Test::More;
use Acme::InputRecordSeparatorIsRegexp 'binmode';
use strict;
use warnings;
 
# handle the case where the length of a record is much larger
# than the size of the read buffer
 
my $yy = "";
for (1..20) {
    $yy .= "x" x 9999;
    if (rand() < 0.333333) {
        $yy .= "\n";
    } elsif (rand() < 0.5) {
        $yy .= "\r";
    } else {

t/08b-chomp.t  view on Meta::CPAN 

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
 
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] =~ /[\r\n]$/, 'correct line ending' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
 
        my $x = $seek[-2];
        my $u = tied(*$fh)->chomp($x);
 
        ok($u==1 || $u==2, 'chomp line');
        ok($x !~ /[\r\n]$/, 'line ending was chomped')
            or diag "\$u on failed chomp was $u\n";
        ok(length($x) == 9999, 'length after chomp');
    }
}
 
# don't close
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;
    seek($fh, $t, 0);

t/09-autochomp.t  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use Test::More;
use Acme::InputRecordSeparatorIsRegexp 'open','autochomp';
use strict;
use warnings;
 
# handle the case where the length of a record is much larger
# than the size of the read buffer
 
my $yy = "";
for (1..20) {
    $yy .= "x" x 9999;
    if (rand() < 0.333333) {
        $yy .= "\n";
    } elsif (rand() < 0.5) {
        $yy .= "\r";
    } else {

t/09-autochomp.t  view on Meta::CPAN 

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] !~ /[\r\n]$/, 'line ending was chomped' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
        ok( length($seek[-2]) == 9999, 'autochomped line length' );
 
        my $x = $seek[-2];
        my $u = tied(*$fh)->chomp($x);
        ok($u==0, 'chomp return value for already chomped');
        ok($x eq $seek[-2], 'already chomped line not changed');
    }
}
 
# don't close

t/09b-autochomp.t  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
use Test::More;
use Acme::InputRecordSeparatorIsRegexp 'binmode','autochomp';
use strict;
use warnings;
 
# handle the case where the length of a record is much larger
# than the size of the read buffer
 
my $yy = "";
for (1..20) {
    $yy .= "x" x 9999;
    if (rand() < 0.333333) {
        $yy .= "\n";
    } elsif (rand() < 0.5) {
        $yy .= "\r";
    } else {

t/09b-autochomp.t  view on Meta::CPAN 

64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
 
my (@tell, @seek);
 
push @tell, tell($fh);
while (<$fh>) {
    push @seek, $_;
    push @tell, tell($fh);
    if (@seek > 1) {
        ok( $seek[-2] !~ /[\r\n]$/, 'line ending was chomped' )
            or diag $seek[-2], "\n\n", $seek[-1],
            "\n\n", length($seek[-2]),"\t",length($seek[-1]);
        ok( length($seek[-2]) == 9999, 'autochomped line length' );
 
        my $x = $seek[-2];
        my $u = tied(*$fh)->chomp($x);
        ok($u==0, 'chomp return value for already chomped');
        ok($x eq $seek[-2], 'already chomped line not changed');
    }
}
 
# don't close

t/10-input-record-separator.t  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
use Test::More;
use Acme::InputRecordSeparatorIsRegexp ':all';
use strict;
use warnings;
 
# handle the case where the length of a record is much larger
# than the size of the read buffer
 
my $yy = "";
my $xx = "AAA";
my $ii = 0;
while (length($xx) < 4) {
    for (1..500) {
        $yy .= $ii++ . ":" . $xx++
    }
    if (rand() < 0.333333) {
        $yy .= "\n";
    } elsif (rand() < 0.5) {
        $yy .= "\r";
    } else {
        $yy .= "\r\n";
    }

t/10-input-record-separator.t  view on Meta::CPAN 

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
my $correct = 0;
my $incorrect = 0;
while (<$f4>) {
    push @seek, $_;
    push @tell, tell($f4);
    if (@seek > 1) {
        if ($seek[-2] =~ /[\r\n]$/) {
            $correct++;
        } else {
            diag $seek[-2], "\n\n", $seek[-1],
                "\n\n", length($seek[-2]),"\t",length($seek[-1]);
            $incorrect++;
        }
    }
}
ok($correct > 0 && $incorrect == 0, 'all line endings correct');
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;

t/10b-input-record-separator.t  view on Meta::CPAN 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
use Test::More;
use Acme::InputRecordSeparatorIsRegexp ':all';
use strict;
use warnings;
 
# handle the case where the length of a record is much larger
# than the size of the read buffer
 
my $yy = "";
my $xx = "AAA";
my $ii = 0;
while (length($xx) < 4) {
    for (1..500) {
        $yy .= $ii++ . ":" . $xx++
    }
    if (rand() < 0.333333) {
        $yy .= "\n";
    } elsif (rand() < 0.5) {
        $yy .= "\r";
    } else {
        $yy .= "\r\n";
    }

t/10b-input-record-separator.t  view on Meta::CPAN 

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
my $correct = 0;
my $incorrect = 0;
while (<$f4>) {
    push @seek, $_;
    push @tell, tell($f4);
    if (@seek > 1) {
        if ($seek[-2] =~ /[\r\n]$/) {
            $correct++;
        } else {
            diag $seek[-2], "\n\n", $seek[-1],
                "\n\n", length($seek[-2]),"\t",length($seek[-1]);
            $incorrect++;
        }
    }
}
ok($correct > 0 && $incorrect == 0, 'all line endings correct');
 
while (@seek) {
    my $i = int(rand(@seek));
    my $t = splice @tell, $i, 1;
    my $s = splice @seek, $i, 1;



( run in 1.058 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )