in reply to Saving a Perl session to a file

Update: Caution: This is only tested under Windows 7!

Play around with Win32::Console. This script
Script: cap_con_1.pl 

use warnings;
use strict;

use Win32::Console 'STD_OUTPUT_HANDLE';
use Data::Dump qw(dd);

my $con_current = Win32::Console->new(STD_OUTPUT_HANDLE);
$con_current or die 'new Win32::Console failed';

my ($left, $top, $right, $bottom) = $con_current->Window;
print qq($left, $top, $right, $bottom \n);

my $rect = $con_current->ReadRect($left, $top, $right, $bottom);
$rect or die 'read Win32::Console failed';

$rect =~ s{ \0\a\0  } ''xmsg;
$rect =~ s{ [ ]+ \z } ''xmsg;

dd $rect;
print qq{======\n$rect\n======\n};

[download]
Captures: 
c:\@Work\Perl\monks\gpmathis>perl -wMstrict -le
"print qq{\nHow old are you?: };
 my $age = <STDIN>;
 my $year = 2017 - $age;
 print qq{You were born in $year\n};
"

How old are you?:
42
You were born in 1975


c:\@Work\Perl\monks\gpmathis>perl cap_con_1.pl
0, 0, 99, 59
"
 c:\\\@Work\\Perl\\monks\\gpmathis>perl -wMstrict -le
      \"print qq{\\nHow old are you?: };
         my \$age = <STDIN>;
          my \$year = 2017 - \$age;
            print qq{You were born in \$year\\n};
             \"

              How old are you?:
              42
              You were born in 1975


              c:\\\@Work\\Perl\\monks\\gpmathis>perl cap_con_1.pl
                   0, 0, 99, 59"
======

c:\@Work\Perl\monks\gpmathis>perl -wMstrict -le
"print qq{\nHow old are you?: };
 my $age = <STDIN>;
 my $year = 2017 - $age;
 print qq{You were born in $year\n};
"

How old are you?:
42
You were born in 1975


c:\@Work\Perl\monks\gpmathis>perl cap_con_1.pl
0, 0, 99, 59
======

c:\@Work\Perl\monks\gpmathis>

[download]

Update: Use cls to begin a "session". You should be able to futz around with the captured  $rect string to clip off the invocation of the script at the end. Also, the Perl script can be converted into a  .bat file with the venerable Windows Batch Wrapper trick:
File: capsess.bat 

@REM = 'windows batch wrapper
@ECHO off
perl %0.bat
goto BYEBYE
' if 0;

use warnings;
use strict;

use Win32::Console 'STD_OUTPUT_HANDLE';

my $con_current = Win32::Console->new(STD_OUTPUT_HANDLE);
$con_current or die 'new Win32::Console failed';

my ($left, $top, $right, $bottom) = $con_current->Window;
my $width = $right - $left + 1;

my $rect = $con_current->ReadRect($left, $top, $right, $bottom);
$rect or die 'read Win32::Console failed';

$rect =~ s{ \0\a\0       } ''xmsg;
$rect =~ s{ [ ]+ \z      } ''xms;
$rect =~ s{ .{$width} \z } ''xms;

print qq{======\n$rect\n======\n};

__END__

:BYEBYE

[download]
Session: 

c:\@Work\Perl\monks\gpmathis>---
c:\@Work\Perl\monks\gpmathis>perl -wMstrict -le
"print qq{\nHow old are you?: };
 my $age = <STDIN>;
 my $year = 2017 - $age;
 print qq{You were born in $year\n};
"

How old are you?:
42
You were born in 1975


c:\@Work\Perl\monks\gpmathis>capsess
======

c:\@Work\Perl\monks\gpmathis>---
c:\@Work\Perl\monks\gpmathis>perl -wMstrict -le
"print qq{\nHow old are you?: };
 my $age = <STDIN>;
 my $year = 2017 - $age;
 print qq{You were born in $year\n};
"

How old are you?:
42
You were born in 1975


======

c:\@Work\Perl\monks\gpmathis>

[download]
Caution: This is only tested under Windows 7!

Give a man a fish:  <%-{-{-{-<

Replies are listed 'Best First'.
Re^2: Saving a Perl session to a file
by Discipulus (Canon) on Apr 14, 2017 at 08:18 UTC
    very nice indeed.. but i've a problem with this: if i understand the captured rectangle contains everything was on the screen before the capture script was launched but when your program emits it's output i get the whole text in vertical sense ie only in the first column of the console.

    Can be related to the following regexes (which i do not understand)? 

     
$rect =~ s{ \0\a\0       } ''xmsg;
$rect =~ s{ [ ]+ \z      } ''xms;
$rect =~ s{ .{$width} \z } ''xms;

    [download]

    Here too win7 + strawberry perl 

    perl -MConfig -MWin32::Console -E "say $Config{version}; say $Win32::C
+onsole::VERSION"

5.14.2
0.10

    [download]

    thanks

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
[reply]
[d/l]
[select]

      This was just a quick hack thrown together to show what might be done with Win32::Console.

      After I got to the point at which I captured $rect, I dd-ed it (Data::Dump) and found that a string that appeared as, e.g., 'perl...' in the console was dumped as  "p\0\a\0e\0\a\0r\0\a\0l\0\a\0..." I used the
          $rect =~ s{ \0\a\0 } ''xmsg;
      substitution to convert the string back to 'perl...'. Why the extra "\0\a\0" groups were present with each character I don't know; I assume some character set/encoding effect. I didn't investigate further, but just zapped them. I would suggest you do a raw dump of whatever you first get back from the
          my $rect = $con_current->ReadRect($left, $top, $right, $bottom);
      call and adjust as necessary for your system; I don't know what the appropriate  s/// will be for you.

      What you get back from the  ReadRect() call is apparently a single long line without newlines. You then may have to break this string up into lines (possibly triming trailing whitespace) in order to have something useful, but again, I didn't bother with this step. I did find a bunch of blanks may be present at the end of the string, which I got rid of with the
          $rect =~ s{ [ ]+ \z } ''xms;
      substitution. Purely for cosmetic purposes, a further substitution of
          $rect =~ s{ .{$width} \z } ''xms;
      removes the last line with the
          c:\@Work\Perl\monks\gpmathis>capsess
      invocation before printing the  $rect string.

      ... i get the whole text in vertical sense ie only in the first column of the console.

      By this I assume you mean that 'perl...' appears as 

      p
e
r
l
.
.
.

      [download]
      in your console window. I have no idea why this is, but can only suggest that you dump the raw  $rect string returned by the  ReadRect() call and go on from there, hacking away until you get something that looks ok. Good luck.

      Give a man a fish:  <%-{-{-{-<

[reply]
[d/l]
[select]
        hello estimed AnomalousMonk,

        I do not wanted you doing the job in my place ;=) I just hoped you had a more precise idea of how to work with this module: infact i looked at it several times in the past and i gave up, everytime.

        > to show what might be done with Win32::Console.

        This is exactly my problem. What is effectively possible to do with this? The lack of SYNOPSIS in the module is well.. disorienting at least

        The /eg/sample.pl runs fine here but is not a simple sample. Nor the net nor PM are source of great examples..

        The module date 10 Feb 1997, by dada, the XS seems to do everything and is beyond my possibilities.

        And yes your example works for me but as you said it prints everything in vertical, as you shown.

        I'v played with it a bit, using what the logic of names suggested to me and got not WriteRect working as I expected:

        use warnings;
use strict;

use Win32::Console qw(GENERIC_READ GENERIC_WRITE);
use Data::Dump qw(dd);

my $con_current = Win32::Console->new(GENERIC_READ | GENERIC_WRITE);
$con_current or die 'new Win32::Console failed';

my ($left, $top, $right, $bottom) = $con_current->Window;
print "Dimensions (left top right bottom):",qq($left, $top, $right, $b
+ottom \n);

my $rect = $con_current->ReadRect($left, $top, $right, $bottom);
$rect or die 'read Win32::Console failed';

#$rect =~ s{ \0\a\0  } ''xmsg;
#$rect =~ s{ [ ]+ \z } ''xmsg;

#dd $rect;
print qq{======\nBefore writing anything from Win32.:Console\n======\n
+};

$con_current->WriteRect($rect,$left, $top, $right, $bottom )or die 'wr
+ite Win32::Console failed'; 

print "dd of \$rect: "; dd $rect;

##OUTPUT

Dimensions (left top right bottom):0, 0, 119, 29
======
Before writing anything from Win32.:Console
======
dd of $rect: (" \0\37\0" x 3600)

        [download]

        I suspect \0\37\0 is because i run the sample.pl and the screen remained white on blue; after i issued color 0A (green on black) i got dd of $rect: (" \0\n\0" x 3600) so this seems to be the attribute thing;

        Your good luck was now comprensible ;=)

        thanks anyway

        L*

        There are no rules, there are no thumbs..
        Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
[reply]
[d/l]
[select]
Re^2: Saving a Perl session to a file
by marinersk (Priest) on Apr 14, 2017 at 02:59 UTC
[reply]
[d/l]

In Section Seekers of Perl Wisdom