package Platform;

# no warnings qw( uninitialized );

print "loading BS_win32\n" if( $BigSister::common::dl );

require Exporter;

@ISA = qw( Exporter );

@EXPORT = qw( bsconnect bsalarm FIONBIO );

$FIONBIO = 0x8004667E;

use Socket;
use Win32::Process;
use Win32::Registry;
use Win32::File;

$Platform::has_fork = 0;

sub bsalarm {
    my( $time ) = @_;

    ($time=0) if( $time<0 );
    $Platform::timeout = $time;
    print "alarm($time)\n" if( $BigSister::common::dl>6 );
}


sub bsconnect {
    my( $socket, $addr ) = @_;
    my( $rin, $win, $ein, $n, $i );
    my( $rout, $wout, $eout, $timeout );
    
    print "bsconnect()\n" if( $BigSister::common::dl>6 );
    unless( Win32::IsWinNT() ) {
	#
	# FIONBIO currently does not work correctly on NT
	#   - solution in next release? (fix documented by Micro$oft)
	ioctl( $socket, $FIONBIO, pack("L",1) );
    }
    connect( $socket, $addr ) ;
    $i=1;
    while(1) {
	$rin = "";
	vec( $rin, fileno($socket), 1 ) = 1;
	$ein=$win=$rin;
	$timeout = ($Platform::timeout)?($Platform::timeout):20;
	($n,$timeout) = select( $rout=$rin, $wout=$win, $eout=$ein, $timeout );
	if( $n<0 && $i-- ) {
	    select( undef, undef, undef, 0.5 );
	}
	else {
	    last;
	}
    }
    print "select: n: $n, rout=".(vec($rout,fileno($socket),1)).", wout=".(vec($wout,fileno($socket),1)).", eout=".(vec($eout,fileno($socket),1)).", timeout: $timeout\n" if( $BigSister::common::dl>4 );
    return( (! vec($eout,fileno($socket),1)) && ($n>0) );
}


sub socknonblock {
    my( $socket ) = @_;

    ioctl( $socket, $FIONBIO, pack("L",1) );
    return 1;
}


sub bswait {
    return 0;
}


sub strftime {
    my( $a );
    return ( $a = gmtime( $_[1] ) );
}


sub perlpath {
    my( $prog, $ext ) = @_;

    $ext = "exe" unless( $ext );
    ($prog = "perl") unless( $prog );
    $prog =~ s/\.$ext$//;
    my $path = $ENV{"PATH"};
    my ( $dir, $perlpath );
    foreach $dir (split( ";", $path )) {
	if( -f "$dir\\$prog.$ext" ) {
	    $perlpath = "$dir\\$prog.$ext";
	    last;
	}
	elsif( -f "$dir\\$prog" ) {
	    $perlpath = "$dir\\$prog";
	    last;
	}
    }
    return $perlpath;
}


sub hostname {
    my $hostname;
    eval {
	require Sys::Hostname;
	$hostname = Sys::Hostname::hostname();
    };
    $hostname || ($hostname = $ENV{"COMPUTERNAME"});
    $hostname =~ tr/A-Z/a-z/;
    $hostname =~ s/\..*//;
    return( $hostname );
}


sub background_process {
    my( $path, $cmdline ) = @_;
    my( $generator );

    print "starting in background: $path: $cmdline\n" if( $BigSister::common::dl>1 );
    unless( $path =~ /(\\|\/)/ ) {
	$path = perlpath( $path );
    }
    if( $cmdline =~ /^perl ([^\s]+)/ ) {
	my $cmd = $1;
	if( -f "$cmd.exe" ) {
	    $cmdline = $cmd.$';
	    $path = "$cmd.exe";
	    unless( $path =~ /^[\/\\]/ ) {
		$path = "C:".$BigSister::common::root."/".$path;
	    }
	    $path =~ s/\//\\/g;
	}
	print "really starting in background: $path: $cmdline\n" if( $BigSister::common::dl>1 );
    }
    else {
	open( _PROG, "<$path" );
	$_ = <_PROG>;
	close _PROG;
	if( /^#!.*perl/ ) {
	    $cmdline =~ s/^[^\s\t]+//;
	    $cmdline = "perl $path $cmdline";
	    $path = perlpath();
	}
    }
    BigSister::common::log( "info", "running: $path; $cmdline" );
    Win32::Process::Create($generator,
	$path,
	$cmdline,
	0,
	&CREATE_NO_WINDOW,
	".");
    return $generator;
}



sub override_root {
    my $key;
    return unless( $main::HKEY_LOCAL_MACHINE->Open( "Software\\GraeffComm\\BigSis", $key ) );
    my %vals;
    $key->GetValues( \%vals );
    my $root = $vals{"RootDir"};
    return unless( $root );
    $root = $root->[2];
    if( $root =~ /^([a-z]:)/i ) {
	chdir( $1 );
	$root = $';
	$root =~ tr/\\/\//;
    }
    if( ($BigSister::common::dl>1) && $root ) {
	print "RootDir is $root\n";
    }
    return( $root );
}


sub bswait_nohang {
    return -1;
}


sub replace {
    my( $file, $newfile ) = @_;
    my( $i );

    rename( $file, $newfile ) && return(1);
    for( $i=0; $i<10; $i++ ) {
	select(undef,undef,undef,0.4);
	# Black magic: change attributes makes IIS releasing files?!
	my $attr;
	Win32::File::GetAttributes( $newfile, $attr );
	$attr = $attr ^ 1;
	Win32::File::SetAttributes( $newfile, $attr );
	unlink( $newfile );
	rename( $file, $newfile ) && return(1);
    }
    return 0;
}


sub system {
    my( @args ) = @_;

    my $prog = $args[0];
    if( -f $prog ) {
	# this is a really dirty hack - but hopefully solves some problems
	open( _PROG, "<$prog" );
	$_ = <_PROG>;
	close _PROG;
	if( /^#!.*perl/ ) {
	    unshift( @args, "perl" );
	}
    }
    for( my $i = 1; $i <= $#args; $i++ ) {
	$args[$i] =~ s/\"/\'/g;
	if( $args[$i] =~ /^\// ) {
	    $args[$i] =~ s/\//\\/g;
	}
	$args[$i] = '"'.($args[$i]).'"';
    }
    return( system( @args ) );
}



sub filepath {
    my( $name ) = @_;

    $name =~ s#/#\\#g;
    return $name;
}


sub mergepath {
    my( $add, $atend ) = @_;

    foreach my $dir (split( ":", $add )) {
	if( $atend ) {
	    $ENV{"PATH"} .= ";".filepath($dir);
	} else {
	    $ENV{"PATH"} = filepath($dir).";".$ENV{"PATH"};
	}
    }
}


1;

