readkey.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

{
    my ($file) = normalizehandle( ( @_ > 1 ? $_[1] : \*STDOUT ) );
    my (@results) = ();
    my (@fail);

    if ( &termsizeoptions() & 1 )                       # VIO
    {
        @results = GetTermSizeVIO($file);
        push( @fail, "VIOGetMode call" );
    }
    elsif ( &termsizeoptions() & 2 )                    # GWINSZ
    {
        @results = GetTermSizeGWINSZ($file);
        push( @fail, "TIOCGWINSZ ioctl" );
    }
    elsif ( &termsizeoptions() & 4 )                    # GSIZE
    {
        @results = GetTermSizeGSIZE($file);
        push( @fail, "TIOCGSIZE ioctl" );
    }
    elsif ( &termsizeoptions() & 8 )                    # WIN32
    {
        @results = GetTermSizeWin32($file);
        push( @fail, "Win32 GetConsoleScreenBufferInfo call" );
    }
    else
    {
        @results = ();
    }

    if ( @results < 4 and $UseEnv )
    {
        my ($C) = defined( $ENV{COLUMNS} ) ? $ENV{COLUMNS} : 0;
        my ($L) = defined( $ENV{LINES} )   ? $ENV{LINES}   : 0;
        if ( ( $C >= 2 ) and ( $L >= 2 ) )
        {
            @results = ( $C + 0, $L + 0, 0, 0 );
        }
        push( @fail, "COLUMNS and LINES environment variables" );
    }

    if ( @results < 4 )
    {
        my ($prog) = "resize";

        # Workaround for Solaris path sillyness
        if ( -f "/usr/openwin/bin/resize" ) {
            $prog = "/usr/openwin/bin/resize";
        }

        my ($resize) = scalar(`$prog 2>/dev/null`);
        if (
            defined $resize
            and (  $resize =~ /COLUMNS\s*=\s*(\d+)/
                or $resize =~ /setenv\s+COLUMNS\s+'?(\d+)/ )
          )
        {
            $results[0] = $1;
            if (   $resize =~ /LINES\s*=\s*(\d+)/
                or $resize =~ /setenv\s+LINES\s+'?(\d+)/ )
            {
                $results[1] = $1;
                @results[ 2, 3 ] = ( 0, 0 );
            }
            else
            {
                @results = ();
            }
        }
        else
        {
            @results = ();
        }
        push( @fail, "resize program" );
    }

    if ( @results < 4 )
    {
        die "Unable to get Terminal Size."
          . join( "", map( " The $_ didn't work.", @fail ) );
    }

    @results;
}

if ( &blockoptions() & 1 )    # Use nodelay
{
    if ( &blockoptions() & 2 )    #poll
    {
        eval <<'DONE';
		sub ReadKey {
		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
                  if (defined $_[0] && $_[0] > 0) {
                    if ($_[0]) {
                      return undef if &pollfile($File,$_[0]) == 0;
                    }
		  }
                  if (defined $_[0] && $_[0] < 0) {
                     &setnodelay($File,1);
                  }
                  my ($value) = getc $File;
                  if (defined $_[0] && $_[0] < 0) {
                     &setnodelay($File,0);
                  }
                  $value;
		}
		sub ReadLine {
		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));

                  if (defined $_[0] && $_[0] > 0) {
                     if ($_[0]) {
                       return undef if &pollfile($File,$_[0]) == 0;
                     }
		  }
                  if (defined $_[0] && $_[0] < 0) {
                     &setnodelay($File,1)
                  };
                  my ($value) = scalar(<$File>);
                  if ( defined $_[0] && $_[0]<0 ) {
                    &setnodelay($File,0)
                  };
                  $value;
		}
DONE
    }
    elsif ( &blockoptions() & 4 )    #select
    {
        eval <<'DONE';
		sub ReadKey {
		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
                  if(defined $_[0] && $_[0]>0) {
				if($_[0]) {return undef if &selectfile($File,$_[0])==0}
		    }
			if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
			my($value) = getc $File;
			if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
			$value;
		}
		sub ReadLine {
		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		    if(defined $_[0] && $_[0]>0) {
				if($_[0]) {return undef if &selectfile($File,$_[0])==0}
		    }
			if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
			my($value)=scalar(<$File>);
			if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
			$value;
		}
DONE
    }
    else
    {    #nothing
        eval <<'DONE';
		sub ReadKey {
		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		    if(defined $_[0] && $_[0]>0) {
		    	# Nothing better seems to exist, so I just use time-of-day
		    	# to timeout the read. This isn't very exact, though.
		    	$starttime=time;
		    	$endtime=$starttime+$_[0];
				&setnodelay($File,1);
				my($value)=undef;
		    	while(time<$endtime) { # This won't catch wraparound!
		    		$value = getc $File;
		    		last if defined($value);
		    	}
				&setnodelay($File,0);
				return $value;
		    }
			if(defined $_[0] && $_[0]<0) {&setnodelay($File,1);}
			my($value) = getc $File;
			if(defined $_[0] && $_[0]<0) {&setnodelay($File,0);}
			$value;
		}
		sub ReadLine {
		  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		    if(defined $_[0] && $_[0]>0) {
		    	# Nothing better seems to exist, so I just use time-of-day
		    	# to timeout the read. This isn't very exact, though.
		    	$starttime=time;
		    	$endtime=$starttime+$_[0];
				&setnodelay($File,1);
				my($value)=undef;
		    	while(time<$endtime) { # This won't catch wraparound!
		    		$value = scalar(<$File>);
		    		last if defined($value);
		    	}
				&setnodelay($File,0);
				return $value;
		    }
			if(defined $_[0] && $_[0]<0) {&setnodelay($File,1)};
			my($value)=scalar(<$File>);
			if(defined $_[0] && $_[0]<0) {&setnodelay($File,0)};
			$value;
		}
DONE
    }
}
elsif ( &blockoptions() & 2 )    # Use poll
{
    eval <<'DONE';
	sub ReadKey {
	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		if(defined $_[0] && $_[0] != 0) {
                     return undef if &pollfile($File,$_[0]) == 0
                }
		getc $File;
	}
	sub ReadLine {
	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		if(defined $_[0] && $_[0]!=0) {
                     return undef if &pollfile($File,$_[0]) == 0;
                }
		scalar(<$File>);
	}
DONE
}
elsif ( &blockoptions() & 4 )    # Use select
{
    eval <<'DONE';
	sub ReadKey {
	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		if(defined $_[0] && $_[0] !=0 ) {
                     return undef if &selectfile($File,$_[0])==0
                }
		getc $File;
	}
	sub ReadLine {
	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		if(defined $_[0] && $_[0] != 0) {
                     return undef if &selectfile($File,$_[0]) == 0;
                }
		scalar(<$File>);
	}
DONE
}
elsif ( &blockoptions() & 8 )    # Use Win32
{
    eval <<'DONE';
	sub ReadKey {
	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		if ($_[0]) {
			Win32PeekChar($File, $_[0]);
		} else {
			getc $File;
		}
		#if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
		#getc $File;
	}
	sub ReadLine {
	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		#if ($_[0]!=0) {return undef if !Win32PeekChar($File, $_[0])};
		#scalar(<$File>);
		if($_[0]) 
			{croak("Non-blocking ReadLine is not supported on this architecture")}
		scalar(<$File>);
	}
DONE
}
else
{
    eval <<'DONE';
	sub ReadKey {
	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		if($_[0]) 
			{croak("Non-blocking ReadKey is not supported on this architecture")}
		getc $File;
	}
	sub ReadLine {
	  my($File) = normalizehandle((@_>1?$_[1]:\*STDIN));
		if($_[0]) 
			{croak("Non-blocking ReadLine is not supported on this architecture")}
		scalar(<$File>);
	}
DONE
}

package Term::ReadKey;    # return to package ReadKey so AutoSplit is happy
1;

__END__;