develooper Front page | perl.perl5.porters | Postings from March 2008

[perl #52216] BUG: Win32::Console WriteInput

From:
Edward Sanman
Date:
March 29, 2008 05:22
Subject:
[perl #52216] BUG: Win32::Console WriteInput
Message ID:
rt-3.6.HEAD-25460-1206746671-27.52216-75-0@perl.org
# New Ticket Created by  "Edward Sanman" 
# Please include the string:  [perl #52216]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=52216 >



This is a bug report for perl from r130005@RBSWA,
generated with the help of perlbug 1.34 running under perl v5.8.0.


-----------------------------------------------------------------.
[Please enter your report here]


The following code does not work.  It output should be same as input.

The output is:
F:\Data\CPSSPerlDeploy>perl testConsole2.pl
|:
|1|1|1|49|2|0|2256516|>
|1|0|1|49|2|0|2256516|>

F:\Data\CPSSPerlDeploy>pause
Press any key to continue . . .


use Win32::Console;

my $In = new Win32::Console(STD_INPUT_HANDLE) || die;
   $In->WriteInput(1,1,1,49,2,49,0);
   $In->WriteInput(1,0,1,49,2,49,0);
   Event();
   Event();
   Event();

exit 0;

sub Event {
    @event=$In->Input();,
    print "|";
    foreach $item (@event) {print "$item|"}
    print "\n";
}

Below is the Console.xs code.  I have pointed out 2 possible errors ( see
<== below )

Thanks,
Ed Sanman
Regence BlueShield of Idaho
208-798-2340
esanman@regence.com


The following is from CPAN
http://search/cpan.org/src/JDB/libwin32-0.28/Console/Console.xs


void
_WriteConsoleInput(handle,type,...)
    HANDLE handle
    int type
PPCODE:
    DWORD written;
    INPUT_RECORD event;
    KEY_EVENT_RECORD * kevent;,...)
    MOUSE_EVENT_RECORD * mevent;..)
    event.EventType = type;
    switch(event.EventType) {
    case KEY_EVENT:
      kevent = (KEY_EVENT_RECORD *)&(event.Event);.
        kevent->bKeyDown          = (BOOL)SvIV(ST(2));
        kevent->wRepeatCount      = (WORD)SvIV(ST(3));
        kevent->wVirtualKeyCode   = (WORD)SvIV(ST(4));
        kevent->wVirtualScanCode  = (WORD)SvIV(ST(5));
#ifdef UNICODE
        kevent->uChar.UnicodeChar = (WCHAR)SvIV(ST(6));
#else
        kevent->uChar.AsciiChar   = (CHAR)SvIV(ST(7));  <== should be ST(6)
not ST(7)
#endif
      kevent->dwControlKeyState = SvIV(ST(7));  <== Need to Add this line
      break;
    case MOUSE_EVENT:
      mevent = (MOUSE_EVENT_RECORD *)&(event.Event);
        mevent->dwMousePosition.X = (SHORT)SvIV(ST(2));
        mevent->dwMousePosition.Y = (SHORT)SvIV(ST(3));
        mevent->dwButtonState     = SvIV(ST(4));
        mevent->dwControlKeyState = SvIV(ST(5));
        mevent->dwEventFlags      = SvIV(ST(6));
      break;
    default:
      XSRETURN_NO;
      break;
    }
    if (WriteConsoleInput(handle,&event,1,&written))));
      XSRETURN_YES;
    else
      XSRETURN_NO;;





[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=library
    severity=high
---
Site configuration information for perl v5.8.0:

Configured by ActiveState at Tue Feb  4 18:07:44 2003.

Summary of my perl5 (revision 5 version 8 subversion 0) configuration:
  Platform:
    osname=MSWin32, osvers=4.0, archname=MSWin32-x86-multi-thread
    uname=''
    config_args='undef'
    hint=recommended, useposix=true, d_sigaction=undef
    usethreads=undef use5005threads=undef useithreads=define
usemultiplicity=define
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cl', ccflags ='-nologo -Gf -W3 -MD -Zi -DNDEBUG -O1 -DWIN32
-D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT  -DPERL_IMPLICIT_CONTEXT
-DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READFIX',
    optimize='-MD -Zi -DNDEBUG -O1',
    cppflags='-DWIN32'
    ccversion='', gccversion='', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64',
lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf
-libpath:"C:\Perl\lib\CORE"  -machine:x86'
    libpth="C:\Perl\lib\CORE"
    libs=  oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.lib
uuid.lib wsock32.lib mpr.lib winmm.lib  version.lib odbc32.lib odbccp32.lib
msvcrt.lib
    perllibs=  oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.lib
uuid.lib wsock32.lib mpr.lib winmm.lib  version.lib odbc32.lib odbccp32.lib
msvcrt.lib
    libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib
    gnulibc_version='undef',
  Dynamic Linking:
    dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug
-opt:ref,icf  -libpath:"C:\Perl\lib\CORE"  -machine:x86'

Locally applied patches:
    ACTIVEPERL_LOCAL_PATCHES_ENTRY

---
@INC for perl v5.8.0:
    C:/Perl/lib
    C:/Perl/site/lib:
    .:

---
Environment for perl v5.8.0:
    HOME=F:\
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset):
    LOGDIR (unset)
    PATH=C:\Program Files\CA\SharedComponents\PEC\bin;C:\Perl\bin
\;C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\System32\Wbem;C:\Program Files
\QuickTime\QTSystem\;J:\oracle\obase\ora92\bin;J:\oracle\obase\ora92\jre
\1.4.2\bin\client;J:\oracle\obase\ora92\jre\1.4.2\bin;J:\oracle\obase\ora10
\bin;J:\oracle\obase\ora10\jre\1.4.2\bin\client;J:\oracle\obase\ora10\jre
\1.4.2\bin;J:\oracle\obase\jre\1.1.8\bin;C:\Program Files\FileNET
\IDM;C:\Program Files\FileNET\FNSW\CLIENT\BIN;C:\Program Files\FileNET\FNSW
\CLIENT\SHOBJ;C:\WINDOWS\System32\crystal;C:\Program Files\CA\Cryptography
\;C:\Program Files\Attachmate\Reflection\;C:\Program Files\Rational
\common;C:\Program Files\Rational\ClearCase\bin;C:\Program Files\CA
\AllFusion Harvest Change Manager
    PERL_BADLANG (unset)
    SHELL (unset)


***IMPORTANT NOTICE: This communication, including any attachment, contains information that may be confidential or privileged, and is intended solely for the entity or individual to whom it is addressed.  If you are not the intended recipient, you should delete this message and are hereby notified that any disclosure, copying, or distribution of this message is strictly prohibited.  Nothing in this email, including any attachment, is intended to be a legally binding signature.***




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About