arthurg has asked for the wisdom of the Perl Monks concerning the following question:
CTable is a nifty Perl module that manipulates tables. It loads tables from files, operates on them in memory and then, if desired, saves them to disk.
It has a cool method calc that operates on each row of a table. calc works as follows (excerpted from CTable documentation):
## Calculate a new field's values based on two others $t->calc($Sub) ## Run $Sub for each row, with ## fields bound to local vars $t->calc($Sub, $Sel) ## Use these row nums $t->calc($Sub, undef, $Fields) ## Use only these fields my $Col = $t->calc($Sub) ## Gather return vals in vector o o o ## Example 2: Create empty column; fill fields 1 by 1 $t->col('PersonID'); $t->calc(sub{no strict 'vars'; $PersonID = "$Last$First"});
calc creates a variable for each column name (field) into main. However, it doesn't save and restore them. Here's the code, from the CTable download:
sub calc { ## We operate in package main for this subroutine so the local ## object and row number can be available to the caller's $Sub. ## The following local vars will be available to $Sub ## $_r ($main::_r) -- the row number in the entire table ## $_s ($main::_s) -- the row number in selection or $Recs ## $_t ($main::_t) -- the table object itself package main; use vars qw($_r $_s $_t); local ($_r, $_s, $_t); $_t = shift; my ($Sub, $Recs, $Fields) = @_; ## These optional params default to current field and current sel $Recs ||= $_t->selection(); $Fields ||= $_t->fieldlist_all(); ## Local copy of symbol table. Didn't seem to help. Odd. ## local %main::; ## We'll build a column of return values from $Sub if needed. my $WantVals = defined(wantarray); my $Vals = $_t->col_empty() if $WantVals; ## Call col() on each field in list to make sure it exists. foreach (@$Fields) {$_t->col($_)}; foreach $_s (0..$#$Recs) { $_r = $Recs->[$_s]; ## Bind $FieldName1, $FieldName2, (etc. for each field name in ## $Fields) point to address of the current value for that ## field in this record. no strict 'refs'; foreach my $F (@$Fields) {*{$F} = \ $_t->{$F}->[$_r]}; ## Now $Sub may refer to $_r, $_s, $_t, and ${any field name} ## Call $Sub and capture return values iff caller wants them ($WantVals ? $Vals->[$_r] = &$Sub() : &$Sub()); } ## Return scalar column ref unless return context is undef return($WantVals ? $Vals : ()); }
I want to save the values of the fields in @$Fields to a buffer before looping over the records, and then restore them after. But there's some confusing aliasing, so that restoring the buffer changes the values of fields in the last row of the table in this attempt:
## Don't overwrite fields in package main. my @saveFields; no strict 'refs'; package main; foreach my $F (@$Fields) { push @saveFields, ${$F}; } foreach $_s (0..$#$Recs) { $_r = $Recs->[$_s]; ## Bind $FieldName1, $FieldName2, (etc. for each field name in ## $Fields) point to address of the current value for that ## field in this record. no strict 'refs'; foreach my $F (@$Fields) {*{$F} = \ $_t->{$F}->[$_r]}; ## Now $Sub may refer to $_r, $_s, $_t, and ${any field name} ## Call $Sub and capture return values iff caller wants them ($WantVals ? $Vals->[$_r] = &$Sub() : &$Sub()); } ## Restore fields in main no strict 'refs'; package main; foreach my $F (@$Fields) { ${$F} = shift @saveFields; };
What's the right way to save and restore the values in package main? I attach test code.
Regards#!/usr/bin/perl ## Unit testing script for the Data::CTable module # Before `make install' is performed this script should be runnable wi +th # `make test'. After `make install' it should work as `perl test.pl' use strict; use Test; BEGIN { plan tests => 30, todo => [] } use Data::CTable; use Data::CTable::Script; use Data::CTable::Listing; use Data::CTable::ProgressLogger; ## Suppress automatic built-in progress during testing in order to ## acheive nice unobscured testing output when all goes well. ## (Will still test the progress() features directly with specific ## subclasses that gather the messages into memory instead of printing ## them out.) Data::CTable->progress_class(0); ## Note whether we're on Unix... my $OnUnix = ((-d "/") && (-d "/tmp")); ## Figure out some platform-specific path details... my ($Sep, $Up, $Cur) = @{Data::CTable->path_info()}{qw(sep up cur)}; my $TestDir = "test$Sep"; ## "test/" ## First test is to read a file that we'll make use of in many of the ## other tests. my $People1 = Data::CTable->new("${TestDir}people.tabs.txt") and ok(1) + or die; ## Now for tests 2..onward, run unit-tests of specific feature ## groups... ok(test_calc()); ## Calc method ok(test_calc_restore_main_vars()); ## check that calc restores Main va +rs 1; sub test_calc { my $People2 = Data::CTable->new("${TestDir}people.tabs.txt") or di +e; package FooBar; no strict 'vars'; package main; $People2->calc(sub{$First = "\U$First\E/@{[$_t->length()]}/$_r/$_s +"}); return(0) unless ("@{$People2->col('First')}" eq "CHRIS/3/0/0 MARCO/3/1/1 PEARL/3/2/2"); return(1); } sub test_calc_restore_main_vars { my $People2 = Data::CTable->new("${TestDir}people.tabs.txt") or di +e; no strict 'vars'; package main; # make sure that calc doesn't overwrite fields in Main # especially important when calc is called repeatedly on tables wi +th intersecting field names $First = 'TEST'; $People2->calc(sub{$Last}); package main; return(0) if ( $First ne 'TEST' ); return(1); }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Symbol table manipulation problem
by ig (Vicar) on May 31, 2011 at 17:30 UTC |