Skip to content

Commit

Permalink
FIXED: cell canonization in list context
Browse files Browse the repository at this point in the history
  • Loading branch information
nadim khemir committed May 5, 2011
1 parent 8c9d01f commit 67ee4d9
Show file tree
Hide file tree
Showing 10 changed files with 453 additions and 63 deletions.
4 changes: 3 additions & 1 deletion MANIFEST
View file
Expand Up @@ -25,7 +25,9 @@ Perl/Reference.pm
Perl/UserData.pm
Perl/Validator.pm

examples/
t/test_template
t/0100_perl_formula.t

examples/ref2.pl
examples/ascii_table2.pl
examples/create_setup.pl
Expand Down
14 changes: 14 additions & 0 deletions Perl.pm
View file
Expand Up @@ -416,6 +416,12 @@ if($is_cell)
}
}
}

if($self->{DEBUG}{FETCH_VALUE})
{
my $dh = $self->{DEBUG}{ERROR_HANDLE} ;
print $dh "\t value: $value\n" ;
}

return($value) ;
}
Expand All @@ -429,6 +435,13 @@ else
{
push @values, $self->Get($current_address) ;
}

if($self->{DEBUG}{FETCH})
{
my $dh = $self->{DEBUG}{ERROR_HANDLE} ;
print $dh "END: Fetching range '$cell_or_range'\n" ;
}


return \@values ;
}
Expand Down Expand Up @@ -2305,6 +2318,7 @@ The following flags exist:
$ss->{DEBUG}{VALIDATOR}++ ; # display calls to all validators in spreadsheet
$ss->{DEBUG}{FETCH}++ ; # shows when a cell value is fetched
$self->{DEBUG}{FETCH_VALUE}++ ; # shows which value is fetched
$ss->{DEBUG}{STORE}++ ; # shows when a cell value is stored
$ss->{DEBUG}{FETCH_TRIGGER}{'A1'}++ ; # displays a message when 'A1' is fetched
$ss->{DEBUG}{FETCH_TRIGGER}{'A1'} = sub {my ($ss, $address) = @_} ; # calls the sub when 'A1' is fetched
Expand Down
137 changes: 101 additions & 36 deletions Perl/Address.pm
View file
Expand Up @@ -56,7 +56,7 @@ my $spreadsheet = '' ;

if($address =~ /^([A-Z_]+!)(.+)/)
{
# reference to another spreadsheet
# reference to spreadsheet
$spreadsheet = $1 ;
$address = $2 ;
}
Expand All @@ -74,21 +74,21 @@ else

if(defined $named_cell_range)
{
if($spreadsheet ne '' && $named_cell_range =~ /^([A-Z_]+!)/)
if($named_cell_range =~ /^([A-Z_]+!)(.+)/)
{
confess "adress '$address' contains a spreadsheeet name as do componants of address!" ;
if($spreadsheet ne '')
{
confess "address '$address' contains multiple spreadsheet names !" ;
}

$spreadsheet = $1 ;
$named_cell_range = $2 ;
}

($start_cell, $end_cell) = $named_cell_range =~ /^(.+):(.+)$/ ;

unless(defined $start_cell)
{
if($named_cell_range =~ /^([A-Z_]+!)(.+)/)
{
$spreadsheet = $1 ;
$named_cell_range = $2 ;
}

$start_cell = $end_cell = $named_cell_range ;
$is_cell++ ;
}
Expand All @@ -104,10 +104,9 @@ else

if($is_cell)
{
#~ print "Canonizing '$spreadsheet$address' => '$spreadsheet$start_cell'\n" ;
if(wantarray)
{
return("$spreadsheet$start_cell", $is_cell, "$spreadsheet$start_cell", "$spreadsheet$end_cell") ;
return("$spreadsheet$start_cell", $is_cell, "$start_cell", "$end_cell") ;
}
else
{
Expand All @@ -116,10 +115,9 @@ if($is_cell)
}
else
{
#~ print "Canonizing '$spreadsheet$address' => '$spreadsheet$start_cell:$end_cell'\n" ;
if(wantarray)
{
return("$spreadsheet$start_cell:$end_cell", $is_cell, "$spreadsheet$start_cell", "$spreadsheet$end_cell") ;
return("$spreadsheet$start_cell:$end_cell", $is_cell, "$start_cell", "$end_cell") ;
}
else
{
Expand Down Expand Up @@ -338,8 +336,7 @@ for my $address (@addresses_definition)
}
else
{
@x_list = ($end_x .. $start_x ) ;
@x_list = reverse @x_list ;
@x_list = reverse ($end_x .. $start_x ) ;
}

my @y_list ;
Expand All @@ -349,8 +346,7 @@ for my $address (@addresses_definition)
}
else
{
@y_list = ($end_y .. $start_y ) ;
@y_list = reverse @y_list ;
@y_list = reverse ($end_y .. $start_y ) ;
}

for my $x (@x_list)
Expand Down Expand Up @@ -408,14 +404,56 @@ else

#-------------------------------------------------------------------------------

sub is_within_range
{
my ($self, $cell_address, $range) = @_ ;

my ($range_canonized, $is_cell, $range_start_cell, $range_end_cell)
= $self->CanonizeAddress($range) ;

if($cell_address=~ /^[A-Z_]+!(.+)/)
{
$cell_address = $1 ;
}

my ($range_start_column, $range_start_row)
= $range_start_cell=~ /^([A-Z@]+)([0-9]+)$/ ;

$range_start_column = FromAA($range_start_column) ;

my ($range_end_column, $range_end_row)
= $range_end_cell=~ /^([A-Z@]+)([0-9]+)$/ ;

$range_end_column = FromAA($range_end_column) ;

my ($full_column, $column, $full_row, $row)
= $cell_address=~ /^(\[?([A-Z@]+)\]?)(\[?([0-9]+)\]?)$/ ;

my $column_index = FromAA($column) ;

if
(
$column_index < $range_start_column
|| $column_index > $range_end_column
|| $row < $range_start_row
|| $row > $range_end_row
)
{
return 0 ;
}
else
{
return 1 ; # within range
}
}

#-------------------------------------------------------------------------------

sub OffsetAddress
{
# this function accept adresses that are fixed ex: [A1]

my $self = shift ;
my $address = shift ;
my $column_offset = shift ;
my $row_offset = shift ;
my ($self, $address, $column_offset, $row_offset, $range) = @_ ;

my ($spreadsheet, $is_cell, $start_cell, $end_cell) = ('') ;

Expand All @@ -439,32 +477,56 @@ else
{
($address, $is_cell, $start_cell, $end_cell) = $self->CanonizeAddress($address) ;

if($start_cell=~ /^([A-Z_]+!)(.+)/)
{
$spreadsheet = $1 ;
$start_cell = $2 ;
}

if($end_cell=~ /^([A-Z_]+!)(.+)/)
if($address =~ /^([A-Z_]+!)(.+)/)
{
$spreadsheet = $1 ;
$end_cell = $2 ;
}
}
}

if($is_cell)
{
return
if
(
$self->OffsetCellAddress($spreadsheet . $start_cell, $column_offset, $row_offset)
) ;
! defined $range
|| $self->is_within_range($start_cell, $range)
)
{
return $self->OffsetCellAddress
(
$spreadsheet . $start_cell,
$column_offset,
$row_offset
) ;
}
else
{
return "$spreadsheet$start_cell" ;
}
}
else
{
my $lhs = $self->OffsetCellAddress($start_cell, $column_offset, $row_offset) ;
my $rhs = $self->OffsetCellAddress($end_cell, $column_offset, $row_offset) ;

my $lhs = $start_cell ;
my $rhs = $end_cell ;

if
(
! defined $range
|| $self->is_within_range($lhs, $range)
)
{
$lhs = $self->OffsetCellAddress($start_cell, $column_offset, $row_offset) ;
}

if
(
! defined $range
|| $self->is_within_range($rhs, $range)
)
{
$rhs = $self->OffsetCellAddress($end_cell, $column_offset, $row_offset) ;
}

if(defined $lhs && defined $rhs)
{
return("$spreadsheet$lhs:$rhs") ;
Expand All @@ -476,6 +538,8 @@ else
}
}

#-------------------------------------------------------------------------------

sub OffsetCellAddress
{
my $self = shift ;
Expand Down Expand Up @@ -548,6 +612,7 @@ return ($column2_index - $column1_index, $row2 - $row1) ;
1 ;

__END__
=head1 NAME
Spreadsheet::Perl::Address - Cell adress manipulation functions
Expand Down
25 changes: 13 additions & 12 deletions examples/Address_test.pl
View file
Expand Up @@ -21,21 +21,22 @@
, D => 'NAME!NADIM:B2'
) ;

print $ss->Dump(undef , 1) ;
@ss{'A', 'B', 'C', 'D'} = (1 .. 10) ;

#~ @ss{'A', 'B', 'C', 'D'} = (1 .. 4) ;
$ss->{DEBUG}{FETCH}++ ;
$ss->{DEBUG}{FETCH_VALUE}++ ;

#~ print "@ss{'A', 'B', 'C', 'D'}\n" ;
#~ print DumpTree([@ss{'A', 'B', 'C', 'D'}], "Slice:") ;
print "@ss{'A', 'B', 'C', 'D'}\n" ;
print DumpTree([@ss{'A', 'B', 'C', 'D'}], "Slice:") ;

#~ print $ss->Dump(undef, 1) ;
print $ss->DumpTable() ;

#~ print "NAME!B1 offset(1, 2) = " . $ss->OffsetAddress('C' ,1 ,2) ."\n" ;
#~ print "NAME!B1:B2 offset(1, 2) = " . $ss->OffsetAddress('D' ,1 ,2) ."\n" ;
#~ print "NAME!B1:B2 offset(1, 2) = " . $ss->OffsetAddress('NAME!B1:B2' ,1 ,2) ."\n" ;
#~ print "NAME![B]1:B[2] offset(1, 2) = " . $ss->OffsetAddress('NAME![B]1:B[2]' ,1 ,2) ."\n" ;
print "NAME!B1 offset(1, 2) = " . $ss->OffsetAddress('C' ,1 ,2) ."\n" ;
print "NAME!B1:B2 offset(1, 2) = " . $ss->OffsetAddress('D' ,1 ,2) ."\n" ;
print "NAME!B1:B2 offset(1, 2) = " . $ss->OffsetAddress('NAME!B1:B2' ,1 ,2) ."\n" ;
print "NAME![B]1:B[2] offset(1, 2) = " . $ss->OffsetAddress('NAME![B]1:B[2]' ,1 ,2) ."\n" ;

#~ my ($a_address) = $ss->CanonizeAddress('A') ;
#~ my ($b_address) = $ss->CanonizeAddress('B') ;
my $a_address = $ss->CanonizeAddress('A') ;
my $b_address = $ss->CanonizeAddress('B') ;

#~ print "offset between $a_address and $b_address: " . join(', ', $ss->GetCellsOffset('A', 'B')) . "\n" ;
print "offset between $a_address and $b_address: " . join(', ', $ss->GetCellsOffset('A', 'B')) . "\n" ;
28 changes: 28 additions & 0 deletions examples/address_offset_within_range.pl
View file
@@ -0,0 +1,28 @@

use Carp ;
use strict ;
use warnings ;

use Spreadsheet::Perl ;

my $ss = tie my %ss, "Spreadsheet::Perl" ;

for
(
['A1:B3', 1, 1, 'A2:B3']
)
{
my $offset_cell = $ss->OffsetAddress(@$_) ;
my $offset_string = "Can't compute!" ;

if(defined $offset_cell)
{
$offset_string = join ", ", $ss->GetCellsOffset($_->[0], $offset_cell) ;
}
else
{
$offset_cell = "Can't offset!" ;
}

print '' . (join(", ", @$_)) . " => " . $offset_cell . " offset: " . $offset_string . "\n" ;
}
43 changes: 43 additions & 0 deletions examples/address_within_range.pl
View file
@@ -0,0 +1,43 @@

use Carp ;
use strict ;
use warnings ;

use Spreadsheet::Perl ;

my $ss = tie my %ss, "Spreadsheet::Perl" ;
$ss->SetNames("FIRST_RANGE", "A1:A2") ;

for
(
['A1', 'A1:A1', 1]
, ['Z9', 'Z9:Z9', 1]
, ['ZZ1', 'ZZ1:ZZ1', 1]
, ['AAA1', 'AAA1:AAA1', 1]
, ['B2', 'B2:D5', 1]
, ['D2', 'B2:D5', 1]
, ['B5', 'B2:D5', 1]
, ['D5', 'B2:D5', 1]
, ['C3', 'B2:D5', 1]

, ['A1', 'B2:D5', 0]
, ['C1', 'B2:D5', 0]
, ['E1', 'B2:D5', 0]
, ['A3', 'B2:D5', 0]
, ['E3', 'B2:D5', 0]
, ['A6', 'B2:D5', 0]
, ['C6', 'B2:D5', 0]
, ['E6', 'B2:D5', 0]

, ['A1', 'FIRST_RANGE', 1]
, ['E6', 'FIRST_RANGE', 0]

)
{
my ($cell, $range, $expected) = @{$_} ;

printf "$cell within range $range: %d => expected $expected\n",
$ss->is_within_range($cell, $range) ;
}


0 comments on commit 67ee4d9

Please sign in to comment.