From f1d68e24a2f391cba13039b26ad982fa5af72644 Mon Sep 17 00:00:00 2001 From: Mateusz Paprocki Date: Sun, 18 Jan 2009 14:56:07 +0100 Subject: [PATCH] Initial version of mdx-tools.pl --- grammar.txt | 109 ++++ mdx-tools.pl | 1603 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ metadata.xml | 588 +++++++++++++++++++++ 3 files changed, 2300 insertions(+) create mode 100644 grammar.txt create mode 100755 mdx-tools.pl create mode 100755 metadata.xml diff --git a/grammar.txt b/grammar.txt new file mode 100644 index 0000000..0ffd338 --- /dev/null +++ b/grammar.txt @@ -0,0 +1,109 @@ +{ use Data::Dumper; } + +parse_mdx : toplevel_spec + +toplevel_spec : select_spec eof + { $return = $item[1] } + +select_spec : /select/i axis_spec(1..2 /,/) using_spec(?) where_spec(?) ';' + { $return = { + 'head' => 'mdx_query', + 'axes' => $item[2], + 'using' => $item[3][0], + 'slice' => $item[4][0] }} + +axis_spec : (/non empty/i)(?) mdx_elt /on/i axis_name + { $return = { + 'axis' => $item[4], + 'spec' => $item[2], + 'flag' => (defined $item[1][0]) ? 1 : 0 }} + +axis_name : /cols/i + | /rows/i + { $return = $item[1] } + +using_spec : /using/i mdx_eid + { $return = $item[2] } + +where_spec : /where/i mdx_elt + { $return = $item[2] } + +fun_literal : /[[:alpha:]][[:alnum:]]*/ + { $return = $item[1] } + +mdx_mth : mdx_eid '->' mdx_fun + { $return = { + 'head' => 'mdx_fun', + 'func' => $item[3]->{'func'}, + 'tail' => [ $item[1], @{$item[3]->{'tail'}} ] }} + | mdx_eid '->' fun_literal + { $return = { + 'head' => 'mdx_fun', + 'func' => $item[3], + 'tail' => [ $item[1] ] }} + +mdx_fun : fun_literal '(' mdx_elt(s? /,/) ')' + { $return = { + 'head' => 'mdx_fun', + 'func' => $item[1], + 'tail' => $item[3] }} + +mdx_set : mdx_eid ':' mdx_eid + { $return = { + 'head' => 'mdx_range', + 'init' => $item[1], + 'stop' => $item[3] }} + | '{' mdx_elt(s? /,/) '}' + { $return = { + 'head' => 'mdx_set', + 'tail' => $item[2] }} + +mdx_tup : '(' mdx_elt(s? /,/) ')' + { $return = { + 'head' => 'mdx_tup', + 'tail' => $item[2] }} + +eid_literal : /([[:alpha:]][[:alnum:]]*)/ + | /\[((?:\]\]|[^\]])+)\]/ + { $return = $1 } + +mdx_eid : eid_literal(s /\./) + { $return = { + 'head' => 'mdx_eid', + 'tail' => $item[1] }} + +mdx_str : /"(?:\\"|[^"])*"/ + | /'(?:\\'|[^'])*'/ + { $return = { + 'head' => 'mdx_str', + 'tail' => $item[1] }} + +mdx_elt : mdx_mth + | mdx_fun + | mdx_set + | mdx_tup + | mdx_str + | mdx_eid + { $return = $item[1] } + +index : /[\d]+/ + +eof : /^\Z/ + +#mdx_bool : +# +#(/or/i | '||') +#(/xor/i | '^^') +#(/and/i | '&&') +# +#(/not/i | '!') +# +#/empty\?/i +# +#mdx_cmp : '>=' +# | '>' +# | '<=' +# | '<' +# | '<>' +# | '=' + diff --git a/mdx-tools.pl b/mdx-tools.pl new file mode 100755 index 0000000..67c1e03 --- /dev/null +++ b/mdx-tools.pl @@ -0,0 +1,1603 @@ +#!/usr/bin/perl -w + +use strict; + +use feature ':5.10'; + +use POSIX qw(floor); + +use Parse::RecDescent; +use Term::ANSIColor; +use Term::ReadLine; +use Data::Dumper; +use Getopt::Long; +use File::Slurp; +use Time::HiRes qw(gettimeofday + tv_interval); +use XML::LibXML; +use DBI; + +use constant { + MDX_MEASURE => 1, + MDX_DIMENSION => 2, + MDX_HIERARCHY => 3, + MDX_LEVEL => 4, + MDX_MEMBER => 5, + MDX_SET => 6, + MDX_TUP => 7, + MDX_QID => 8, + MDX_STR => 9, +}; + +sub mdx_load_metadata { + my ($file) = @_; + + sub update_names { + my ($names, $name, $uid) = @_; + + if (exists $names->{$name}) { + push @{$names->{$name}}, $uid; + } else { + $names->{$name} = [ $uid ]; + } + } + + my %cache = (); + my $names = {}; + + my %listing = ( + 'measure' => [], + 'dimension' => [], + 'hierarchy' => [], + 'level' => [], + 'member' => [], + ); + + my $xml = XML::LibXML->new(); + + my $tree = $xml->parse_file($file); + my $root = $tree->getDocumentElement; + + my @m_nodes = $root->findnodes('measures/measure'); + + foreach my $m_elem (@m_nodes) { + my $m_uid = $m_elem->findvalue('uid'); + push @{$listing{'measure'}}, $m_uid; + + my $m_name = $m_elem->findvalue('name'); + update_names($names, $m_name, $m_uid); + + my %measure = ( + 'type' => MDX_MEASURE, + 'uid' => $m_uid, + 'name' => $m_name, + 'desc' => $m_elem->findvalue('desc'), + 'table' => $m_elem->findvalue('table'), + 'field' => $m_elem->findvalue('field'), + 'format' => $m_elem->findvalue('format'), + 'function' => $m_elem->findvalue('function'), + ); + + $cache{$m_uid} = \%measure; + } + + my @d_nodes = $root->findnodes('dimensions/dimension'); + + foreach my $d_elem (@d_nodes) { + my $d_uid = $d_elem->findvalue('uid'); + push @{$listing{'dimension'}}, $d_uid; + + my $d_name = $d_elem->findvalue('name'); + update_names($names, $d_name, $d_uid); + + my %dimension = ( + 'type' => MDX_DIMENSION, + 'uid' => $d_uid, + 'name' => $d_name, + 'desc' => $d_elem->findvalue('desc'), + 'table' => $d_elem->findvalue('table'), + 'primary' => $d_elem->findvalue('primary'), + 'foreign' => $d_elem->findvalue('foreign'), + 'default' => $d_elem->findvalue('default'), + 'hierarchies' => [], + ); + + my @h_nodes = $d_elem->findnodes('hierarchies/hierarchy'); + + foreach my $h_elem (@h_nodes) { + my $h_uid = $h_elem->findvalue('uid'); + push @{$listing{'hierarchy'}}, $h_uid; + + my $h_name = $h_elem->findvalue('name'); + update_names($names, $h_name, $h_uid); + + my %hierarchy = ( + 'type' => MDX_HIERARCHY, + 'uid' => $h_uid, + 'name' => $h_name, + 'desc' => $h_elem->findvalue('desc'), + 'default' => $h_elem->findvalue('default'), + 'dimension' => $d_uid, + 'levels' => [], + ); + + push @{$dimension{'hierarchies'}}, $h_uid; + + my @l_nodes = $h_elem->findnodes('levels/level'); + + foreach my $l_elem (@l_nodes) { + my $l_uid = $l_elem->findvalue('uid'); + push @{$listing{'level'}}, $l_uid; + + my $l_name = $l_elem->findvalue('name'); + update_names($names, $l_name, $l_uid); + + my $prev = $hierarchy{'levels'}[-1]; + + my %level = ( + 'type' => MDX_LEVEL, + 'uid' => $l_uid, + 'name' => $l_name, + 'desc' => $l_elem->findvalue('desc'), + 'field' => $l_elem->findvalue('field'), + 'dtype' => $l_elem->findvalue('dtype'), + 'default' => $l_elem->findvalue('default'), + 'hierarchy' => $h_uid, + 'prevlevel' => $prev, + 'nextlevel' => undef, + 'members' => [], + ); + + push @{$hierarchy{'levels'}}, $l_uid; + + if (defined $prev) { + $cache{$prev}{'nextlevel'} = $l_uid; + } + + my @m_nodes = $l_elem->findnodes('members/member'); + + foreach my $m_elem (@m_nodes) { + my $m_uid = $m_elem->findvalue('uid'); + push @{$listing{'member'}}, $m_uid; + + my $m_name = $m_elem->findvalue('name'); + update_names($names, $m_name, $m_uid); + + my $prev = $level{'members'}[-1]; + + my %member = ( + 'type' => MDX_MEMBER, + 'uid' => $m_uid, + 'name' => $m_name, + 'item' => $m_elem->findvalue('item'), + 'level' => $l_uid, + 'hierarchy' => $h_uid, + 'dimension' => $d_uid, + 'prevmember' => $prev, + 'nextmember' => undef, + 'children' => [], + ); + + push @{$level{'members'}}, $m_uid; + + if (defined $prev) { + $cache{$prev}{'nextmember'} = $m_uid; + } + + my @c_nodes = $m_elem->findnodes('children/child'); + + foreach my $c_elem (@c_nodes) { + my $ref = $c_elem->findvalue('ref'); + push @{$member{'children'}}, $ref; + } + + $cache{$m_uid} = \%member; + } + + $cache{$l_uid} = \%level; + } + + $cache{$h_uid} = \%hierarchy; + } + + $cache{$d_uid} = \%dimension; + } + + my $dbase = { + 'engine' => $root->findvalue('database/engine'), + 'host' => $root->findvalue('database/host'), + 'port' => $root->findvalue('database/port'), + 'name' => $root->findvalue('database/name'), + }; + + return (\%cache, \%listing, $names, $dbase); +} + +my ($cache, $listing, $names, $dbase) = + mdx_load_metadata('metadata.xml'); + +sub has { + my ($ary, $elt) = @_; + + foreach (@{$ary}) { + return 1 if $_ eq $elt; + } + + return 0; +} + +sub mdx_names_uid { + return $names->{$_[0]}; +} + +sub mdx_cache_elt { + return $cache->{$_[0]}; +} + +sub mdx_elt_dimension { + my $elt = mdx_cache_elt($_[0]); + + given ($elt->{'type'}) { + when (MDX_HIERARCHY) { + return $elt->{'dimension'}; + } + when (MDX_LEVEL) { + return mdx_elt_dimension($elt->{'hierarchy'}); + } + when (MDX_MEMBER) { + return mdx_elt_dimension($elt->{'level'}); + } + default { + return undef; + } + } +} + +sub mdx_elt_hierarchy { + my $elt = mdx_cache_elt($_[0]); + + given ($elt->{'type'}) { + when (MDX_LEVEL) { + return $elt->{'hierarchy'}; + } + when (MDX_MEMBER) { + return mdx_elt_hierarchy($elt->{'level'}); + } + default { + return undef; + } + } +} + +sub mdx_elt_level { + my $elt = mdx_cache_elt($_[0]); + + given ($elt->{'type'}) { + when (MDX_MEMBER) { + return $elt->{'level'}; + } + default { + return undef; + } + } +} + +my %mdx_elt = ( + 'mdx_fun' => \&mdx_eval_fun, + 'mdx_set' => \&mdx_eval_set, + 'mdx_tup' => \&mdx_eval_tup, + 'mdx_str' => \&mdx_eval_str, + 'mdx_eid' => \&mdx_eval_eid, +); + +sub mdx_eval { + return $mdx_elt{$_[0]->{'head'}}($_[0]); +} + +sub mdx_eval_eid { + my ($eid) = @_; + + my @tail = @{$eid->{'tail'}}; + + my ($d_uid, $h_uid, $l_uid, $m_uid); + my ($d_elt, $h_elt, $l_elt, $m_elt); + my ($d_name, $h_name, $l_name, $m_name); + + $d_name = shift @tail or return undef; + + my $uids = mdx_names_uid($d_name); + + if (not defined $uids) { + return undef; + } elsif (scalar @{$uids} > 1) { + die "Non-uniqe first element: '$d_name'"; + } else { + ($d_uid) = @{$uids}; + } + + $d_elt = mdx_cache_elt($d_uid); + + given ($d_elt->{'type'}) { + when (MDX_DIMENSION) { + $h_name = shift @tail; + + if (not defined $h_name) { + return { + 'head' => MDX_QID, + 'type' => MDX_DIMENSION, + 'd_uid' => $d_uid, + }; + } + + $uids = mdx_names_uid($h_name); + + if (defined $uids) { + for my $uid (@{$uids}) { + if (has($d_elt->{'hierarchies'}, $uid)) { + $h_elt = mdx_cache_elt($uid); + $h_uid = $uid; + last; + } + } + } + + if (not defined $h_elt) { + unshift @tail, $h_name; + + $h_uid = $d_elt->{'default'}; + + if (not defined $h_uid) { + die "'$d_name' does not have default hierarchy"; + } else { + $h_elt = mdx_cache_elt($h_uid); + $h_name = $h_elt->{'name'}; + } + } + } + when (MDX_HIERARCHY) { + ($h_name, $h_uid, $d_name) = ($d_name, $d_uid, undef); + + $h_elt = mdx_cache_elt($h_uid); + + for my $uid (@{$listing->{'dimension'}}) { + $d_elt = mdx_cache_elt($uid); + + if (has($d_elt->{'hierarchies'}, $h_uid)) { + $d_name = $d_elt->{'name'}; + $d_uid = $uid; + last; + } + } + + if (not defined $d_name) { + die "Dimension not found for '$h_name' hierarchy"; + } + } + default { + die "Dimension or hierarchy expected, got '$d_name'"; + } + } + + $l_name = shift @tail; + + if (not defined $l_name) { + return { + 'head' => MDX_QID, + 'type' => MDX_HIERARCHY, + 'd_uid' => $d_uid, + 'h_uid' => $h_uid, + }; + } + + $uids = mdx_names_uid($l_name); + + for my $uid (@{$uids}) { + if (has($h_elt->{'levels'}, $uid)) { + $l_elt = mdx_cache_elt($uid); + $l_uid = $uid; + last; + } + } + + if (defined $l_elt) { + $m_name = shift @tail; + + if (not defined $m_name) { + return { + 'head' => MDX_QID, + 'type' => MDX_LEVEL, + 'd_uid' => $d_uid, + 'h_uid' => $h_uid, + 'l_uid' => $l_uid, + }; + } + + if (scalar @tail > 0) { + die "Only single member expected after level"; + } + + $uids = mdx_names_uid($m_name); + + for my $uid (@{$uids}) { + if (has($l_elt->{'members'}, $uid)) { + $m_elt = mdx_cache_elt($uid); + $m_uid = $uid; + last; + } + } + + if (not defined $m_elt) { + die "'$m_name' is not a member of '$l_name' level"; + } + + if ($m_elt->{'type'} ne MDX_MEMBER) { + die "Member expected after '$l_name', got '$m_name'"; + } + + my $index = 0; + + for my $lev (@{$h_elt->{'levels'}}) { + if ($lev eq $l_uid) { + last; + } else { + $index++; + } + } + + return { + 'head' => MDX_QID, + 'type' => MDX_MEMBER, + 'uid' => $m_uid, + }; + } else { + my @levels = @{$h_elt->{'levels'}}; + my @members = ($l_name, @tail); + + my @m_path = (); + my $m_prev = undef; + + for $m_name (@members) { + $l_uid = shift @levels; + $l_elt = mdx_cache_elt($l_uid); + + $uids = mdx_names_uid($m_name); + + ($m_elt, $m_uid) = (undef, undef); + + for my $uid (@{$uids}) { + if (has($l_elt->{'members'}, $uid)) { + $m_elt = mdx_cache_elt($uid); + $m_uid = $uid; + last; + } + } + + if (not defined $m_elt) { + die "'$m_name' not found in '" . + $l_elt->{'name'} . "' level"; + } + + if ((defined $m_prev) and + (not has($m_prev->{'children'}, $m_uid))) { + return undef; + } else { + $m_prev = $m_elt; + } + + push @m_path, { + 'head' => MDX_QID, + 'type' => MDX_MEMBER, + 'uid' => $m_uid, + }; + } + + if (scalar @m_path == 1) { + return $m_path[0]; + } else { + return { + 'head' => MDX_TUP, + 'tail' => \@m_path, + }; + } + } + + return undef; +} + +sub mdx_set_sig { + my ($sig, $tup) = @_; + + my @sig_ary = @{$sig}; + my @members = @{$tup->{'tail'}}; + + if (@sig_ary and ($#sig_ary != $#members)) { + return 0; + } + + my @current = (); + my ($uid, $elt); + + for my $elem (@members) { + $uid = $elem->{'uid'}; + $elt = mdx_cache_elt($uid); + + push @current, $elt->{'level'}; + } + + if (not @sig_ary) { + $sig = \@current; + } else { + for my $i (0..$#sig_ary) { + if ($sig_ary[$i] ne $current[$i]) { + return 0; + } + } + } + + return 1; +} + +sub mdx_eval_set { + my ($set) = @_; + + my @tail; + my @elem; + my @sig; + + for my $elt (@{$set->{'tail'}}) { + $elt = mdx_eval($elt); + + next if not defined $elt; + + given ($elt->{'head'}) { + when (MDX_SET) { + @elem = @{$elt->{'tail'}}; + } + when (MDX_TUP) { + if (not @{$elt->{'tail'}}) { + next; + } else { + @elem = ( $elt ); + } + } + when (MDX_QID) { + if ($elt->{'type'} != MDX_MEMBER) { + die "Expected member got else"; + } else { + @elem = ({ + 'head' => MDX_TUP, + 'tail' => [ $elt ], + }); + } + } + default { + die "Unexpected element"; + } + } + + if (not mdx_set_sig(\@sig, $elem[0])) { + die "Set element has wrong dimensionality"; + } + + push @tail, @elem; + } + + return { + 'head' => MDX_SET, + 'tail' => \@tail, + }; +} + +sub mdx_eval_tup { + my ($tup) = @_; + + my @tail; + my @elem; + + for my $elt (@{$tup->{'tail'}}) { + $elt = mdx_eval($elt); + + next if not defined $elt; + + given ($elt->{'head'}) { + when (MDX_TUP) { + if (not (@elem = @{$elt->{'tail'}})) { + next; + } + } + when (MDX_QID) { + if ($elt->{'type'} != MDX_MEMBER) { + die "Expected member got else"; + } else { + @elem = ( $elt ); + } + } + default { + die "Unexpected element"; + } + } + + push @tail, @elem; + } + + my %levels = (); + + for my $elem (@tail) { + my $uid = $elem->{'tail'}[-1]; + my $elt = mdx_cache_elt($uid); + + my $l_uid = $elt->{'level'}; + my $l_elt = mdx_cache_elt($l_uid); + + if (exists $levels{$l_uid}) { + die "'" . $l_uid->{'name'} . + "' level used multiple times"; + } else { + $levels{$l_uid} = 1; + } + } + + return { + 'head' => MDX_TUP, + 'tail' => \@tail, + }; +} + +my %mdx_fun = ( + 'crossjoin' => \&mdx_fun_crossjoin, + 'children' => \&mdx_fun_children, + 'members' => \&mdx_fun_members, +); + +sub mdx_fun_crossjoin { + my ($args) = @_; + + my @args = @{$args}; + my @tail = (); + + if (@args) { + for my $elt (@args) { + my @cross = (); + my $tuple; + + given ($elt->{'head'}) { + when (MDX_SET) { + if (not @tail) { + push @tail, @{$elt->{'tail'}}; + } else { + for my $elt0 (@tail) { + for my $elt1 (@{$elt->{'tail'}}) { + push @cross, { + 'head' => MDX_TUP, + 'tail' => [@{$elt0->{'tail'}}, + @{$elt1->{'tail'}}], + }; + } + } + + @tail = @cross; + } + + next; + } + when (MDX_TUP) { + $tuple = $elt->{'tail'}; + } + when (MDX_QID) { + if ($elt->{'type'} != MDX_MEMBER) { + die "Expected member got else"; + } else { + $tuple = [ $elt ]; + } + } + default { + die "Unexpected element"; + } + } + + if (not @tail) { + push @tail, { + 'head' => MDX_TUP, + 'tail' => $tuple, + }; + } else { + for my $elt (@tail) { + push @cross, [@{$elt}, @{$tuple}]; + } + + @tail = @cross; + } + } + + my @sig = (); + + for my $elt (@tail) { + if (not mdx_set_sig(\@sig, $elt)) { + die "Set element has wrong dimensionality"; + } + } + } + + return { + 'head' => MDX_SET, + 'tail' => \@tail, + }; +} + +sub mdx_fun_children { + my ($args) = @_; + + if (scalar @{$args} != 1) { + die "Single argument expected in 'children'"; + } + + my $item = $args->[0]; + my @tail = (); + + die "Element expected, got whatever" + if $item->{'head'} != MDX_QID; + + die "Member expected, got whatever" + if $item->{'type'} != MDX_MEMBER; + + my $elt = mdx_cache_elt($item->{'uid'}); + + for my $mem (@{$elt->{'children'}}) { + push @tail, { + 'head' => MDX_TUP, + 'tail' => [{ + 'head' => MDX_QID, + 'type' => MDX_MEMBER, + 'uid' => $mem, + }], + }; + } + + return { + 'head' => MDX_SET, + 'tail' => \@tail, + }; +} + +sub mdx_fun_members { + my ($args) = @_; + + if (scalar @{$args} != 1) { + die "Single argument expected in 'members'"; + } + + my $item = $args->[0]; + my @tail = (); + + die "Element expected, got whatever" + if $item->{'head'} != MDX_QID; + + my $elt = mdx_cache_elt($item->{'l_uid'}); + + given ($item->{'type'}) { + when (MDX_DIMENSION) { + my $def = $item->{'default'}; + + if (not defined $def) { + die "Dimension does not have default hierarchy"; + } else { + $elt = mdx_cache_elt($def); + $def = $elt->{'default'}; + + if (not defined $def) { + die "Hierarchy does not have default level"; + } else { + $elt = mdx_cache_elt($def); + } + } + } + when (MDX_HIERARCHY) { + my $def = $elt->{'default'}; + + if (not defined $def) { + die "Hierarchy does not have default level"; + } else { + $elt = mdx_cache_elt($def); + } + } + when (MDX_LEVEL) { + # nothing ;) + } + default { + die "Dimension, hierarchy or level expected, got whatever"; + } + } + + for my $mem (@{$elt->{'members'}}) { + push @tail, { + 'head' => MDX_TUP, + 'tail' => [{ + 'head' => MDX_QID, + 'type' => MDX_MEMBER, + 'uid' => $mem, + }], + }; + } + + return { + 'head' => MDX_SET, + 'tail' => \@tail, + }; +} + +sub mdx_eval_fun { + my ($fun) = @_; + + my @tail = (); + my $func = $fun->{'func'}; + + if (not exists $mdx_fun{$func}) { + die "'$func' function does not exit"; + } + + for my $elt (@{$fun->{'tail'}}) { + $elt = mdx_eval($elt); + + if (not defined $elt) { + die "Invalid argument to function"; + } else { + push @tail, $elt; + } + } + + return $mdx_fun{$func}(\@tail); +} + +sub mdx_eval_str { + die "NOT YET"; +} + +sub mdx_eval_axis { + my ($axis) = @_; + + my $elt = mdx_eval($axis); + + my @tail; + + if (not defined $elt) { + @tail = (); + } else { + given ($elt->{'head'}) { + when (MDX_SET) { + return $elt; + } + when (MDX_TUP) { + if (@{$elt->{'tail'}}) { + @tail = ( $elt ); + } + } + when (MDX_QID) { + if ($elt->{'type'} != MDX_MEMBER) { + die "Expected member got else"; + } else { + @tail = ({ + 'head' => MDX_TUP, + 'tail' => [ $elt ], + }); + } + } + default { + die "Unexpected element"; + } + } + } + + return { + 'head' => MDX_SET, + 'tail' => \@tail, + }; +} + +sub mdx_eval_query { + my ($query) = @_; + + my %axes = (); + + for my $axis (@{$query->{'axes'}}) { + my $name = $axis->{'axis'}; + + if (exists $axes{$name}) { + die "Axis '$name' already specified"; + } else { + $axes{$name} = { + 'spec' => $axis->{'spec'}, + 'flag' => $axis->{'flag'}, + }; + } + } + + while (my ($key, $val) = each %axes) { + my $axis = mdx_eval_axis($val->{'spec'}); + + my @set = (); + + for my $selt (@{$axis->{'tail'}}) { + my @tup = (); + + for my $telt (@{$selt->{'tail'}}) { + push @tup, $telt->{'uid'}; + } + + push @set, \@tup; + } + + $axes{$key} = { + 'spec' => \@set, + 'flag' => $val->{'flag'}, + }; + } + + my $slice = $query->{'slice'}; + + if (defined $slice) { + $slice = mdx_eval_axis($slice); + + my @set = (); + + for my $selt (@{$slice->{'tail'}}) { + my @tup = (); + + for my $telt (@{$selt->{'tail'}}) { + push @tup, $telt->{'uid'}; + } + + push @set, \@tup; + } + + $slice = \@set; + } + + my %levels = (); + my $tuple; + + for my $axis (values(%axes), $slice) { + if (ref $axis eq "HASH") { + $tuple = $axis->{'spec'}->[0]; + } else { + $tuple = $axis->[0]; + } + + for my $uid (@{$tuple}) { + my $lev = mdx_cache_elt($uid)->{'level'}; + + if (exists $levels{$lev}) { + die "'$lev' level is used on multiple axes"; + } else { + $levels{$lev} = 1; + } + } + } + + my $measure = $query->{'using'}; + + if (defined $measure) { + my @tail = @{$measure->{'tail'}}; + + if (scalar @tail != 1) { + die "Invalid measure specificatio"; + } else { + my $uids = mdx_names_uid($tail[0]); + + if (not defined $uids) { + die "'$measure' is not a measure"; + } elsif (scalar @{$uids} > 1) { + die "'$measure' in non-uniqe element"; + } else { + ($measure) = @{$uids}; + } + } + } else { + $measure = $listing->{'measure'}->[0]->{'uid'}; + } + + return (\%axes, $measure, $slice); +} + +sub mdx_query_warehouse { + my ($dbh, $OUT, $axes, $measure, $slice) = @_; + + sub get_axis_spec { + my ($tup, $join_spec) = @_; + + my @tup = @{$tup}; + + my @axis_spec = (); + my %field_map = (); + + my ($dim, $d_elt); + my ($lev, $l_elt); + + my $index = 0; + + for my $member (@tup) { + my $elt = mdx_cache_elt($member); + + $dim = $elt->{'dimension'}; + $d_elt = mdx_cache_elt($dim); + $lev = $elt->{'level'}; + $l_elt = mdx_cache_elt($lev); + + $join_spec->{$d_elt->{'table'}} = { + 'primary' => $d_elt->{'primary'}, + 'foreign' => $d_elt->{'foreign'}, + }; + + $field_map{$index++} = $l_elt->{'field'}; + + push @axis_spec, { + 'table' => $d_elt->{'table'}, + 'field' => $l_elt->{'field'}, + 'dtype' => $l_elt->{'dtype'}, + }; + } + + return (\@axis_spec, \%field_map); + } + + my @rows = (); + my @cols = (); + + if (exists $axes->{'rows'}) { + @rows = @{$axes->{'rows'}->{'spec'}}; + } + + if (exists $axes->{'cols'}) { + @cols = @{$axes->{'cols'}->{'spec'}}; + } + + my @slice = (); + + if (defined $slice) { + @slice = @{$slice}; + } + + my %join_spec = (); + + my @rows_spec = (); + my @cols_spec = (); + + my %rows_field_map = (); + my %cols_field_map = (); + + if (@rows) { + my ($rows_spec, $rows_field_map) = + get_axis_spec($rows[0], \%join_spec); + + @rows_spec = @{$rows_spec}; + %rows_field_map = %{$rows_field_map}; + } + + if (@cols) { + my ($cols_spec, $cols_field_map) = + get_axis_spec($cols[0], \%join_spec); + + @cols_spec = @{$cols_spec}; + %cols_field_map = %{$cols_field_map}; + } + + my @slice_spec = (); + my %slice_field_map = (); + + if (@slice) { + my ($slice_spec, $slice_field_map) = + get_axis_spec($slice[0], \%join_spec); + + @slice_spec = @{$slice_spec}; + %slice_field_map = %{$slice_field_map}; + } + + my @axes_spec = (@rows_spec, @cols_spec); + + my %field_items = (); + + for my $spec (@axes_spec, @slice_spec) { + $field_items{$spec->{'field'}} = {}; + } + + my @sql_table = (); + + for my $spec (@axes_spec) { + push @sql_table, $spec->{'field'} . + ' ' . $spec->{'dtype'}; + } + + my $sql_table = qq{create temporary table t1 (} + . join(', ', @sql_table) + . qq{, Rank int);\n}; + + $dbh->do($sql_table); + + my $has_rows = 1; + my $has_cols = 1; + + if (not @rows) { + @rows = ([]); + $has_rows = 0; + } + + if (not @cols) { + @cols = ([]); + $has_cols = 0; + } + + if (not ($has_rows or $has_cols)) { + return undef; + } + + my $index = 1; + + for my $row_tuple (@rows) { + my @row_items = (); + + for my $uid (@{$row_tuple}) { + my $elt = mdx_cache_elt($uid); + push @row_items, $elt->{'item'}; + } + + for my $i (0..$#row_items) { + my $field = $rows_field_map{$i}; + $field_items{$field}->{$row_items[$i]} = 1; + } + + for my $col_tuple (@cols) { + my @col_items = (); + + for my $uid (@{$col_tuple}) { + my $elt = mdx_cache_elt($uid); + push @col_items, $elt->{'item'}; + } + + for my $i (0..$#col_items) { + my $field = $cols_field_map{$i}; + $field_items{$field}->{$col_items[$i]} = 1; + } + + my @items = (@row_items, @col_items, $index++); + + my $quote = join(', ', map { $dbh->quote($_) } @items); + my $sql_insert = qq{insert into t1 values ($quote);\n}; + + $dbh->do($sql_insert); + } + } + + for my $slice_tuple (@slice) { + my @slice_tuple = @{$slice_tuple}; + + for my $i (0..$#slice_tuple) { + my $uid = $slice_tuple[$i]; + my $elt = mdx_cache_elt($uid); + + my $item = $elt->{'item'}; + + my $field = $slice_field_map{$i}; + $field_items{$field}->{$item} = 1; + } + } + + my $m_elt = mdx_cache_elt($measure); + + my $m_table = $m_elt->{'table'}; + my $m_field = $m_elt->{'field'}; + my $m_func = $m_elt->{'function'}; + + my @sql_columns = (); + + for my $spec (@axes_spec) { + push @sql_columns, $spec->{'table'} . + '.' . $spec->{'field'}; + } + + my $sql_columns = join(', ', @sql_columns); + + my @join_with = (); + my @on_clause = (); + + while (my ($key, $val) = each %join_spec) { + push @join_with, $key; + push @on_clause, ($m_table . '.' . $val->{'foreign'} + . '=' . $key . '.' . $val->{'primary'}); + } + + my $join_with = join(', ', @join_with); + my $on_clause = join(' and ', @on_clause); + + my @where_spec = (); + + while (my ($key, $val) = each %field_items) { + my @items = map { $dbh->quote("$_") } keys %{$val}; + push @where_spec, $key . ' in (' . join(', ', @items) . ')'; + } + + my $where_spec = join(' and ', @where_spec); + + my @sql_t1_columns = (); + my @sql_t1_on_clause = (); + + for my $spec (@axes_spec) { + my $field = $spec->{'field'}; + + push @sql_t1_columns, "t1.$field"; + push @sql_t1_on_clause, "t1.$field=t2.$field"; + } + + my $sql_t1_columns = join(', ', @sql_t1_columns); + my $sql_t1_on_clause = join(' and ', @sql_t1_on_clause); + + my $sql = qq{ + select $sql_t1_columns, t2.Value from t1 left join ( + select $sql_columns, $m_func($m_field) as 'Value' + from $m_table inner join ($join_with) on ($on_clause) + where ($where_spec) group by $sql_columns) as t2 + on ($sql_t1_on_clause) order by t1.Rank; + }; + + my $sth = $dbh->prepare($sql); + + $sth->execute(); + + my $n_cols = scalar @cols; + + my @width = (0) x $n_cols; + my @array = (); + + for (my $i = 0; $i <= $#rows; $i++) { + my @values = (); + + for (my $j = 0; $j <= $#cols; $j++) { + my $ref = $sth->fetchrow_arrayref; + + if (not defined $ref) { + die "Expected more values"; + } else { + my $value = $ref->[-1]; + my $width; + + if (defined $value) { + $width = length $value; + } else { + $width = 4; # null + } + + if ($width > $width[$j]) { + $width[$j] = $width; + } + + push @values, $value; + } + } + + push @array, \@values; + } + + $sth->finish(); + + $dbh->do(qq{drop table t1}); + + if ($axes->{'rows'}->{'flag'}) { + my @list = (); + + for (my $i = 0; $i <= $#rows; $i++) { + my $non_empty = 0; + + for (my $j = 0; $j <= $#cols; $j++) { + my $value = $array[$i][$j]; + + if (defined $value) { + $non_empty = 1; + last; + } + } + + if (not $non_empty) { + push @list, $i; + } + } + + if (@list) { + delete @array[@list]; + delete @rows[@list]; + } + } + + if ($axes->{'cols'}->{'flag'}) { + my @list = (); + + for (my $j = 0; $j <= $#cols; $j++) { + my $non_empty = 0; + + for (my $i = 0; $i <= $#rows; $i++) { + my $value = $array[$i][$j]; + + if (defined $value) { + $non_empty = 1; + last; + } + } + + if (not $non_empty) { + push @list, $j; + } + } + + if (@list) { + for (my $i = 0; $i <= $#rows; $i++) { + delete $array[$i]->[@list]; + } + + delete @cols[@list]; + delete @width[@list]; + } + + } + + my $n_rows_tup = (not @rows) ? 0 : scalar @{$rows[0]}; + my $n_cols_tup = (not @cols) ? 0 : scalar @{$cols[0]}; + + my @rows_width = (0) x $n_rows_tup; + my @cols_width = (0) x scalar @cols; + + my @rows_items = (); + my @cols_items = (); + + for (my $i = 0; $i <= $#rows; $i++) { + my @this_row = (); + + for (my $j = 0; $j < $n_rows_tup; $j++) { + my $elt = mdx_cache_elt($rows[$i][$j]); + + my $value = $elt->{'name'}; + my $width = length $value; + + if ($width > $rows_width[$j]) { + $rows_width[$j] = $width; + } + + push @this_row, $value; + } + + push @rows_items, \@this_row; + } + + for (my $i = 0; $i <= $#cols; $i++) { + my @this_col = (); + + for (my $j = 0; $j < $n_cols_tup; $j++) { + my $elt = mdx_cache_elt($cols[$i][$j]); + + my $value = $elt->{'name'}; + my $width = length $value; + + if ($width > $cols_width[$i]) { + $cols_width[$i] = $width; + } + + push @this_col, $value; + } + + push @cols_items, \@this_col; + } + + for (my $i = 0; $i <= $#cols; $i++) { + if ($cols_width[$i] > $width[$i]) { + $width[$i] = $cols_width[$i]; + } + } + + my @row_bar = (); + my @col_bar = (); + + for (my $i = 0; $i < $n_rows_tup; $i++) { + push @row_bar, '-' x ($rows_width[$i] + 2); + } + + for (my $i = 0; $i <= $#cols; $i++) { + push @col_bar, '-' x ($width[$i] + 2); + } + + print "\n"; + + my $nice = ' ' x 1; + + my $row_bar = join('+', @row_bar); + my $col_bar = join('+', @col_bar); + + $row_bar = '+' . $row_bar if $row_bar; + $col_bar = $col_bar . '+' if $col_bar; + + my $offset = ' ' x (length($row_bar)); + + my $off_col_bar = $nice . $offset . '+' . $col_bar . "\n"; + + for (my $j = 0; $j < $n_cols_tup; $j++) { + my @line = (); + + for (my $i = 0; $i <= $#cols; $i++) { + my $value = $cols_items[$i][$j]; + my $len = length $value; + my $max = $width[$i]; + + my $L = 1 + floor(($max - $len) / 2); + my $R = 1 + $max - $len - $L + 1; + + push @line, ' ' x $L . $value . ' ' x $R; + } + + my $line = $nice . $offset . '|' . join('|', @line) . "|\n"; + + print $OUT $off_col_bar; + print $OUT $line; + } + + my $bar = $nice . $row_bar . '+' . $col_bar . "\n"; + + if ($has_cols && !$has_rows) { + print $OUT $nice . $row_bar . '+' . + ('+' x length $col_bar) . "\n"; + } else { + print $OUT $bar; + } + + for (my $i = 0; $i <= $#rows; $i++) { + my @head = (); + my $head; + + for (my $j = 0; $j < $n_rows_tup; $j++) { + my $value = $rows_items[$i][$j]; + my $len = length $value; + my $max = $rows_width[$j]; + + my $L = 1 + floor(($max - $len) / 2); + my $R = 1 + $max - $len - $L + 1; + + push @head, ' ' x $L . $value . ' ' x $R; + } + + my @line = (); + my $line; + + for (my $j = 0; $j <= $#cols; $j++) { + my $value = $array[$i][$j] || 'null'; + my $white = $width[$j] - length($value); + + push @line, ' ' . ' ' x $white . $value . ' '; + } + + my $op = ($has_rows && !$has_cols) ? '+' : '|'; + + $head = $nice . '|' . join('|', @head); + $line = $head . $op . join('|', @line) . "|\n"; + + print $OUT $line, $bar; + } + + return ($#rows+1, $#cols+1); +} + +use constant { + HISTORY => '~/.mdx-tools-history', + METADATA => 'metadata.xml', +}; + +sub rl_load_history { + my ($term) = @_; + my ($file) = glob(HISTORY); + + if ($term->Features->{readHistory}) { + $term->ReadHistory($file); + } elsif ($term->Features->{setHistory}) { + if (-e $file) { + chomp (my @lines = read_file($file)); + $term->SetHistory(@lines); + } + } +} + +sub rl_save_history { + my ($term) = @_; + my ($file) = glob(HISTORY); + + if ($term->Features->{writeHistory}) { + $term->WriteHistory($file); + } elsif ($term->Features->{getHistory}) { + if (-e $file) { + my @lines = map { "$_\n" } $term->GetHistory; + $term->SetHistory(@lines); + } + } +} + +my $dbi_ctx = 'dbi:' + . $dbase->{'engine'} + . ':' + . $dbase->{'name'} + . ';host=' . $dbase->{'host'} + . ';port=' . $dbase->{'port'}; + +my ($dbi_usr) = getpwuid($<); + +my $dbh = DBI->connect($dbi_ctx, $dbi_usr); + +open(GRAMMAR, 'grammar.txt') + or die "Can't open grammar file: $!"; + +my $grammar = do { + local $/; + ; +}; + +close(GRAMMAR); + +my $parser = Parse::RecDescent->new($grammar) + or die "Invalid grammar specification"; + +my $term = new Term::ReadLine('mdx-tools'); +my $OUT = $term->OUT() || *STDOUT; + +$term->ornaments(0); + +rl_load_history($term); + +my $input; +my $result; +my $index = 1; +my @lines = (); +my $multiline = 0; + +for (;; $index++) { + if (not $multiline) { + $input = $term->readline('>>> '); + } else { + $input = $term->readline('--> '); + } + + last if not defined $input; + + $input =~ s/^\s*(.*?)\s*$/$1/; + + next if $input =~ /^$/; + + push @lines, $input; + + if ($input =~ /;$/) { + $result = $parser->parse_mdx(join ' ', @lines); + + $multiline = 0; + @lines = (); + + if (defined $result) { + eval { + my $t0 = [gettimeofday]; + my ($n, $m) = mdx_query_warehouse($dbh, + $OUT, mdx_eval_query($result)); + my $t1 = [gettimeofday]; + + my $dt = tv_interval($t0, $t1); + + print "\n" . $n*$m . " cells as ($n x $m) slice (" . + sprintf('%.2f', $dt) . " sec)\n"; + }; + + if ($@) { + print $OUT "!!! " . $@; + } + } else { + print $OUT "!!! Syntax error in MDX statement\n"; + } + + } else { + $multiline = 1; + } +} + +$dbh->disconnect(); + +rl_save_history($term); + +print "\nNothing more to do. Bye.\n"; + diff --git a/metadata.xml b/metadata.xml new file mode 100755 index 0000000..46d153d --- /dev/null +++ b/metadata.xml @@ -0,0 +1,588 @@ + + + + mysql + + localhost + 3306 + + odwa + + + + + M1 + + Order Quantity + Order Quantity measure + + factinternetsales
+ OrderQuantity + + %d + sum + + + + M2 + + Sales Amount + Sales Amount measure + + factinternetsales
+ SalesAmount + + %d + sum + + + + M3 + + Freight + Freight measure + + factinternetsales
+ Freight + + %.2f + sum + + + + + + D1 + + Order Date + Order Date dimension + + dimtime
+ + TimeKey + OrderDateKey + + D1H1 + + + + D1H1 + + Calendar + Calendar hierarchy + + D1H1L1 + + + + D1H1L1 + + Year + Year (calendar) + + CalendarYear + char(4) + + D1H1L1M1 + + + + D1H1L1M1 + + 2001 + 2001 + + + + D1H1L1M1C1 + D1H1L2M1 + + + + D1H1L1M1C2 + D1H1L2M2 + + + + + + D1H1L1M2 + + 2002 + 2002 + + + + D1H1L1M2C1 + D1H1L2M1 + + + + D1H1L1M2C2 + D1H1L2M2 + + + + + + D1H1L1M3 + + 2003 + 2003 + + + + D1H1L1M3C1 + D1H1L2M1 + + + + D1H1L1M3C2 + D1H1L2M2 + + + + + + D1H1L1M4 + + 2004 + 2004 + + + + D1H1L1M4C1 + D1H1L2M1 + + + + D1H1L1M4C2 + D1H1L2M2 + + + + + + + + D1H1L2 + + Semester + Semester (calendar) + + CalendarSemester + tinyint(4) + + D1H1L2M1 + + + + D1H1L2M1 + + S1 + 1 + + + + D1H1L2M1C1 + D1H1L3M1 + + + + D1H1L2M1C2 + D1H1L3M2 + + + + + + D1H1L2M2 + + S2 + 2 + + + + D1H1L2M2C1 + D1H1L3M3 + + + + D1H1L2M2C2 + D1H1L3M4 + + + + + + + + D1H1L3 + + Quarter + Quarter (calendar) + + CalendarQuarter + tinyint(4) + + D1H1L3M1 + + + + D1H1L3M1 + + Q1 + 1 + + + + D1H1L3M1C1 + D1H1L4M1 + + + + D1H1L3M1C2 + D1H1L4M2 + + + + D1H1L3M1C3 + D1H1L4M3 + + + + + + D1H1L3M2 + + Q2 + 2 + + + + D1H1L3M2C1 + D1H1L4M4 + + + + D1H1L3M2C2 + D1H1L4M5 + + + + D1H1L3M2C3 + D1H1L4M6 + + + + + + D1H1L3M3 + + Q3 + 3 + + + + D1H1L3M3C1 + D1H1L4M7 + + + + D1H1L3M3C2 + D1H1L4M8 + + + + D1H1L3M3C3 + D1H1L4M9 + + + + + + D1H1L3M4 + + Q4 + 4 + + + + D1H1L3M4C1 + D1H1L4M10 + + + + D1H1L3M4C2 + D1H1L4M11 + + + + D1H1L3M4C3 + D1H1L4M12 + + + + + + + + D1H1L4 + + Month + Month (calendar) + + MonthNumberOfYear + tinyint(4) + + D1H1L3M1 + + + + D1H1L3M1 + + January + 1 + + + + D1H1L3M2 + + February + 2 + + + + D1H1L3M3 + + March + 3 + + + + D1H1L3M4 + + April + 4 + + + + D1H1L3M5 + + May + 5 + + + + D1H1L3M6 + + June + 6 + + + + D1H1L3M7 + + July + 7 + + + + D1H1L3M8 + + August + 8 + + + + D1H1L3M9 + + September + 9 + + + + D1H1L3M10 + + Ocober + 10 + + + + D1H1L3M11 + + November + 11 + + + + D1H1L3M12 + + December + 12 + + + + + + + + + + D2 + + Customer + Customer dimension + + dimcustomer
+ + CustomerKey + CustomerKey + + D2H1 + + + + D2H1 + + Gender + Gender hierarchy + + D2H1L1 + + + + D2H1L1 + + Gender + Gender level + + Gender + varchar(1) + + D2H1L1M1 + + + + D2H1L1M1 + + Female + F + + + D2H1L1M2 + + Male + M + + + + + + + + + + D3 + + Product + Product dimension + + dimproduct
+ + ProductKey + ProductKey + + D3H1 + + + + D3H1 + + Color + Color hierarchy + + D3H1L1 + + + + D3H1L1 + + Color + Color level + + Color + varchar(15) + + D3H1L1M1 + + + + D3H1L1M1 + + Unknown + NA + + + D3H1L1M2 + + Black + Black + + + D3H1L1M3 + + Silver + Silver + + + D3H1L1M4 + + Red + Red + + + D3H1L1M5 + + White + White + + + D3H1L1M6 + + Blue + Blue + + + D3H1L1M7 + + Multi + Multi + + + D3H1L1M8 + + Yellow + Yellow + + + D3H1L1M9 + + Grey + Grey + + + D3H1L1M10 + + Silver/Black + Silver/Black + + + + + + + + + + -- 2.11.4.GIT