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"});

[download]

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 : ());
}

[download]

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; };

[download]

What's the right way to save and restore the values in package main? I attach test code.

Regards
Arthur 
#!/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);  
}

[download]

In reply to Symbol table manipulation problem by arthurg

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.