view release on metacpan or search on metacpan
lib/AnyData.pm view on Meta::CPAN
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);
lib/AnyData.pm view on Meta::CPAN
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
lib/AnyData.pm view on Meta::CPAN
}
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;
lib/AnyData.pm view on Meta::CPAN
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);
lib/AnyData.pm view on Meta::CPAN
$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];
lib/AnyData.pm view on Meta::CPAN
#
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
lib/AnyData/Format/HTMLtable.pm view on Meta::CPAN
$self->{col_names} = shift @$table if !$col_names;
return $table, $self->{col_names};
}
sub export {
#print "EXPORTING!";
my $self = shift;
my $storage = shift;
my $col_names = $storage->{col_names};
my $table = $storage->{records};
#use Data::Dumper; print Dumper $table; print "###"; exit;
my $fh = $storage->{fh};
use CGI;
my $table_flags = shift || {Border=>1,bgColor=>'white'};
my $top_row_flags = shift || {bgColor=>'#c0c0c0'};
my $data_row_flags = shift || {};
@$table = map {
my $row = $_;
@$row = map { $_ || ' ' } @$row;
$row;
} @$table;
lib/AnyData/Format/Mp3.pm view on Meta::CPAN
use AnyData::Storage::FileSys;
use AnyData::Storage::File;
use vars qw( @ISA $VERSION);
@AnyData::Format::Mp3::ISA = qw( AnyData::Format::Base );
$VERSION = '0.12';
sub new {
my $class = shift;
my $self = shift || {};
#use Data::Dumper; die Dumper $self;
my $dirs = $self->{dirs} || $self->{file_name} || $self->{recs};
$self->{col_names} = 'song,artist,album,year,genre,filename,filesize';
$self->{recs} =
$self->{records} = get_data( $dirs );
return bless $self, $class;
}
sub storage_type { 'RAM'; }
sub read_fields {
lib/AnyData/Format/Text.pm view on Meta::CPAN
use warnings;
use AnyData::Format::Base;
use AnyData::Storage::FileSys;
use vars qw( @ISA $DEBUG );
@AnyData::Format::Text::ISA = qw( AnyData::Format::Base );
$DEBUG = 0;
sub new {
my $class = shift;
my $self = shift || {};
#use Data::Dumper; die Dumper $self;
$self->{rec_sep} ||= "\n";
if ($self->{dirs}) {
$self->{storage} = 'FileSys';
$self->{col_names} = 'fullpath,path,name,ext,size,content';
$self->{records} = get_data( {},$self->{dirs} );
}
else {
$self->{col_names} = 'text';
$self->{key} = 'text';
}
lib/AnyData/Format/XML.pm view on Meta::CPAN
}
for my $col(@col_names) {
if (ref $values->{$col}) {
@row = (@row,@{$values->{$col}});
}
else {
push @row, $values->{$col};
}
}
# use Data::Dumper; print Dumper $values, Dumper \@row; exit;
return @row;
}
sub seek_first_record {
my $self = shift;
return unless $self->{twig} and $self->{twig}->root;
$self->{current_element} = $self->{record_tag};
}
sub push_names {
lib/AnyData/Format/XML.pm view on Meta::CPAN
$old->del_att('record_tag__') if $old;
#$twig->print;
#print "\n";
#$old->print if $old;
##print "\n";
# my $par = $self->create_record;
# $self->{blank_element} = $par;
#printf "\n%s\n %s\n", $elt->path, "@$col_names";
@$col_names = map {s"/#PCDATA""; $_} @$col_names;
#$twig->print; print "\n\n";
#use Data::Dumper; print Dumper $record_tag->gi,$col_names,$atts;
return $record_tag,$col_names,$atts;
}
sub check_twig_options {
my $flags = shift;
my $new_flags;
my %twig_opt = %XML::Twig::valid_option;
return $flags unless scalar (keys %twig_opt);
while (my($k,$v) = each %$flags) {
$new_flags->{$k} = $v if $twig_opt{$k};
lib/AnyData/Format/XML.pm view on Meta::CPAN
my @children = $twig->root->descendants;
for my $e(@children) {
next unless $e->path eq $record_tag_path;
$record_tag = $e;
last;
}
if (!$record_tag) {
$record_tag = $twig->root->first_child;
my $p = $record_tag->path;
@$col_names = map {$p.'/'.$_}@$col_names;
# use Data::Dumper; print Dumper $amap;
my $newmap;
$newmap->{ $p.'/'.$_ }++ for keys %{$amap};
$amap = $newmap;
$newmap = {};
$newmap->{ $p.'/'.$_ } = $map->{$_} for keys %{$map};
$map = $newmap;
}
##
#=pod
#paste into parent record_tag__
lib/AnyData/Format/XML.pm view on Meta::CPAN
#=cut
my $col_structure = {
amap => $amap,
map => $map,
multi => $multi,
col_names => $col_names,
pretty_cols => $pretty_cols,
col2tag => $col2tag,
};
# print $record_tag->path, "\n";
# use Data::Dumper; print Dumper $col_structure;
# exit;
return $record_tag, $col_structure;
}
sub get_data {
my $self = shift;
my $fh_or_str = shift;
my $url = $self->{url};
if ( $url ) {
$fh_or_str = AnyData::Storage::RAM::get_remote_data({},$url);
lib/AnyData/Format/XML.pm view on Meta::CPAN
my %amap;
$flags->{LoadDTD} = 1;
$flags->{TwigRoots} = {$root_tag=>'1'} if $root_tag;
#
# DEFAULTS : KeepEncoding OFF to mirror XML::Twig
# ProtocolEncoding 'ISO-8859-1'
#
# $flags->{KeepEncoding} ||= 1;
#
$flags->{ProtocolEncoding} ||= 'ISO-8859-1';
#use Data::Dumper; die Dumper $flags;
$flags = check_twig_options($flags);
my $twig= new XML::Twig(%{$flags});
my $success = $twig->safe_parse($fh_or_str);
$self->{errstr} = $@ unless $success;
die $self->{errstr} if $self->{errstr};
return undef unless $success;
$self->{dtd} = $twig->dtd;
my $root = $twig->first_elt($root_tag) || $twig->root;
my $name = $root->path;
lib/AnyData/Format/XML.pm view on Meta::CPAN
my $rt_atts = $record_tag->atts;
if (!$rt_atts->{record_tag__}) {
my $new_rt = $record_tag->copy;
$new_rt->set_att('record_tag__','1');
$new_rt->set_att('xstruct__','1');
$new_rt->paste('first_child',$record_tag->parent);
$record_tag = $new_rt;
}
# $twig->print;
# use Data::Dumper; print Dumper $col_structure;
# print $self->{record_tag}->path;
$self->{record_tag} = $record_tag;
$self->{twig} = $twig;
$self->{col_names} = $col_structure->{pretty_cols};
$self->{col_structure} = $col_structure;
return 1;
}
lib/AnyData/Storage/File.pm view on Meta::CPAN
for my $key(keys %table) {
$self->{$key}=$table{$key};
}
my $skip = $parser->init_parser($self);
if (!$skip && defined $newfile) {
$open_mode =~ /[co]/
? $self->print_col_names($parser)
: $self->get_col_names($parser);
}
$self->{col_nums} = $self->set_col_nums();
# use Data::Dumper; die Dumper $self;
}
sub get_file_handle { return shift->{fh} }
sub get_file_name { return shift->{file} }
sub get_file_open_mode { return shift->{open_mode} }
sub file2str { return shift->get_record(@_) }
sub get_record {
my($self,$parser)=@_;
local $/ = $parser->{record_sep} || "\n";
my $fh = $self->{fh} ;
lib/AnyData/Storage/FileSys.pm view on Meta::CPAN
package AnyData::Storage::FileSys;
use strict;
use warnings;
use File::Find;
use File::Basename;
use vars qw( @ISA @files $wanted_part $wanted_re );
use AnyData::Storage::File;
@ISA = qw( AnyData::Storage::File );
use Data::Dumper;
sub open_table {}
sub new {
my $class = shift;
my $self = shift || {};
$self->{col_names} = ['fullpath','path','name','ext','size','content' ];
bless $self, $class;
my $exts = $self->{exts};
if ($exts) {
lib/AnyData/Storage/FileSys.pm view on Meta::CPAN
my @row = ( $file_info->[0],
$file_info->[2],
$file_info->[1],
$file_info->[3],
);
push @$table, \@row;
# 'fullpath,path,name,ext,size,content';
# 'fullpath,file_name,path,ext,size,'
# 'name,artist,album,year,comment,genre';
}
#use Data::Dumper; print "!",Dumper $table; exit;
return $table;
}
sub seek_first_record {
my $self = shift;
$self->{index} = 0;
}
sub file2str {
my $self = shift;
my $curindex = $self->{index};
lib/AnyData/Storage/FileSys.pm view on Meta::CPAN
my $str = <$fh>;
undef $fh;
push @$rec, $str;
return $rec;
}
sub col_names { shift->{col_names} }
sub get_filename_parts {
my $self = shift;
my %flags;
%flags = @_ if scalar @_;
#use Data::Dumper; print "!",Dumper \%flags; exit;
$wanted_part = $flags{part} || $self->{wanted_part} || '';
$wanted_re = $flags{re} || $self->{wanted_re} || '';
my $dirs = $flags{dirs} || $self->{dirs} || [];
my $wanted_sub = $flags{sub} || \&wanted;
@files = ();
find { no_chdir => 1,
wanted => $wanted_sub,
},
@$dirs;
;
lib/AnyData/Storage/RAM.pm view on Meta::CPAN
#########################################################################
use strict;
use warnings;
use vars qw($VERSION $DEBUG);
$VERSION = '0.12';
$DEBUG = 1;
use Data::Dumper;
use AnyData::Storage::File;
sub new {
my $class = shift;
my $self = shift || {};
return bless $self, $class;
}
########
# MOVE set_col_nums and open_table to Storage/Base.pm
lib/AnyData/Storage/RAM.pm view on Meta::CPAN
# ALSO make DBD::AnyData::Statement and DBD::Table simple @ISA for AnyData
sub set_col_nums {
my $self = shift;
my $col_names = $self->{col_names};
return {} unless $col_names ;
return {} unless ref $col_names eq 'ARRAY';
return {} unless scalar @$col_names;
my $col_nums={}; my $i=0;
for (@$col_names) { next unless $_; $col_nums->{$_} = $i; $i++; }
#use Data::Dumper; die Dumper $col_names;
$self->{col_nums}=$col_nums;
return $col_nums;
}
sub open_table {
my( $self, $parser, $file, $read_mode, $data ) = @_;
$data = $self->{recs} if $self->{recs};
#$data ||= $parser->{recs};
#$data = $file if ref $file eq 'ARRAY' and !$data;
#use Data::Dumper; print Dumper $data;
#print ref $parser;
my $rec_sep = $parser->{record_sep};# || "\n";
my $table_ary = [];
my $col_names = $parser->{col_names} || $self->{col_names};
my $cols_supplied = $col_names;
my $url = $file if $file =~ m"^http://|^ftp://";
$self->{open_mode} = $read_mode || 'r';
my $data_type;
lib/AnyData/Storage/RAM.pm view on Meta::CPAN
$data = join '', @$data;
}
if ($data_type eq 'ARY-ARY') {
$table_ary = $data;
}
elsif ($data_type eq 'ARY-HSH') {
print "IMPORT OF HASHES NOT YET IMPLEMENTED!\n"; exit;
}
else {
$data =~ s/\015$//gsm; # ^M = CR from DOS
#use Data::Dumper; print Dumper $data;
my @tmp = split /$rec_sep/, $data;
#use Data::Dumper; print ref $parser, Dumper \@tmp;
if ((ref $parser) =~ /Fixed/ && (!$col_names or !scalar @$col_names)) {
my $colstr = shift @tmp;
# $colstr =~ s/\015$//g; # ^M = CR from DOS
@$col_names = split ',',$colstr;
}
if ((ref $parser) =~ /Paragraph/) {
my $colstr = shift @tmp;
@$col_names = $parser->read_fields($colstr);
#print "@$col_names";
}
for my $line( @tmp ) {
# for (split /$rec_sep/, $data) {
# s/\015$//g; # ^M = CR from DOS
next if $parser->{skip_pattern} and $line =~ $parser->{skip_pattern};
my @row = $parser->read_fields($line);
#print $_;
#use Data::Dumper; print Dumper \@row;
###z MOD
# next unless scalar @row;
# push @$table_ary, \@row;
push @$table_ary, \@row
# unless $parser->{skip_mark}
# and $row[0] eq $parser->{skip_mark};
#
}
}
if ((ref $parser) !~ /Fixed|Paragraph/
&& !$parser->{keep_first_line}
&& !$parser->{col_names}
) {
$col_names = shift @$table_ary;
}
#use Data::Dumper; die Dumper $table_ary;
}
}
# if ($file and !(ref $file eq 'ARRAY') and $file !~ m'^http://|ftp://' and !(scalar @$table_ary) ) {
if ((ref $parser) !~ /XML/ ) {
my $size = scalar @$table_ary if defined $table_ary;
if ($file and !(ref $file eq 'ARRAY') and !$size ) {
if ($file =~ m'^http://|ftp://') {
# ($table_ary,$col_names) =
# $self->get_remote_data($file,$parser);
}
lib/AnyData/Storage/RAM.pm view on Meta::CPAN
my %table = (
index => 0,
file => $file,
records => $table_ary,
col_nums => $col_nums,
col_names => \@array,
);
for my $key(keys %table) {
$self->{$key}=$table{$key};
}
#use Data::Dumper; print Dumper $self; exit;
#use Data::Dumper; print Dumper $table_ary;
#use Data::Dumper; print Dumper $self->{records} if (ref $parser) =~ /Weblog/;
}
sub close { my $s = shift; undef $s }
sub get_remote_data {
my $self = shift;
my $file = shift;
my $parser = shift;
$ENV = {} unless defined $ENV;
$^W = 0;
undef $@;
lib/AnyData/Storage/RAM.pm view on Meta::CPAN
my $self = shift;
my $file = shift;
my $parser = shift;
my $open_mode = shift || 'r';
my $adf = AnyData::Storage::File->new;
# $adf->open_table($parser,$file,'r');
my $fh = $adf->open_local_file($file,$open_mode);
#print Dumper $file,$adf; exit;
$self->{file_manager} = $adf;
$self->{fh} = $fh;
#use Data::Dumper; print Dumper $self;
# my $fh = $adf->{fh};
return([],$self->{col_names}) if 'co' =~ /$open_mode/;
# if ((ref $parser) =~ /HTML/) {
# print "[[$file]]";
# for (<$fh>) { print; }
# }
local $/ = undef;
my $str = <$fh>;
# $fh->close;
#print $str if (ref $parser) =~ /HTML/;
lib/AnyData/Storage/RAM.pm view on Meta::CPAN
####################################
sub push_row {
my($self, $fields, $parser) = @_;
if (! ref $fields) {
$fields =~ s/\012$//;
#chomp $fields;
my @rec = $parser->read_fields($fields);
$fields = \@rec;
}
#use Data::Dumper; print Dumper $fields;
my $currentRow = $self->{index};
$self->{index} = $currentRow+1;
$self->{records}->[$currentRow] = $fields;
return 1;
}
##################################
# truncate()
##################################
sub truncate {
lib/AnyData/Storage/RAM.pm view on Meta::CPAN
my @c = caller 3;
if ($c[3] =~ /DELETE/ or $c[3] =~ /UPDATE/) {
$self->delete_record($rec);
return undef if $c[3] =~ /DELETE/;
}
push @{ $self->{table} }, $rec;
# $self->{index}++;
return $rec;
}
sub delete_record{my $self=shift;use Data::Dumper; print Dumper @_}
sub close {1;}
sub seek {
my($self,$pos,$whence) = @_;
if ($pos == 0 && $whence == 0) {
$self->{index}=0;
return $self->{index};
}
if ($pos == 0 && $whence == 2) {
return $self->{index};
}
}
sub truncate {}#use Data::Dumper; print Dumper \@_;}
1;
__END__