view release on metacpan or  search on metacpan

lib/AnyData.pm  view on Meta::CPAN

    die "No table defined" unless $table;
    my $ad = tied(%$table)->{ad};
    my @cols = @{ $ad->col_names };
    print "<",join(":", @cols), ">\n";
    while (my $row = each %$table) {
        my @row  = map {defined $row->{$_} ? $row->{$_} : ''} @cols;
        for (@row) { print "[$_]"; }
        print  "\n";
    }
}

sub adRows {
    my $thash = shift;
    my %keys  = @_;
    my $obj   = tied(%$thash);
    return $obj->adRows(\%keys);
}
sub adColumn {
    my $thash  = shift;
    my $column = shift;
    my $flags = shift;
    my $obj    = tied(%$thash);
    return $obj->adColumn($column, $flags);
}
sub adArray {
    my($format,$data)=@_;
    my $t = adTie( $format, $data );
    my $t1 = tied(%$t);
    my $ad = $t1->{ad};
    my $arrayref = $ad->{storage}->{records};
    unshift @$arrayref, $ad->{storage}->{col_names};
    return $arrayref;
}
##################################################################
# END OF TIEDHASH STUFF
##################################################################
sub parser_type {
    my $type = ref shift->{parser};
    $type =~ s/AnyData::Format::(.*)/$1/;
    return $type;
}
sub zpack {
    my $self = shift;
    return if $self->{storage}->{no_pack};
    return if (ref $self->{storage} ) !~ /File$/;

#    return unless $self->{needs_packing};
#    $self->{needs_packing} = 0;
    return unless scalar(keys %{ $self->{storage}->{deleted} } );
    $self->{needs_packing} = 0;
    #    my @callA = caller 2;
    #    my @callB = caller 3;
    #    return if $callA[3] =~ /DBD/;
    #    return if $callB[3] and $callB[3] =~ /SQL::Statement/;
    #    return if $self->{parser}->{export_on_close};
    #print "PACKING";
    my $bak_file = $self->{storage}->get_file_name . '.bak';
    my $bak = adTable( 'Text', $bak_file, 'o' );
    my $bak_fh = $bak->{storage}->get_file_handle;
    my $fh     = $self->{storage}->get_file_handle;
    die "Can't pack to backup $!" unless $fh and $bak_fh;
    # $self->seek_first_record;
    $fh->seek(0,0) || die $!;
    #$bak_fh->seek(0,0) || die $!;
#    while (my $line = $self->get_record) {
#        next if $self->is_deleted($line);
    while (my $line = $self->get_undeleted_record) {
        my $tmpstr = $bak->{parser}->write_fields($line)
                   . $self->{parser}->{record_sep};
        $bak_fh->write($tmpstr,length $tmpstr);
    }
    $fh->seek(0,0);
    $fh->truncate(0) || die $!;
    $bak->seek_first_record;
    while (<$bak_fh>) {
        $fh->write($_,length $_);
    }
    $fh->close;
    $bak_fh->close;
    $self->{doing_pack} = 0;
    undef $self->{storage}->{deleted};
}

##########################################################
#  FUNCTION CALL INTERFACE
##########################################################
sub adTie {
    my($format,$file,$read_mode,$flags)=@_;
    my $data;
    if (ref $file eq 'ARRAY' && !$read_mode ) { $read_mode = 'u'; }
    # ARRAY only {data=>[]};
    if (scalar @_ == 1){
        $read_mode = 'o';
        tie %$data,
            'AnyData::Storage::TiedHash',
            adTable($format),
            $read_mode;
        return $data;
    }
    tie %$data,
        'AnyData::Storage::TiedHash',
        adTable($format,$file,$read_mode,undef,$flags),
        $read_mode;
    return $data;
}
sub adErr {
    my $hash = shift;
    my $t = tied(%$hash);
    my $errstr = $t->{ad}->{parser}->{errstr}
        || $t->{ad}->{storage}->{errstr};
    print $errstr if $errstr;
    return $errstr;
}
sub adExport {
    my $tiedhash  = shift;
    my($tformat,$tfile,$tflags)=@_;
    my $ad = tied(%$tiedhash)->{ad};
    my $sformat = ref $ad->{parser};
    $sformat =~ s/AnyData::Format:://;
    $tformat ||= $sformat;
    if ($tformat eq $sformat and $tformat eq 'XML') {