lib/Sack/Merge.pm

package Sack::Merge;

use warnings;
use strict;

use Digest::MD5 qw(md5);
use Time::HiRes qw(time);
use Data::Dump qw(dump);

our $out;
sub out { $out }

our $nr = 0;
our $md5_nr;
our $digest_fh;
our @digest_offset;

sub clean {
        undef $out;
}

sub add {
        my ( $self, $new ) = @_;

        my $t_merge = time();

        my $tick = 0;

        my $missing;

        foreach my $k1 ( keys %$new ) {

                foreach my $k2 ( keys %{ $new->{$k1} } ) {

                        my $n   = delete $new->{$k1}->{$k2};

                        if ( $k1 =~ m{#} ) {
                                my $md5 = md5 $k2;
                                if ( defined $md5_nr->{$md5} ) {
                                        $k2 = $md5_nr->{$md5};
                                } else {
                                        open( $digest_fh, '>', '/tmp/sack.digest' ) unless $digest_fh;
                                        $digest_offset[ $nr ] = tell( $digest_fh );
                                        print $digest_fh "$k2\n";

                                        $k2 = $md5_nr->{$md5} = $nr;
                                        $nr++;
                                }
                        }

                        my $ref = ref    $out->{$k1}->{$k2};

                        if ( ! defined $out->{$k1}->{$k2} ) {
                                $out->{$k1}->{$k2} = $n;
                        } elsif ( $k1 =~ m{\+} ) {
#                               warn "## agregate $k1 $k2";
                                $out->{$k1}->{$k2} += $n;
                        } elsif ( $ref  eq 'ARRAY' ) {
                                if ( ref $n eq 'ARRAY' ) {
                                        push @{ $out->{$k1}->{$k2} }, $_ foreach @$n;
                                } else {
                                        push @{ $out->{$k1}->{$k2} }, $n;
                                }
                        } elsif ( $ref eq '' ) {
                                $out->{$k1}->{$k2} = [ $out->{$k1}->{$k2}, $n ];
                        } else {
                                die "can't merge $k2 [$ref] from ",dump($n), " into ", dump($out->{$k1}->{$k2});
                        }

                        if ( $tick++ % 1000 == 0 ) {
                                print STDERR ".";
                        } elsif ( $tick % 10000 == 0 ) {
                                print STDERR $tick;
                        }
                }
        }

        $t_merge = time - $t_merge;
        warn sprintf "\nmerged %d in %.4fs\n", $tick, $t_merge;

        return $tick;
}

1;
1	dpavlin	198	package Sack::Merge;
2
3			use warnings;
4			use strict;
5
6			use Digest::MD5 qw(md5);
7			use Time::HiRes qw(time);
8			use Data::Dump qw(dump);
9
10			our $out;
11			sub out { $out }
12
13			our $nr = 0;
14			our $md5_nr;
15			our $digest_fh;
16			our @digest_offset;
17
18	dpavlin	200	sub clean {
19			undef $out;
20			}
21
22	dpavlin	198	sub add {
23			my ( $self, $new ) = @_;
24
25			my $t_merge = time();
26
27			my $tick = 0;
28
29			my $missing;
30
31			foreach my $k1 ( keys %$new ) {
32
33			foreach my $k2 ( keys %{ $new->{$k1} } ) {
34
35			my $n = delete $new->{$k1}->{$k2};
36
37			if ( $k1 =~ m{#} ) {
38			my $md5 = md5 $k2;
39			if ( defined $md5_nr->{$md5} ) {
40			$k2 = $md5_nr->{$md5};
41			} else {
42			open( $digest_fh, '>', '/tmp/sack.digest' ) unless $digest_fh;
43			$digest_offset[ $nr ] = tell( $digest_fh );
44			print $digest_fh "$k2\n";
45
46			$k2 = $md5_nr->{$md5} = $nr;
47			$nr++;
48			}
49			}
50
51			my $ref = ref $out->{$k1}->{$k2};
52
53			if ( ! defined $out->{$k1}->{$k2} ) {
54			$out->{$k1}->{$k2} = $n;
55			} elsif ( $k1 =~ m{\+} ) {
56			# warn "## agregate $k1 $k2";
57			$out->{$k1}->{$k2} += $n;
58			} elsif ( $ref eq 'ARRAY' ) {
59			if ( ref $n eq 'ARRAY' ) {
60			push @{ $out->{$k1}->{$k2} }, $_ foreach @$n;
61			} else {
62			push @{ $out->{$k1}->{$k2} }, $n;
63			}
64			} elsif ( $ref eq '' ) {
65			$out->{$k1}->{$k2} = [ $out->{$k1}->{$k2}, $n ];
66			} else {
67			die "can't merge $k2 [$ref] from ",dump($n), " into ", dump($out->{$k1}->{$k2});
68			}
69
70			if ( $tick++ % 1000 == 0 ) {
71			print STDERR ".";
72			} elsif ( $tick % 10000 == 0 ) {
73			print STDERR $tick;
74			}
75			}
76			}
77
78			$t_merge = time - $t_merge;
79			warn sprintf "\nmerged %d in %.4fs\n", $tick, $t_merge;
80
81			return $tick;
82			}
83
84			1;