#!/usr/bin/perl
# $Id: deparse_cmp.t,v 1.1 2004/01/08 01:41:42 nothingmuch Exp $

use strict;
use warnings;

use Test::More;
use Fcntl qw(SEEK_SET);
eval { require IPC::Open3 } or skip_all("Need pipes for B::Deparse. I don't know of another way yet.");
use B::Deparse;
use IO::Select;

if ($ENV{TEST_MANY_MODULES}){
    # lots of dependancies # thanks to the wonderful perl monks
    eval { require CPAN };
    eval { require CPANPLUS };
    eval { require LWP::Simple };
    eval { require Crypt::OpenPGP };
    eval { require WWW::Mechanize::Shell };
    eval { require Class::DBI };
    eval { require Net::LDAP };
    eval { require Net::SSH::Perl };
    eval { require Petal }; 
    
    # quite big
    eval { require CGI };
    eval { require Mail::SpamAssassin };
    eval { require Mail::Box };
    eval { require Mail::Box::Manager };
    
    # lots of pod
    eval { require diagnostics };
    
    # core modules are likely to be there
    eval { require Scalar::Util };
    eval { require File::Temp };
    eval { require IO::Handle };
    eval { require Memoize };
    eval { require Test };
    eval { require Test::Simple };
}

eval { require Pod::Stripper }; # interesting as a test suite.
my $diff = eval { require Text::Diff }; # more to test, and nicer output with large string comparisons

use Pod::Wrap;

$|=1;

$SIG{CHLD} = 'IGNORE'; #sub { wait until wait + 1 }; # damn lazy. Looks good with keyword highlighting.
$SIG{PIPE} = 'IGNORE'; # __END__s will cause perl to stop reading.

my @modules = values %INC;
plan tests => @modules + 1;

ok(Pod::Wrap->new(), "Create wrapper obj");

$Text::Wrap::columns = 90; # Opcode && Net::LDAP::Constant have __DATA__ section. It shouldn't be wrapped because B::Deparse keeps it (as it should).

foreach $_ (@modules){
    testFile($_); # test a filename
};

exit;

sub testFile {
    my $file = shift;
    
    my ($wrapped, $orig);
    
    
    SKIP:{
        eval {
            my $f = '';
            open FH, "+>", \$f;
            open IN, "<", $file;
            Pod::Wrap->new->parse_from_filehandle(\*IN,\*FH);
            close IN;
            seek FH, 0, SEEK_SET;
            $wrapped = deparse(\*FH);
            close FH;
            
            
            open IN, "<", $file;
            $f = '';
            1 while(sysread IN, $f, 4096, length($f));
            open FH, "<", \$f;
            $orig = deparse(\*FH);
            close FH;
        };
        
        if ($@){
            my $msg = $@;
            $msg =~ s/\n//s;
            skip ("Couldn't deparse ($@)",1);
        }
        
        local $TODO = "Decide if we want to do this one." if $file =~ /Stripper\.pm$/;
        
        if ($diff){ # if we have Text::Diff we make a nicer output on error
            if ($wrapped eq $orig){
                pass($file);
            } else {
                fail($file);
                my $diff = Text::Diff::diff(\$wrapped, \$orig);#, { STYLE => "Table" });
                foreach my $line (split($/, $diff)){
                    diag($line);
                }
            }
        } else { is ($wrapped, $orig, $file) }
    }
}

sub deparse {
    my $fh = shift;
    
    local $ENV{PERL_HASH_SEED} = 0; # GRRR!!!! otherwise deparse output will not be consistent
    IPC::Open3::open3(\*WRITE, \*READ, \*ERR, "perl", "-MO=Deparse") or die $!; # should be fatal (if it fails, or just because it's plain wrong).
    
    # out various handles
    my $w = IO::Select->new(\*WRITE);
    my $r = IO::Select->new(\*READ, \*ERR);
    
    my $output = '';
    my $buf = '';
    
    # write, reading if needed
    WRITE: while(my @h = map { @$_ } IO::Select->select($r,$w)){
        foreach my $h (@h){
            if ($h == \*READ){
                sysread READ, $output, 512, length($output);
            } elsif ($h == \*ERR){
                sysread ERR, $buf, 512;
            } elsif ($h == \*WRITE and not $w->has_exception(0)){
                if (read $fh, $buf, 512){
                    syswrite WRITE, $buf;
                } else {
                    close WRITE;
                    last WRITE;
                }
            }
        }
    }
    
    # just read
    READ: { while(my @h = map { @$_ } IO::Select->select($r, undef, undef, 10)){ foreach my $h (@h){
        if ($h == \*READ){
            sysread READ, $output, 512, length($output) or last READ;
        } elsif ($h == \*ERR) {
            sysread ERR, $buf, 512;
        } else {
            die "WTF?!\n";
        }
    }} die "$!" };
    
    close READ;
    close ERR;
    
    return $output;
}