This time, with feeling ... here's the attachments.
--
Jeff
#########################################################
package AnyData::Format::Hash;
#########################################################
# copyright (c) 2000, Jeff Zucker <[EMAIL PROTECTED]>
# all rights reserved
#########################################################
=head1 NAME
AnyData::Format::Hash - easy tiedhash or DBI/SQL access to hashes
=head1 SYNOPSIS
use AnyData;
my $table = adHash( 'Ini', $filename,'r',$flags );
while (my $row = each %$table) {
print $row->{name},"\n" if $row->{country} =~ /us|mx|ca/;
}
# ... other tied hash operations
OR
use DBI
my $dbh = DBI->connect('dbi:AnyData:');
$dbh->func('table1','Init', $filename,$flags,'ad_catalog');
my $hits = $dbh->selectall_arrayref( qq{
SELECT name FROM table1 WHERE country = 'us'
});
# ... other DBI/SQL operations
=head1 DESCRIPTION
Please refer to the documentation for AnyData.pm and DBD::AnyData.pm
for further details.
=head1 AUTHOR & COPYRIGHT
copyright 2000, Jeff Zucker <[EMAIL PROTECTED]>
all rights reserved
=cut
use AnyData::Format::Base;
use strict;
use vars qw/@ISA $VERSION/;
@ISA = qw(AnyData::Format::Base);
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Useqq = 0;
$VERSION = '0.06';
sub new {
my $class = shift;
my $self = shift || {};
$self->{has_export_method} = 1;
$self->{export_on_close} = 1;
$self->{comment} ||= '^#';
$self->{slurp_mode} = 1;
return bless $self, $class;
}
sub storage_type {'RAM'}
#sub get_data { return import(@_) }
#sub init_parser{};
#sub read_fields{};
sub import {
my $self = shift;
my $data = shift;
my $storage = shift;
return $self->get_data($data,$self->{col_names});
}
sub get_data {
my $self = shift;
my $str = shift;
if ($str and ref $str eq 'ARRAY') {
# $str = join '', @$str;
}
my $full_table;
my $table;
if (ref $str eq 'HASH') {
while (my($k,$v)=each %$str) {
push @$full_table,$v;
}
}
elsif ( ref $str eq 'ARRAY') {
for my $v1(@$str) {
push @$full_table,$v1;
}
}
else {
# if ($str =~ /^([EMAIL PROTECTED])$/) {
if ($str =~ /(.+)/s) {
$str = $1; # $str now untainted :-(
}
use mylibs; zwarn $str; exit;
eval $str;
die $@ if $@;
if ($table and ref $table eq 'HASH') {
while (my($k,$v)=each %$table) {
push @$full_table,$v;
}
}
else {
$full_table = $table;
}
#print Dumper $table;
}
$table = $full_table;
#use mylibs; zwarn $table;
# my @col_names = split ',', shift @$table;
my @col_names = ();
my %is_col;
my @new_table;
for my $hash_ref(@$table) {
for my $col(keys %$hash_ref) {
if (!$is_col{$col}++) {
push @col_names,$col;
}
}
my @row;
for my $col(@col_names) {
my $value = defined $hash_ref->{$col}
? $hash_ref->{$col}
: undef;
push @row, $value;
}
push @new_table,[EMAIL PROTECTED];
}
#zwarn [EMAIL PROTECTED]; zwarn [EMAIL PROTECTED];
return [EMAIL PROTECTED], [EMAIL PROTECTED];
}
sub export {
#print "EXPORTING!";
my $self = shift;
my $storage = shift;
my $col_names = $storage->{col_names};
my $table = $storage->{records};
my $fh = $storage->{fh};
my $newtable;
for my $row(@$table) {
my $rowhash;
@[EMAIL PROTECTED] = @$row;
for my $c(@$col_names) {
delete $rowhash->{$c} unless defined $rowhash->{$c};
}
#$newtable->{$rowhash->{table}} = $rowhash;
push @$newtable, $rowhash;
}
=pod
if (my $default = $newtable->{schema_defaults}) {
while (my($k,$v)=each %$newtable) {
next if $k eq 'schema_defaults';
for my $c(@$col_names) {
next unless $newtable->{$k}->{$c}
and $default->{$c}
and $newtable->{$k}->{$c} eq $default->{$c};
delete $newtable->{$k}->{$c};
}
}
}
=cut
$table = Dumper $newtable;
$table =~ s/^\$VAR1/\$table/;
$table =~ s/^\$ARRAY/\$table/;
return $table unless $fh;
return $fh->print( $table );
}
#########################################################
package AnyData::Format::ComplexIni;
#########################################################
# copyright (c) 2000, Jeff Zucker <[EMAIL PROTECTED]>
# all rights reserved
#########################################################
=head1 NAME
AnyData::Format::Ini - easy tiedhash or DBI/SQL access to ini files
=head1 SYNOPSIS
use AnyData;
my $table = adHash( 'Ini', $filename,'r',$flags );
while (my $row = each %$table) {
print $row->{name},"\n" if $row->{country} =~ /us|mx|ca/;
}
# ... other tied hash operations
OR
use DBI
my $dbh = DBI->connect('dbi:AnyData:');
$dbh->func('table1','Init', $filename,$flags,'ad_catalog');
my $hits = $dbh->selectall_arrayref( qq{
SELECT name FROM table1 WHERE country = 'us'
});
# ... other DBI/SQL operations
=head1 DESCRIPTION
This is a parser for Ini files including simple formats like:
ext = .jpg
dir = /foo
as well as more complex formats like
[photoslop]
ext = .jpg
dir = /pics
[musicmatch]
ext = .mp3
dir = /sounds
It also supports the use of comments (marked by default with a semicolon, but settable
by the user.
Please refer to the documentation for AnyData.pm and DBD::AnyData.pm
for further details.
=head1 AUTHOR & COPYRIGHT
copyright 2000, Jeff Zucker <[EMAIL PROTECTED]>
all rights reserved
=cut
use AnyData::Format::Base;
use strict;
use vars qw/@ISA $VERSION/;
@ISA = qw(AnyData::Format::Base);
use Data::Dumper;
$VERSION = '0.01';
sub new {
my $class = shift;
my $self = shift || {};
$self->{has_export_method} = 1;
$self->{export_on_close} = 1;
$self->{comment} ||= ';';
$self->{comment_sep} ||= '~';
$self->{slurp_mode} = 1;
return bless $self, $class;
}
sub storage_type { 'RAM'; }
sub get_data { return import(@_) }
sub import {
my $self = shift;
my $str = shift;
if (ref $str eq 'ARRAY') {
$str = $str->[0];
}
my $has_class = 1 if $str =~ /^\[.+\]\s*$/sm;
my(%row,$class,@table,%is_col,@cols);
my $eol = $self->{eol};
if (!$has_class) {
for (split $eol,$str) {
my($key,$value) = /^\s*([^=]+)=\s*(.*)$/;
next unless $key;
if ($key =~ /^$self->{comment}(.+)$/) {
$key = 'comment';
$value = $1;
}
push @table, [$key,$value];
}
return [EMAIL PROTECTED], ['key','value'];
}
@cols = ('key');
for (split $eol,$str) {
my($key,$value);
if (/^\[\s*(.+)\s*\]\s*$/) {
$class = $1;
next;
}
if (/^;(.+)$/) {
$key = 'comment';
$value = $1;
}
else {
($key,$value) = /^\s*([^=]+)=\s*(.*)$/;
}
next unless $key;
if ( $key =~ /^$self->{comment}(.+)$/){
$key = 'comment';
$value = $1;
}
else {
push @cols, $key if !$is_col{$key}++;
}
$row{($class||'')}{$key} .= $self->{comment_sep}
. $value if $key eq 'comment';
$row{($class||'')}{$key} = $value unless $key eq 'comment';
}
while (my($class,$line)= each %row) {
my @newrow;
push @newrow, $class;
for my $col(@cols) {
next if $col eq 'key';
push @newrow, $line->{$col};
}
push @table, [EMAIL PROTECTED];
}
return [EMAIL PROTECTED], [EMAIL PROTECTED];
}
# this requires a change to AnyData.pm
# I'll work on it later after AnyData is patched.
sub export {
my($self,$storage) = @_;
my $col_names = $storage->{col_names};
my $col_nums = $storage->{col_nums};
print "!", $col_nums->{comment};
my $table = $storage->{records};
#use Data::Dumper; print Dumper $table; print "###"; exit;
my $fh = $storage->{fh};
for my $row(@$table) {
printf "[%s]\n",$row->[0] if $row->[0];
}
}
