view release on metacpan or  search on metacpan

t/compress/generic.pl  view on Meta::CPAN

EOT

            my $lex = LexFile->new( my $name );

            my %opts = () ;
            my $iow = $CompressClass->can('new')->( $CompressClass, $name, %opts );
            is $iow->input_line_number, undef;
            $iow->print($str) ;
            is $iow->input_line_number, undef;
            $iow->close ;

            my @tmp;
            my $buf;
            {
                my $io = $UncompressClass->can('new')->( $UncompressClass, $name );

                is $., 0;
                is $io->input_line_number, 0;
                ok ! $io->eof, "eof";
                is $io->tell(), 0, "tell 0" ;
                #my @lines = <$io>;
                my @lines = $io->getlines();
                is @lines, 6
                    or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
                is $lines[1], "of a paragraph\n" ;
                is join('', @lines), $str ;
                is $., 6;
                is $io->input_line_number, 6;
                is $io->tell(), length($str) ;

                ok $io->eof;

                ok ! ( defined($io->getline)  ||
                          (@tmp = $io->getlines) ||
                          defined($io->getline)         ||
                          defined($io->getc)     ||
                          $io->read($buf, 100)   != 0) ;
            }


            {
                local $/;  # slurp mode
                my $io = $UncompressClass->new($name);
                is $., 0, "line 0";
                is $io->input_line_number, 0;
                ok ! $io->eof, "eof";
                my @lines = $io->getlines;
                is $., 1, "line 1";
                is $io->input_line_number, 1, "line number 1";
                ok $io->eof, "eof" ;
                ok @lines == 1 && $lines[0] eq $str;

                $io = $UncompressClass->new($name);
                ok ! $io->eof;
                my $line = $io->getline();
                ok $line eq $str;
                ok $io->eof;
            }

            {
                local $/ = "";  # paragraph mode
                my $io = $UncompressClass->new($name);
                is $., 0;
                is $io->input_line_number, 0;
                ok ! $io->eof;
                my @lines = $io->getlines();
                is $., 2;
                is $io->input_line_number, 2;
                ok $io->eof;
                ok @lines == 2
                    or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
                ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
                    or print "# $lines[0]\n";
                ok $lines[1] eq "and a single line.\n\n";
            }

            {
                # Record mode
                my $reclen = 7 ;
                my $expected_records = int(length($str) / $reclen)
                                        + (length($str) % $reclen ? 1 : 0);
                local $/ = \$reclen;

                my $io = $UncompressClass->new($name);
                is $., 0;
                is $io->input_line_number, 0;

                ok ! $io->eof;
                my @lines = $io->getlines();
                is $., $expected_records;
                is $io->input_line_number, $expected_records;
                ok $io->eof;
                is @lines, $expected_records,
                    "Got $expected_records records\n" ;
                ok $lines[0] eq substr($str, 0, $reclen)
                    or print "# $lines[0]\n";
                ok $lines[1] eq substr($str, $reclen, $reclen);
            }

            {
                local $/ = "is";
                my $io = $UncompressClass->new($name);
                my @lines = ();
                my $no = 0;
                my $err = 0;
                ok ! $io->eof;
                while (my $a = $io->getline()) {
                    push(@lines, $a);
                    $err++ if $. != ++$no;
                }

                ok $err == 0 ;
                ok $io->eof;

                is $., 3;
                is $io->input_line_number, 3;
                ok @lines == 3
                    or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
                ok join("-", @lines) eq
                                 "This- is- an example\n" .
                                "of a paragraph\n\n\n" .

t/compress/generic.pl  view on Meta::CPAN

        {
            # Read from non-compressed file

            my $str = <<EOT;
This is an example
of a paragraph


and a single line.

EOT
            my $lex = LexFile->new( my $name );

            writeFile($name, $str);
            my @tmp;
            my $buf;
            {
                my $io = $UncompressClass->can('new')->( $UncompressClass, $name, -Transparent => 1 );

                isa_ok $io, $UncompressClass ;
                ok ! $io->eof, "eof";
                is $io->tell(), 0, "tell == 0" ;
                my @lines = $io->getlines();
                is @lines, 6, "got 6 lines";
                ok $lines[1] eq "of a paragraph\n" ;
                ok join('', @lines) eq $str ;
                is $., 6;
                is $io->input_line_number, 6;
                ok $io->tell() == length($str) ;

                ok $io->eof;

                ok ! ( defined($io->getline)  ||
                          (@tmp = $io->getlines) ||
                          defined($io->getline)         ||
                          defined($io->getc)     ||
                          $io->read($buf, 100)   != 0) ;
            }


            {
                local $/;  # slurp mode
                my $io = $UncompressClass->new($name);
                ok ! $io->eof;
                my @lines = $io->getlines;
                is $., 1;
                is $io->input_line_number, 1;
                ok $io->eof;
                ok @lines == 1 && $lines[0] eq $str;

                $io = $UncompressClass->new($name);
                ok ! $io->eof;
                my $line = $io->getline;
                is $., 1;
                is $io->input_line_number, 1;
                is $line, $str;
                ok $io->eof;
            }

            {
                local $/ = "";  # paragraph mode
                my $io = $UncompressClass->new($name);
                ok ! $io->eof;
                my @lines = $io->getlines;
                is $., 2;
                is $io->input_line_number, 2;
                ok $io->eof;
                ok @lines == 2
                    or print "# expected 2 lines, got " . scalar(@lines) . "\n";
                ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
                    or print "# [$lines[0]]\n" ;
                ok $lines[1] eq "and a single line.\n\n";
            }

            {
                # Record mode
                my $reclen = 7 ;
                my $expected_records = int(length($str) / $reclen)
                                        + (length($str) % $reclen ? 1 : 0);
                local $/ = \$reclen;

                my $io = $UncompressClass->new($name);
                is $., 0;
                is $io->input_line_number, 0;

                ok ! $io->eof;
                my @lines = $io->getlines();
                is $., $expected_records;
                is $io->input_line_number, $expected_records;
                ok $io->eof;
                is @lines, $expected_records,
                    "Got $expected_records records\n" ;
                ok $lines[0] eq substr($str, 0, $reclen)
                    or print "# $lines[0]\n";
                ok $lines[1] eq substr($str, $reclen, $reclen);
            }

            {
                local $/ = "is";
                my $io = $UncompressClass->new($name);
                my @lines = ();
                my $no = 0;
                my $err = 0;
                ok ! $io->eof;
                while (my $a = $io->getline) {
                    push(@lines, $a);
                    $err++ if $. != ++$no;
                }

                is $., 3;
                is $io->input_line_number, 3;
                ok $err == 0 ;
                ok $io->eof;


                ok @lines == 3 ;
                ok join("-", @lines) eq
                                 "This- is- an example\n" .
                                "of a paragraph\n\n\n" .
                                "and a single line.\n\n";
            }