view release on metacpan or  search on metacpan

lib/DynGig/Range/Cluster/Config.pm  view on Meta::CPAN

{
    return undef unless my $buffer = Compress::Zlib::uncompress( $_[0] );
    return undef unless my $this = eval { YAML::XS::Load $buffer };
    return ref $this eq __PACKAGE__ ? $this : undef;
}

=head2 unzip()

Returns compressed config.

=cut
sub zip
{
    my $serial = YAML::XS::Dump shift @_;

    return Compress::Zlib::compress( $serial ) unless @_;
    return Compress::Zlib::compress( $serial, @_ );
}

=head2 unzip()

Returns MD5 digest of serialized config.

=cut
sub md5
{
    Digest::MD5->new()->add( YAML::XS::Dump $_[0] )->hexdigest();
}

=head2 load()

Delta loads ( no change == no-op ) configs into a HASH.
Returns HASH reference in scalar context.
Returns flattened HASH in list context.

=cut
sub load
{
    my $this = shift @_;
    my %conf;

    for my $name ( keys %_CONF )
    {
        my $conf = $_CONF{$name};
        my $mtime  = ( $conf->[0]->stat() )[9];

        next if $conf->[1] && $mtime <= $conf->[1];

        $conf{$name} = $conf->[0]->reload()->get();
        $conf->[1] = $mtime;
    }

    return wantarray ? %conf : \%conf;
}

=head2 update( cluster1 => config1, cluster2 => config2 .. )

Updates object.

=cut
sub update
{
    my ( $this, %conf ) = @_;
    my $K = $this->{key};
    my $V = $this->{value};
    my $C = $this->{cluster};

    for my $name ( keys %conf )
    {
        for my $table ( keys %$K )
        {
            for my $table ( $K->{$table}, $V->{$table} )
            {
                for my $key ( keys %$table )
                {
                    delete $table->{$key}{$name};
                    delete $table->{$key} unless %{ $table->{$key} };
                }
            }
        }

        while ( my ( $table, $conf ) = each %{ $C->{$name} = $conf{$name} } )
        {
            while ( my ( $key, $value ) = each %$conf )
            {
                $K->{$table}{$key}{$name} = $value;
                push @{ $V->{$table}{$value}{$name} }, $key;
            }
        }
    }
}

sub AUTOLOAD 
{
    my $this = shift;
    my $K = $this->{key};
    my $V = $this->{value};

    if ( our $AUTOLOAD =~ /::DB_(\w+)$/ ) ## 'DB' methods
    {
        my $key = $1;

        if ( $key =~ /^(cluster|table)s$/ )
        {
            my @list = keys %{ $this->{$1} || $K };
            return wantarray ? @list : \@list;
        }
        elsif ( $this->{$key} )
        {
            my $table = shift;
            return defined $table ? $this->{$key}{$table} : $table;
        }
    }
    elsif ( $AUTOLOAD =~ /::(\w+)$/ && $K->{$1} ) ## 'table' methods
    {
        my $table = $1;
        my %param = @_;
        my $key = $param{key};
        my $value = $param{value};
        my $cluster = $param{cluster};