view release on metacpan or  search on metacpan

lib/DataCube/MeasureUpdater.pm  view on Meta::CPAN

package DataCube::MeasureUpdater;


use strict;
use warnings;


sub new {
    my($class,@opts,%opts) = @_;
    
    updater_opts:{
        %opts         = @opts    and last updater_opts if @_  > 2 && @_ % 2; 
        $opts{schema} = $opts[0] and last updater_opts if @_ == 2;
    }
    
    my $schema = $opts{schema};
    
    die   "DataCube::MeasureUpdater(new):\nmust pass a DataCube::Schema object to new\n$!\n"
    unless $schema && ref($schema) && ref($schema) =~ /^datacube::schema$/i;
    
    my $self = bless {}, ref($class) || $class;
    $self->{measures} = $schema->{measures};
    return $self;
}


sub update {
    my($self,%opts) = @_;

    my $source     = $opts{source};
    my $target     = $opts{target};
    my $source_key = $opts{source_key};
    my $target_key = $opts{target_key};

    #local $SIG{__WARN__} = sub {
    #    die '-' x 80 . "\n" .
    #        "DataCube::MeasureUpdater(update | warnings):\n".
    #        "caught a fatal exception here:\n$_[0]\n" . '-' x 80 . "\n" .
    #        join("\n", "source_key:   $source_key", "target_key:   $target_key") . '-' x 80 . "\n";
    #};

    update:
    for(@{$self->{measures}}) {
        
        if($_->[0] eq 'key_count'){
            
            next update unless exists $source->{$source_key}->{key_count};
            
            $target->{$target_key}->{key_count} +=
            $source->{$source_key}->{key_count};
            
            next update;
        }
        
        my $measure_field = $_->[1];
        
        if($_->[0] eq 'count'){
            next update unless exists $source->{$source_key}->{count}->{$measure_field};
            
            $target->{$target_key}->{count}->{$measure_field} = {}
                unless $target->{$target_key}->{count}->{$measure_field};
            
            my $target_area = $target->{$target_key}->{count}->{$measure_field};
            my $source_area = $source->{$source_key}->{count}->{$measure_field};
            
            $target_area->{$_} = undef for keys %$source_area;
            
            next update;
        }
          
        if($_->[0] eq 'multi_count'){
            next update unless exists $source->{$source_key}->{multi_count}->{$measure_field};
            
            $target->{$target_key}->{multi_count}->{$measure_field} = {}
                unless $target->{$target_key}->{multi_count}->{$measure_field};
            
            my $target_area = $target->{$target_key}->{multi_count}->{$measure_field};
            my $source_area = $source->{$source_key}->{multi_count}->{$measure_field};
            
            $target_area->{$_} += $source_area->{$_} for keys %$source_area;
            
            next update;
        }
        
        if($_->[0] eq 'sum'){
            next update unless exists $source->{$source_key}->{sum}->{$measure_field};