In attempting to create a spreadsheet using cell properties previously defined, I'm having issues where the cell formatting is only sporadically being written in the cells. The values are there, but the font color, etc. is not always there.
Here's my code:
$result_file = $toxls . ".excel_props.xls";
$property_file = "properties.txt";
open (PROP, ">$property_file");
my $parser = Spreadsheet::ParseExcel->new();
my $workbook_parse = $parser->parse( $toxls );
my $worksheet_parse = $workbook_parse->Worksheet( $totab );
my ( $col_min, $col_max ) = $worksheet_parse->col_range();
my ( $row_min, $row_max ) = $worksheet_parse->row_range();
my $workbook = Spreadsheet::WriteExcel->new( $result_file );
my $worksheet = $workbook->addworksheet( $totab );
my %bkgd_color = ();
$worksheet->set_column('A:A', 12);
$worksheet->set_column('C:C', 15);
$worksheet->set_column('D:D', 30);
$worksheet->set_column('E:E', 30);
$worksheet->set_column('F:F', 35);
$worksheet->set_column('G:G', 40);
$worksheet->set_column('I:I', 40);
for my $col ( $col_min .. $col_max ) {
for my $row ( $row_min .. $row_max ) {
# Return the cell object at $row and $col
my $cell = $worksheet_parse->get_cell( $row, $col );
next unless $cell;
my $value = $cell->value();
my $format = $cell->get_format();
my $pattern = $format->{Fill}->[0];
my $color1 = $format->{Fill}->[1];
my $color2 = $format->{Fill}->[2];
my $font = $format->{Font};
my $fontcolor = $font->{Color};
## Change value if font color = black
if ($fontcolor eq '32767') {
$fontcolor = "8";
}
my $wrap = $format->{Wrap};
my $bold = $font->{Bold};
print PROP "\nRow, Col = ($row, $col)\n";
print PROP "Pattern = $pattern\n";
print PROP "Value = $value\n";
print PROP "Fill = $pattern $color1 $color2\n";
print PROP "Wrap = $wrap\n";
print PROP "Font = $fontcolor\n";
print PROP "Bold = $bold\n";
if (index($value,"B\=baseline") > -1 || index($value,"B\=Baseline") > -1) {
$worksheet->set_row($row, 150);
}
if ($pattern == 1 ){
if ( ! exists $bkgd_color{$color1} ){
$bkgd_color{$color1} = $workbook->add_format(
pattern => $pattern,
bg_color => $color1,
align => 'left',
valign => 'top',
text_wrap => $wrap,
border => 1,
color => $fontcolor,
bold => $bold
);
print PROP "Print segment = not exist bkgd_color\n";
}
$worksheet->write( $row, $col, $value, $bkgd_color{$color1});
} else {
$format = $workbook->add_format();
$format->set_pattern($pattern);
$format->set_align('left');
$format->set_valign('top');
$format->set_bg_color($color2);
$format->set_fg_color($color1);
$format->set_color($fontcolor);
$format->set_text_wrap($wrap);
$format->set_border();
$format->set_bold($bold);
print PROP "Fontcolor = $fontcolor\n";
$worksheet->write( $row, $col, $value, $format);
}
}
}
The properties.txt file shows what I expect when I parse the $toxls spreadsheet, which I'm using to test with. Yet, it doesn't always produce the formatting (font color, Align, and AlignH) that is being saved from the parse, when I write back out to the $result_file. Any ideas?
The properties.txt file looks good:
Row, Col = (2, 3)
Pattern = 1
Value = Password Requirements
Fill = 1 22 31
Wrap = 1
Font = 10 <-- red text
Bold = 1
Row, Col = (3, 3)
Pattern = 1
Value = Logging
Fill = 1 22 31
Wrap = 1
Font = 12 <--- blue text
Bold = 0
Row, Col = (4, 3)
Pattern = 0
Value = Logging
Fill = 0 64 65
Wrap = 1
Font = 12
Bold = 0
Fontcolor = 12
Row, Col = (5, 3)
Pattern = 1
Value = AntiVirus
Fill = 1 22 31
Wrap = 1
Font = 8 <-- black text
Bold = 0
My goal is simply to read in an existing spreadsheet, then create a new one with the exception of altering the font color or fill color on some cells. I tried this snippet, and it even missed formatting on many of the cells:
for my $col ( $col_min .. $col_max ) {
for my $row ( $row_min .. $row_max ) {
# Return the cell object at $row and $col
my $cell = $worksheet_parse->get_cell( $row, $col );
next unless $cell;
my $value = $cell->value();
my $format = $cell->get_format();
$worksheet->write( $row, $col, $value, $format);
}
}
I'm not quite sure why you are saving the format to $bkgd_color{$color1} other than to save some processing time but I suspect that is where your problem is. Try changing that section of your code to:
if ( $pattern == 1 ) {
$format = $workbook->add_format(
pattern => $pattern,
bg_color => $color1,
align => 'left',
valign => 'top',
text_wrap => $wrap,
border => 1,
color => $fontcolor,
bold => $bold
);
$worksheet->write( $row, $col, $value, $format);
}
See this new code removing the bgcolor logic. Yet, the resulting spreadsheet is only partially formatted correctly:
my $parser = Spreadsheet::ParseExcel->new();
my $workbook_parse = $parser->parse( $toxls );
my $worksheet_parse = $workbook_parse->Worksheet( $totab );
my ( $col_min, $col_max ) = $worksheet_parse->col_range();
my ( $row_min, $row_max ) = $worksheet_parse->row_range();
my $workbook = Spreadsheet::WriteExcel->new( $result_file );
my $worksheet = $workbook->addworksheet( $totab );
$worksheet->set_column('A:A', 12);
$worksheet->set_column('C:C', 15);
$worksheet->set_column('D:D', 30);
$worksheet->set_column('E:E', 30);
$worksheet->set_column('F:F', 35);
$worksheet->set_column('G:G', 40);
$worksheet->set_column('I:I', 40);
for my $row ( $row_min .. $row_max ) {
for my $col ( $col_min .. $col_max ) {
# Return the cell object at $row and $col
my $cell = $worksheet_parse->get_cell($row,$col);
next unless $cell;
my $value = $cell->value();
my $format = $cell->get_format();
my $pattern = $format->{Fill}->[0];
my $color1 = $format->{Fill}->[1];
my $color2 = $format->{Fill}->[2];
my $wrap = $format->{Wrap};
my $font = $format->{Font};
my $fontcolor = $font->{Color};
my $bold = $font->{Bold};
## Change value if font color = black
if ($fontcolor eq '32767') {
$fontcolor = "8";
}
## Freeze after the header row
if (index($value,"B\=baseline") > -1 || index($value,"B\=Baseline") > -1) {
$worksheet->set_row($row, 150);
$freezerow = $row + 1;
$worksheet->freeze_panes($freezerow, 0);
}
my $updformat = $workbook->add_format(
pattern => $pattern,
fg_color => $color1,
bg_color => $color2,
align => 'left',
valign => 'top',
text_wrap => $wrap,
border => 1,
color => $fontcolor,
bold => $bold
);
$worksheet->write( $row, $col, $value, $updformat);
}
}
Related
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 5 years ago.
Improve this question
Below is the output I got when I use print Dumper(\%Data) in my code
{
"" => undef,
"123456789012:SRIRAMA" => [123456789012, "SRIRAMA", 856.06, 0, 0, 0],
"389252737122:RAMA" => [389252737122, "RAMA", 345.76, 0, 0, 0],
}
This data I have to write to an Excel file like below
Number Name number name amt amt2 amt3 amt4
123456789012 SRIRAMA 123456789012 SRIRAMA 856.06 0 0 0
389252737122 RAMA 389252737122 RAMA 345.76 0 0 0
The first two columns are one SQL result and rest of the columns are another SQL query result.
The first query result I have put in a map and searched based on the key in second query result and finally I got the output above.
Here, Number and Name—the first two columns—are keys for searching the data.
The code below is after getting the SQL result:
foreach ( #Sqlresult ) {
$rec_cntr = $rec_cntr + 1;
my #fields = undef;
chop;
next if /^$/;
next if /ERROR:/;
next if /ORA-/;
#fields = split( /::/, $_ );
my $fldref = #fields;
$ent_id = undef;
$ent_id = $fields[0];
$key = undef;
$key = $fields[0] . ":" . $name;
push( #{ $Data{$key} }, $fields[1] );
}
$rec_cntr = 0;
The below code snippet I use when the records are not there pushing as zero.
my $kkey = undef;
for $kkey ( sort keys %Data ) {
next if $kkey eq '';
my $Lent = #{ $Data{$kkey} };
if ( $Lent < 5 ) {
push( #{ $Data{$kkey} }, 0 );
}
print scalar #{ $Data{$kkey} };
}
print Dumper( \%Data );
The above print Dumper produces the information shown at the start of the question
Here is where the data is written into an Excel sheet
my $dt = `date +%m-%d-%Y_%\I%\M`;
chop $dt;
my $FileName = "/data_reports/AdjestedFile" . $dt . ".xls";
#my $workbook = Spreadsheet::WriteExcel->new( $FileName );
my $workbook = Excel::Writer::XLSX->new( $FileName );
# Define the format and add it to the worksheet
my $format = $workbook->add_format(
center_across => 1,
bold => 1,
size => 10,
color => "black",
bg_color => "grey",
border_color => "black",
align => "vcenter",
);
my $formatnum = $workbook->add_format();
$formatnum->set_num_format( '00000000000' );
my $formatamt = $workbook->add_format();
$formatamt->set_num_format( '0.00' );
$formatamt->set_align( 'right' );
my $formattext = $workbook->add_format( num_format => '#' );
my $prev_feetype = "";
my $current_ws;
$current_ws = $workbook->add_worksheet();
$current_ws->keep_leading_zeros( 1 );
$current_ws->set_column( 0, 16, 17, $formattext );
$current_ws->set_column( 1, 1, 13, $formattext );
$current_ws->set_column( 2, 2, 10, $formatnum );
$current_ws->set_column( 3, 3, 10, $formattext );
$current_ws->set_column( 4, 4, 10, $formattext );
$current_ws->set_column( 5, 5, 10, $formattext );
$current_ws->set_column( 6, 6, 10, $formattext );
$current_ws->set_column( 7, 7, 10, $formattext );
my $cl = 0;
$current_ws->write_string( 0, $cl++, "Number", $format );
$current_ws->write_string( 0, $cl++, "Name", $format );
$current_ws->write_string( 0, $cl++, "amt", $format );
$current_ws->write_string( 0, $cl++, "NA", $format );
$current_ws->write_string( 0, $cl++, "NA", $format );
$current_ws->write_string( 0, $cl++, "NA", $format );
$current_ws->write_string( 0, $cl++, "NA", $format );
$current_ws->write_string( 0, $cl++, "NA", $format );
my $rownum = 1;
foreach ( %Data ) {
my #fields = undef;
chop;
next if /^$/;
#fields = split( /,/, $_ );
my $fldref = \#fields;
my $clcntr = 0;
my $ent_id = "";
foreach ( #fields ) {
if ( $clcntr == 1 ) {
$ent_id = $_;
}
if ( isfloat( $_ ) ) { #and $clcntr != 9 ) {
$current_ws->write_number( $rownum, $clcntr++, $_ );
}
else {
$current_ws->write_string( $rownum, $clcntr++, $_ );
}
}
}
There's a lot to read there, but these ideas may help
Always use strict and use warnings at the top of every Perl program you write. It is invaluable for locating the more obvious bugs
Don't initialise arrays with #data = undef. If you want to empty an existing array then write #data = (). If you are declaring a new array then my #data will create a new empty array
The exact same advice applies to hashes, and that will be the reason for the "" => undef at the start of your %Data hash
Don't use my $dt = `date +%m-%d-%Y_%\I%\M`. You are starting a whole new shell process just to ask it the time. You should
use Time::Piece;
and
my $dt = localtime->strftime('%m-%d-%Y_%I%M');
The result from this won't need chomping
But are you sure you want %I? That gives you the 12-hour time, so the value will reset to zero at midday. %H gives you 24-hour time, and is much more likely to be useful
chomp is preferable to chop unless you're doing something unusual. chop will just remove the last character from a string, whatever it is, while chomp will remove the last character if it is a newline
for ( %Data ) { ... } will loop over the hash setting $_ to key1, val1, key2, val2 etc. That isn't what you want
In this case, since the information in the key is duplicated in the value, you probably want for ( values %Data ) { ... }. But that value is an array reference so no splitting is required
This is probably closer to what you need
my $rownum = 0;
for my $values ( values %Data ) {
my $colnum = 0;
for my $val ( #$values ) {
if ( isfloat($_) ) {
$current_ws->write_number( $rownum, $colnum++, $val );
}
else {
$current_ws->write_string( $rownum, $colnum++, $val );
}
}
}
I am new to Perl. I have excel file say "sample.xls" which looks like follows.
Sample.xls
There are about data of 1000 rows like this. I want to parse this file and write it in another file say "output.xls" with following output format.
output.xls
I have written a script in perl, however, it doesn't give me the exact output the way I want. Also, looks like the script is not very efficient. Can anyone guide me how I can improve my script as well as have my output as shown in "output.xls" ??
Here's the Script:
#!/usr/bin/perl –w
use strict;
use warnings;
use Spreadsheet::ParseExcel;
use Spreadsheet::WriteExcel;
use Spreadsheet::WriteExcel::Chart;
# Read the input and output filenames.
my $inputfile = "path/sample.xls";
my $outputfile = "path/output.xls";
if ( !$inputfile || !$outputfile ) {
die( "Couldn't find file\n" );
}
my $parser = Spreadsheet::ParseExcel->new();
my $inwb = $parser->parse( $inputfile );
if ( !defined $inwb ) {
die "Parsing error: ", $parser->error(), ".\n";
}
my $outwb = Spreadsheet::WriteExcel->new( $outputfile );
my $inws = $inwb->worksheet( "Sheet1" );
my $outws = $outwb->add_worksheet("Sheet1");
my $out_row = 0;
my ( $row_min, $row_max ) = $inws->row_range();
my ( $col_min, $col_max ) = $inws->col_range();
my $format = $outwb->add_format(
center_across => 1,
bold => 1,
size => 10,
border => 4,
color => 'black',
border_color => 'black',
align => 'vcenter',
);
$outws->write(0,0, "Item Name", $format);
$outws->write(0,1, "Spec", $format);
$outws->write(0,2, "First name", $format);
$outws->write(0,3, "Middle Name", $format);
$outws->write(0,4, "Last Name", $format);
$outws->write(0,5, "Customer Number", $format);
$outws->write(0,6, "Age", $format);
$outws->write(0,7, "Units", $format);
my $col_count = 1;
#$row_min = 1;
for my $inws ( $inwb->worksheets() ) {
my ( $row_min, $row_max ) = $inws->row_range();
my ( $col_min, $col_max ) = $inws->col_range();
for my $in_row ( 2 .. $row_max ) {
for my $col ( 0 .. 0 ) {
my $cell = $inws->get_cell( $in_row, $col);
my #fields = split /_/, $cell->value();
next unless $cell;
$outws->write($in_row,$col, $cell->value());
$outws->write($in_row,$col+1, $fields[1]);
}
}
for my $in_row ( 2 .. $row_max ) {
for my $col ( 1 .. 1 ) {
my $cell = $inws->get_cell( $in_row, $col);
my #fields = split /_/, $cell->value();
next unless $cell;
#$outws->write($in_row,$col+1, $cell->value());
$outws->write($in_row,$col+1, $fields[0]);
$outws->write($in_row,$col+2, $fields[1]);
$outws->write($in_row,$col+3, $fields[2]);
$outws->write($in_row,$col+4, $fields[3]);
}
}
for my $in_row ( 2 .. $row_max ) {
for my $col ( 2 .. 2 ) {
my $cell = $inws->get_cell( $in_row, $col);
my #fields = split /_/, $cell->value();
next unless $cell;
$outws->write($in_row,6, $cell->value());
}
}
for my $in_row ( 2 .. $row_max ) {
for my $col ( 3 .. 9 ) {
my $cell = $inws->get_cell( $in_row, $col);
next unless $cell;
}
}
for my $in_row ( 2 .. $row_max ) {
for my $col ( 10 .. 10 ) {
my $cell = $inws->get_cell( $in_row, $col );
next unless $cell;
$outws->write($in_row,7, $cell->value());
}
}
}
To get your output sorted, you need to collect all the information first before you are writing it out. Right now, you are doing a bit of jumping back and forth between rows and columns.
Here are some changes I would make to get it sorted, and make it more efficient (to read).
Create a data structure $data outside of your loop to store all the information.
If there is only one worksheet, you don't need to loop over sheets. Just work with one sheet.
Loop over the lines.
Inside that loop, use the code you have to parse the individual fields to just parse them. No 2..2 loops. Just a bunch of statements.
my #item_fields = split /_/, $inws->get_cell( $in_row, 0 ) || q{};
my #name_fields = split /_/, $inws->get_cell( $in_row, $col ) || q{};
Store them in $data per item.
push #{ $data } = [ $item_fields[0], ... ];
Done with the loop. Open the output file.
Loop over $data with a sort and write to the output file.
foreach my $row (sort { $a->[0] cmp $b->[0] } #{ $data } ) { ... }
Done.
I suggest you read up on sort and also check out perlref and perlreftut to learn more about references (data structures).
I am new to Spreadsheet::ParseExcel. I have a space-delimited file which I opened in Microsoft Excel and saved it as a XLS file.
I installed Spreadsheet::ParseExcel and used the example code in documentation to print the contents of the file. My objective is to build an array of some of the data to write to a database. I just need a little help building the array -- writing to a database I'll figure out later.
I'm having a hard time understanding this module -- I did read the documentation, but because of my inexperience I'm unable to understand it.
Below is the code I'm using for the output.
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
use Spreadsheet::ParseExcel;
my $parser = Spreadsheet::ParseExcel->new();
my $workbook = $parser->parse( 'file.xls' );
if ( !defined $workbook ) {
die $parser->error(), ".\n";
}
for my $worksheet ( $workbook->worksheets() ) {
my ( $row_min, $row_max ) = $worksheet->row_range();
my ( $col_min, $col_max ) = $worksheet->col_range();
for my $row ( $row_min .. $row_max ) {
for my $col ( $col_min .. $col_max ) {
my $cell = $worksheet->get_cell( $row, $col );
next unless $cell;
print "Row, Col = ($row, $col)\n";
print "Value = ", $cell->value(), "\n";
print "Unformatted = ", $cell->unformatted(), "\n";
print "\n";
}
}
}
And here is some of the output
Row, Col = (0, 0)
Value = NewRecordFlag
Unformatted = NewRecordFlag
Row, Col = (0, 1)
Value = AgencyName
Unformatted = AgencyName
Row, Col = (0, 2)
Value = CredentialIdnt
Unformatted = CredentialIdnt
Row, Col = (0, 3)
Value = ContactIdnt
Unformatted = ContactIdnt
Row, Col = (0, 4)
Value = AgencyRegistryCardNumber
Unformatted = AgencyRegistryCardNumber
Row, Col = (0, 5)
Value = Description
Unformatted = Description
Row, Col = (0, 6)
Value = CredentialStatusDescription
Unformatted = CredentialStatusDescription
Row, Col = (0, 7)
Value = CredentialStatusDate
Unformatted = CredentialStatusDate
Row, Col = (0, 8)
Value = CredentialIssuedDate
Unformatted = CredentialIssuedDate
My objective is to build an array of CredentialIssuedDate, AgencyRegistryCardNumber, and AgencyName. Once I grasp the concept of doing that, I can go to town with this great module.
Here's a quick example of something that should work for you. It builds an array #rows of arrays of the three field values you want for each worksheet, and displays each result using Data::Dumper. I haven't been able to test it, but it looks right and does compile
It starts by building a hash %headers that relates the column header strings to the column number, based on the first row in each worksheet.
Then the second row onwards is processed, extracting the cells in the columns named in the #wanted array, and putting their values in the array #row, which is pushed onto #rows as each one is accumulated
#!/usr/bin/perl
use strict;
use warnings;
use Spreadsheet::ParseExcel;
use Data::Dumper;
my #wanted = qw/
CredentialIssuedDate
AgencyRegistryCardNumber
AgencyName
/;
my $parser = Spreadsheet::ParseExcel->new;
my $workbook = $parser->parse('file.xls');
if ( not defined $workbook ) {
die $parser->error, ".\n";
}
for my $worksheet ( $workbook->worksheets ) {
my ( $row_min, $row_max ) = $worksheet->row_range;
my ( $col_min, $col_max ) = $worksheet->col_range;
my %headers;
for my $col ( $col_min, $col_max ) {
my $header = $worksheet->get_cell($row_min, $col)->value;
$headers{$header} = $col;
}
my #rows;
for my $row ( $row_min + 1 .. $row_max ) {
my #row;
for my $name ( #wanted ) {
my $col = $headers{$name};
my $cell = $worksheet->get_cell($row, $col);
push #row, $cell ? $cell->value : "";
}
push #rows, \#row;
}
print Dumper \#rows;
}
I was able to resolve this by using the Spreadsheet::BasicReadNamedCol module
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
use Spreadsheet::BasicReadNamedCol;
my $xlsFileName = 'shit.xls';
my #columnHeadings = (
'AgencyName',
'eMail',
'PhysicalAddress1',
'PhysicalAddress2'
);
my $ss = new Spreadsheet::BasicReadNamedCol($xlsFileName) ||
die "Could not open '$xlsFileName': $!";
$ss->setColumns(#columnHeadings);
# Print each row of the spreadsheet in the order defined in
# the columnHeadings array
my $row = 0;
while (my $data = $ss->getNextRow())
{
$row++;
print join('|', $row, #$data), "\n";
}
I have started using Spreadsheet::WriteExcel::Chart for writing chart.I have 10 worksheet which contain data. I have added one worksheet for chart. My question is, How can I create chart using another worksheet data.
2) I also tried another approach In which,I have created new worksheet and load data from old worksheet than try to create chart.
3)In $data,we are hardcoding value, is it possible that can we fetch value from cell rather
than hardcode value
In both case,I am not able to figure out the solution.
use Spreadsheet::ParseExcel;
use Spreadsheet::WriteExcel;
use Spreadsheet::ParseExcel::SaveParser;
# Open the template with SaveParseir
my $parser = new Spreadsheet::ParseExcel::SaveParser;
my $workbook = $parser->Parse('DD1.xls');
if ( !defined $workbook ) {
die $parser->error(), ".\n";
}
#Create the New worksheet
my $Flop_workbook = Spreadsheet::WriteExcel->new('Flop.xls');
for my $worksheet ( $workbook->worksheets() ) {
my ( $row_min, $row_max ) = $worksheet->row_range();
my ( $col_min, $col_max ) = $worksheet->col_range();
my $worksheetname = $worksheet->get_name();
print "worksheetname : ", $worksheetname ,"\n";
my $sheet = $Flop_workbook->add_worksheet($worksheetname);
for my $row ( $row_min .. $row_max ) {
for my $col ( $col_min .. $col_max ) {
my $cell = $worksheet->get_cell( $row, $col );
next unless $cell;
print "Row, Col = ($row, $col)\n";
print "Value = ", $cell->value, "\n";
print "Unformatted = ", $cell->unformatted(), "\n";
$sheet->write_string($row,$col,$cell->value);
print "\n";
}
}
}
my $chartsheet = $Flop_workbook->add_worksheet('Chart_data');
my $chart = $Flop_workbook->add_chart( type => 'line' );
#Configure the chart.
$chart->add_series(
categories => '=SUM_F_SCDLIB_DFF!$I$2',
values => '=SUM_F_SCDLIB_DFF!$I$2',
); (Failed here As I need to load another worksheet data)
# Add the worksheet data the chart refers to.
my $data = [
[ 'Category', 2, 3, 4, 5, 6, 7 ],
[ 'Value', 1, 4, 5, 2, 1, 5 ],
];
$chartsheet->write( 'AB5', $data );
#$template->SaveAs('newfile.xlsx');
What would constitute a mouse-drag when using the Input method from Win32::Console?
use Win32::Console qw(STD_INPUT_HANDLE ENABLE_MOUSE_INPUT);
my $con_in = Win32::Console->new(STD_INPUT_HANDLE);
$con_in->Mode(ENABLE_MOUSE_INPUT);
sub getch {
my ( $arg ) = #_;
my #event = $con_in->Input();
my $event_type = shift( #event );
if ( defined $event_type and $event_type == 2 ) {
my( $x, $x, $button_state, $control_key, $event_flags ) = #event;
my $button_drag = ?;
return handle_mouse( $x, $y, $button_state, $button_drag, $arg );
}
}
The getch on Linux looks like this:
sub getch {
my ( $arg ) = #_;
my $c = ReadKey 0;
if ( $c eq "\e" ) {
my $c = ReadKey 0.10;
# ...
if ( $c eq '[' ) {
my $c = ReadKey 0;
# ...
if ( $c eq 'M' ) {
# On button press, xterm sends CSI M C b C x C y (6 characters).
my $event_type = ord( ReadKey 0 ) - 32;
my $x = ord( ReadKey 0 ) - 32;
my $y = ord( ReadKey 0 ) - 32;
my $button_drag = ( $event_type & 0x20 ) >> 5;
my $button_pressed;
my $low3bits = $event_type & 0x03;
if ( $low3bits == 0x03 ) {
$button_pressed = 0;
} else {
if ( $event_type & 0x40 ) {
$button_pressed = $low3bits + 4;
} else {
$button_pressed = $low3bits + 1;
}
}
return handle_mouse( $x, $y, $button_pressed, $button_drag, $arg );
}
# ...
}
}
}
I've found something, but I'm not sure whether it is right.
use Win32::Console qw(STD_INPUT_HANDLE ENABLE_MOUSE_INPUT);
my $con_in = Win32::Console->new(STD_INPUT_HANDLE);
$con_in->Mode(ENABLE_MOUSE_INPUT);
sub getch {
my ( $arg ) = #_;
my #event = $con_in->Input();
my $event_type = shift( #event );
if ( defined $event_type and $event_type == 2 ) {
my( $x, $x, $button_state, $control_key, $event_flags ) = #event;
my $button_drag = 0;
# MOUSEEVENTF_MOVE => 0x0001
$button_drag = 1 if $event_flags & MOUSEEVENTF_MOVE;
return handle_mouse( $x, $y, $button_state, $button_drag, $arg );
}
}