view release on metacpan or  search on metacpan

lib/AnyData.pm  view on Meta::CPAN

            local *D;
            opendir(D,$format_dir);
            @formats = grep {/\.pm$/} readdir(D);
            last;
        }
    }
    unshift @formats,'ARRAY';
    @formats = map {s/^(.*)\.pm$/$1/;$_} @formats;
    return @formats;
}

sub export {
    my $self=shift;
    my $fh   = $self->{storage}->{fh};
    my $mode = $self->{storage}->{open_mode} || 'r';
#    if ( $self->{parser}->{export_on_close}
#      && $self->{storage}->{fh}
#      && $mode ne 'r'
#     ){
      return $self->{parser}->export( $self->{storage}, @_ );
#    }
}
sub DESTROY {
    my $self=shift;
#    $self->export;
    $self->zpack;
    #print "AD DESTROYED ";
}
##########################################
# DBD STUFF
##########################################
# required only for DBD-AnyData
##########################################
sub prep_dbd_table {
    my $self       = shift;
    my $tname      = shift;
    my $createMode = shift;
    my $col_names;
    my $col_nums;
    my $first_row_pos;
    if (!$createMode) {
        $col_names     = $self->{storage}->get_col_names($self->{parser});
        $col_nums      = $self->{storage}->set_col_nums();
        $first_row_pos = $self->{storage}->{first_row_pos};
    }
    die "ERROR: No Column Names!:", $self->{storage}->{open_mode}
     if (!$col_names || !scalar @$col_names) 
     && 'ru' =~ $self->{storage}->{open_mode}
     && !$createMode eq 'o';
    my $table = {
        NAME          => $tname,
        DATA          => [],
        CURRENT_ROW   => 0,
        col_names     => $col_names,
        col_nums      => $col_nums,
        first_row_pos => $first_row_pos,
        fh            => $self->{storage}->get_file_handle,
        file          => $self->{storage}->get_file_name,
        ad            => $self,
    };
    #use Data::Dumper; print Dumper $table;
    return $table;
}
sub fetch_row   {
    my $self   = shift;
    my $requested_cols = shift || [];
    my $rec;
    if ( $self->{parser}->{skip_pattern} ) {
        my $found;
        while (!$found) {
            $rec = $self->{storage}->file2str($self->{parser},$requested_cols);
            last if !defined $rec;
            next if $rec =~ $self->{parser}->{skip_pattern};
            last;
	}
    }
    else {
        $rec = $self->{storage}->file2str($self->{parser},$requested_cols);
    }
    return $rec if ref $rec eq 'ARRAY';
    return unless $rec;
    my @fields = $self->{parser}->read_fields($rec);
    return undef if scalar @fields == 1 and !defined $fields[0];
    return \@fields;
}
sub fetch_rowNEW   {
    my $self   = shift;
    my $requested_cols = shift || [];
    my $rec    = $self->{storage}->file2str($self->{parser},$requested_cols);
    my @fields;
    if (ref $rec eq 'ARRAY') {
        @fields = @$rec;
    } 
    else {
        return unless defined $rec;
        my @fields = $self->{parser}->read_fields($rec);
        return undef if scalar @fields == 1 and !defined $fields[0];
    }
    if ( my $subs = $self->{parser}->{read_sub} ) {
        for (@$subs) {
            my($col,$sub) =  @$_;
            next unless defined $col;
            my $col_num = $self->{storage}->{col_nums}->{$col};
            next unless defined $col_num;
            $fields[$col_num] = &$sub($fields[$col_num]);
	}
      }
    return \@fields;
}
sub push_names {
    my $self = shift;
    my $col_names = shift || undef;
    #print "Can't find column names!" unless scalar @$col_names;
    $self->{storage}->print_col_names( $self->{parser}, $col_names )
         unless $self->{parser}->{col_names} && $self->parser_type ne 'XML';
    #    $self->set_col_nums;
    $self->{parser}->{key} ||= $col_names->[0];
    #use Data::Dumper; print Dumper $self; exit;
}
sub drop           { shift->{storage}->drop(@_); }
sub truncate       { shift->{storage}->truncate(@_) }

##################################################################
# END OF DBD STUFF
##################################################################

##################################################################
# REQUIRED BY BOTH DBD AND TIEDHASH
##################################################################
sub push_row {
    my $self = shift;
    die "ERROR: No Column Names!" unless scalar @{$self->col_names};
    my $requested_cols = [];
    my @row = @_;
    if (ref($row[0]) eq 'ARRAY') {
        $requested_cols = shift @row;
    }
    my $rec = $self->{parser}->write_fields(@row) or return undef;
    return $self->{storage}->push_row( $rec, $self->{parser}, $requested_cols);
}
sub push_rowNEW {
    my $self = shift;
    #print "PUSHING... ";
    die "ERROR: No Column Names!" unless scalar @{$self->col_names};
    my $requested_cols = [];
    my @row = @_;
    use Data::Dumper;
    #print "PUSHING ", Dumper \@row;
    if (ref($row[0]) eq 'ARRAY') {
        $requested_cols = shift @row;
    }
    my $rec = $self->{parser}->write_fields(@row) or return undef;
    return $self->{storage}->push_row( $rec, $self->{parser}, $requested_cols);
}
sub seek              { shift->{storage}->seek(@_); }
sub seek_first_record { 
    my $self=shift;
    $self->{storage}->seek_first_record($self->{parser});
}
sub col_names    {
    my $self = shift;
    my $c = $self->{storage}->{col_names};
    $c = $self->{parser}->{col_names} unless (ref $c eq 'ARRAY') and scalar @$c;
    $c ||= [];
}
sub is_url {
    my $file = shift;
    return $file if $file and $file =~ m"^http://|ftp://";
}

sub adTable {
    ###########################################################
    # Patch from Wes Hardaker
    ###########################################################
    # my($formatref,$file,$read_mode,$lockMode,$othflags)=@_;
    my($formatref,$file,$read_mode,$lockMode,$othflags,$tname)=@_;
    ###########################################################
    #use Data::Dumper; print Dumper \@_;
    my($format,$flags);
    $file ||= '';
    my $url = is_url($file);
    $flags = {};
    $othflags ||= {};
    if ( ref $formatref eq 'HASH' or $othflags->{data}) {
        $format = 'Base';
	$flags = $othflags;
        if (ref $formatref eq 'HASH') {
            %$flags  = (%$formatref,%$othflags);
	} 
   } 
   else {
      ($format,$flags) = split_params($formatref);
      $othflags ||= {};
      %$flags = (%$flags,%$othflags);
    }
    if ( $flags->{cols} ) {
        $flags->{col_names} = $flags->{cols};
        delete $flags->{cols};
    }
    if (ref($file) eq 'ARRAY') {
      if ($format eq 'Mp3' or $format eq 'FileSys') {
	 $flags->{dirs} = $file;
      } 
      else {
         $flags->{recs} = join '',@$file;
         $flags->{recs} = $file if $format =~ /ARRAY/i;
         $flags->{storage} = 'RAM' unless $format eq 'XML';
         $read_mode = 'u';
      }
    }
    else {
        $flags->{file} = $file;
    }
    if ($format ne 'XML' and ($format eq 'Base' or $url) ) {
        my $x;
        $flags->{storage} = 'RAM';
        delete $flags->{recs};
        my $ad = AnyData->new( $format, $flags);
        $format eq 'Base'
            ? $ad->open_table( $file )
            : $ad->open_table( $file,  'r',
                               $ad->{storage}->get_remote_data($file)
                             );
        return $ad;
    }
    my $ad = AnyData->new( $format, $flags);
    my $createMode = 0;
    $createMode = $read_mode if defined $lockMode;
    $read_mode   = 'c' if $createMode  and $lockMode;
    $read_mode   = 'u' if !$createMode and $lockMode;
    $read_mode ||= 'r';
    $ad->{parser}->{keep_first_line} = 1 
         if $flags->{col_names} and 'ru' =~ /$read_mode/;
    #####################################################
    # Patch from Wes Hardaker
    #####################################################
    # $ad->open_table( $file, $read_mode );
##    $ad->open_table( $file, $read_mode, $tname );
    $ad->open_table( $file, $read_mode, $tname );
#    use Data::Dumper; my $x = $ad; delete $x->{parser}->{twig}; delete $x->{parser}->{record_tag}; delete $x->{parser}->{current_element}; print Dumper $x;
    #####################################################
    return $ad;
}

sub open_table     {
    my $self = shift;
    $self->{storage}->open_table( $self->{parser}, @_ );
    my $col_names = $self->col_names();
    $self->{parser}->{key} ||= '';
    $self->{parser}->{key} ||= $col_names->[0] if $col_names->[0];
}
##################################################################


##################################################################
# TIEDHASH STUFF
##################################################################
sub key_col          { shift->{parser}->{key} }

sub fetchrow_hashref {
    my $self = shift;
    my $rec = $self->get_undeleted_record or return undef;
    my  @fields = ref $rec eq 'ARRAY'
            ? @$rec
            : $self->{parser}->read_fields($rec);
    my $col_names = $self->col_names();
    return undef unless scalar @fields;
    return undef if scalar @fields == 1 and !defined $fields[0];
    my $rowhash;
    @{$rowhash}{@$col_names} = @fields;
    return ( $rowhash );
}
sub get_undeleted_record {
    my $self = shift;
    my $rec;
    my $found=0;
    return $self->fetch_row if $self->parser_type eq 'XML';
    while (!$found) {
        my $test = $rec    = $self->{storage}->file2str($self->{parser});
        return  if !defined $rec;
        next if $self->{storage}->is_deleted($self->{parser});
        next if $self->{parser}->{skip_pattern} 
            and $rec =~ $self->{parser}->{skip_pattern};
        last;
    }
    return $rec;
#    return $rec if ref $rec eq 'ARRAY';
#    return unless $rec;
#    my @fields = $self->{parser}->read_fields($rec);
#    return undef if scalar @fields == 1 and !defined $fields[0];
#    return \@fields;
}
sub update_single_row {
    my $self     = shift;
    my $oldrow   = shift;
    my $newvals  = shift;
    my @colnames = @{ $self->col_names };
    my @newrow;
    my $requested_cols = [];
    for my $i(0..$#colnames) {

lib/AnyData.pm  view on Meta::CPAN

#           }
#	}
#        unshift @$data, \@cols;
#        return $target_ad->{parser}->export($data,$target_file_name);
#  }

sub str2ary {
    my($ad,$row) = @_;
    return @$row if ref $row eq 'ARRAY';
    return $ad->{parser}->read_fields($row);
}
sub ad_string {
    my($formatref,@fields) = @_;
    my($format,$flags) = split_params($formatref);
# &dump($formatref); print "<$format>"; &dump($flags) if $flags;
    #$formatref =~ s/(.*)/$1/;
    my $ad = AnyData->new( $format, $flags );
    return $ad->{parser}->write_fields(@fields);
#    return $ad->write_fields(@fields);
}

sub ad_fields {
    my($formatref,$str,$flags) = @_;
#    my($format,$flags) = split_params($formatref);
#    my $ad = AnyData::new( $format, $flags );
    my $ad = AnyData->new( $formatref, $flags );
    return $ad->{parser}->read_fields($str);
}

sub ad_convert_str {
    my($source_formatref,$target_formatref,$str) = @_;
    my($source_format,$source_flags) = split_params($source_formatref);
    my($target_format,$target_flags) = split_params($target_formatref);
    my $source_ad = AnyData->new( $source_format,$source_flags);
    my $target_ad = AnyData->new( $target_format,$target_flags);
    my @fields = $source_ad->read_fields($str);
    return $target_ad->write_fields( @fields );
}

#########################################################
# UTILITY METHODS
#########################################################
#
# For all methods that have $format as a parameter,
# $format can be either a string name of a format e.g. 'CSV'
# or a hashref of the format and flags for that format e.g.
# { format => 'FixedWidth', pattern=>'A1 A3 A2' }
#
# given this parameter, this method returns $format and $flags
# setting $flags to {} if none are given
#
sub split_params {
    my $source_formatref = shift;
    my $source_flags = {};
    my $source_format  = $source_formatref;
    if (ref $source_formatref eq 'HASH') {
      while (my($k,$v)=each %$source_formatref) {
           ($source_format,$source_flags) = ($k,$v);
      }
    }
    #use Data::Dumper;
    return( $source_format, $source_flags);
}
sub dump {
    my $var = shift;
    my $name = ref($var);
    #use Data::Dumper;
    $Data::Dumper::Indent = 1;
    $Data::Dumper::Useqq  = 0;
    print Data::Dumper->new([$var],[$name])->Dump();
}

###########################################################################
# START OF DOCUMENTATION
###########################################################################

=pod

=head1 NAME

AnyData - (DEPRECATED) easy access to data in many formats

=head1 SYNOPSIS

 use AnyData;
 my $table = adTie( 'CSV','my_db.csv','o',            # create a table
                 {col_names=>'name,country,sex'}
               );
 $table->{Sue} = {country=>'de',sex=>'f'};         # insert a row
 delete $table->{Tom};                             # delete a single row
 $str  = $table->{Sue}->{country};                 # select a single value
 while ( my $row = each %$table ) {                # loop through table
   print $row->{name} if $row->{sex} eq 'f';
 }
 $rows = $table->{{age=>'> 25'}};                  # select multiple rows
 delete $table->{{country=>qr/us|mx|ca/}};         # delete multiple rows
 $table->{{country=>'Nz'}}={country=>'nz'};        # update multiple rows
 my $num = adRows( $table, age=>'< 25' );          # count matching rows
 my @names = adNames( $table );                    # get column names
 my @cars = adColumn( $table, 'cars' );            # group a column
 my @formats = adFormats();                        # list available parsers
 adExport( $table, $format, $file, $flags );       # save in specified format
 print adExport( $table, $format, $flags );        # print to screen in format
 print adDump($table);                             # dump table to screen
 undef $table;                                     # close the table

 #adConvert( $format1, $file1, $format2, $file2 );  # convert btwn formats
 #print adConvert( $format1, $file1, $format2 );    # convert to screen

=head1 DESCRIPTION

The rather wacky idea behind this module and its sister module
DBD::AnyData is that any data, regardless of source or format should
be accessible and modifiable with the same simple set of methods.
This module provides a multidimensional tied hash interface to data
in a dozen different formats. The DBD::AnyData module adds a DBI/SQL
interface for those same formats.

Both modules provide built-in protections including appropriate
flocking() for all I/O and (in most cases) record-at-a-time access to
files rather than slurping of entire files.

Currently supported formats include general format flat files (CSV,
Fixed Length, etc.), specific formats (passwd files, httpd logs,
etc.), and a variety of other kinds of formats (XML, Mp3, HTML
tables).  The number of supported formats will continue to grow
rapidly since there is an open API making it easy for any author to
create additional format parsers which can be plugged in to AnyData
itself and thereby be accessible by either the tiedhash or DBI/SQL
interface.