view release on metacpan or  search on metacpan

lib/Data/PcAxis.pm  view on Meta::CPAN

    my $counts = $self->val_counts;

    my $index;
    for my $n (0..($#$selection - 1)) {
        $index += $selection->[$n] * (reduce { $a * $b } @$counts[$n+1 .. $#$counts]);
    }
    $index += @$selection[-1];

    my $res = $self->data->[$index];
    $res =~ s/^["']|["']$//g; # Strip outer quotes from returned data

    return $res;
}

sub datacol {
    # TODO: Only allow one wildcard.

    my $self = shift;
    my $selection = shift;

    my $counts = $self->val_counts;

    my $datacol;
    if ( any { $_ eq '*' } @$selection ) {
        my $grp_idx = firstidx { $_ eq '*' } @$selection;

        for my $i ( 0 .. (@$counts[$grp_idx] -1 )) {
            $selection->[$grp_idx] = $i;
            push @$datacol, $self->datum($selection);
        }
    }
    else {
        $datacol = $self->datum($selection);
    }
    return $datacol;
}

sub _build_metadata {
    my $self = shift;

    open my $fh, '<', $self->pxfile;

    # slurp all metadata into one string, removing newlines
    my $meta = '';
    while (my $line = <$fh>) {
        last if $line =~ /^DATA=/;
        my $tmp = $meta;
        $line =~ s/\R//g;

        # double up end-of-line semicolons to solve problem of semicolons appearing within fields
        $line =~ s/;$/;;/g;
        $meta = $tmp . $line;
    }

    close $fh;

    # join broken lines (e.g. TITLE="...Very Long"\n"Title")
    $meta =~ s/""/ /g;

    # split metadata string into array
    my @meta = split ';;', $meta;

    # initialise Text::CSV objects for parsing options and values
    my $csv_opt = Text::CSV->new({binary=>1}) or die Text::CSV->error_diag();
    my $csv_val = Text::CSV->new({binary=>1}) or die Text::CSV->error_diag();

    # parse metadata array into a hash
    my $metadata;
    for my $i (0..$#meta) {

        # Regex grabs key, option (optional value appearing after key in brackets, used
        # to specify values to which this metadata key refers), and values from each
        # metadata entry
        my ($key, $opt, $val) = $meta[$i] =~ /^(?<key>.+?)(?:\((?<opt>.+?)\))?=(?<val>.+)$/;

        # if entry has no 'option' value then data is specific to table
        $opt //= 'TABLE';

        # parse comma separated list of values to array
        $csv_val->parse($val);
        my @val_fields = $csv_val->fields();

        # parse comma separated list of options to array
        $csv_opt->parse($opt);
        my @opt_fields = $csv_opt->fields();

        # add array of values to appropriate key->option branch of metadata hash
        for my $field (@opt_fields) {
            if ($key ne 'VALUES') {
                $metadata->{$key}->{$field} = scalar @val_fields == 1 ? $val_fields[0] : [ @val_fields ];
            }
            else {
                # ensure that a single VALUES option still gets assigned to an array
                $metadata->{$key}->{$field} = [ @val_fields ];
            }
        }
    }
    return $metadata;
}

sub _build_data {
    my $self = shift;

    open my $fh, '<', $self->pxfile;

    my @data;
    my $dataflag = 0;
  DATAROW:
    while (my $line = <$fh>) {

        if ($line =~ /^DATA=/) {
            $dataflag = 1;
        }
        next DATAROW unless $dataflag == 1;

        chomp $line;
	$line =~ s/DATA=//;
        $line =~ s/;//;
        my @row = split /\s+/, $line;
        push @data, @row;