From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

ZAG / Objects-Collection-0.37 / lib / Objects / Collection / ActiveRecord.pm 

            

              
1
—
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
—
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127

              
package Objects::Collection::ActiveRecord;
=head1 NAME
 Objects::Collection::ActiveRecord -  Tools for track changes in HASHes.
=head1 SYNOPSIS
 use Objects::Collection::ActiveRecord;
 sub _prepare_record {
    my ( $self, $key, $ref ) = @_;
    my %hash;
    tie %hash, 'Objects::Collection::ActiveRecord', hash => $ref;
    return \%hash;
 }
=head1 DESCRIPTION
 Tools for track changes in HASHes.
  
=cut
use strict;
use warnings;
use strict;
use Carp;
use Data::Dumper;
require Tie::Hash;
use Objects::Collection::Base;
@Objects::Collection::ActiveRecord::ISA = qw(Tie::StdHash Objects::Collection::Base);
$Objects::Collection::ActiveRecord::VERSION = '0.01';
attributes qw( _changed _orig_record __temp_array);
sub _init {
    my $self = shift;
    return $self->Init(@_);
}
sub DELETE {
    my ( $self, $key ) = @_;
    $self->_changed(1);
    delete $self->_orig_record->{$key};
}
sub STORE {
    my ( $self, $key, $val ) = @_;
    my $hash = $self->_orig_record;
    $self->_changed(1);
    $hash->{$key} = $val;
}
sub FETCH {
    my ( $self, $key ) = @_;
    if ( $key eq '_changed' ) {
        $self->_changed();
    }
    else {
        $self->_orig_record->{$key};
    }
}
sub Init {
    my ( $self, %arg ) = @_;
    $self->_orig_record( $arg{hash} );
    unless ( $arg{hash} ) {
        carp "Not inited param hash"
    }
    $self->_changed(0);
    return 1;
}
sub GetKeys {
    my $self = shift;
    my $hash = $self->_orig_record;
    return [ keys %$hash ];
}
sub TIEHASH {return Objects::Collection::Base::new(@_) }
sub FIRSTKEY {
    my ($self) = @_;
    $self->__temp_array( [ sort { $a cmp $b } @{ $self->GetKeys() } ] );
    shift( @{ $self->__temp_array() } );
}
sub NEXTKEY {
    my ( $self, $key ) = @_;
    shift( @{ $self->__temp_array() } );
}
sub EXISTS {
    my ( $self, $key ) = @_;
    my $hash = $self->_orig_record;
    return exists $hash->{$key};
}
sub CLEAR {
    my $self = shift;
    %{ $self->_orig_record } = ();
    $self->_changed(1);
}
1;
__END__
=head1 SEE ALSO
Tie::StdHash
=head1 AUTHOR
Zahatski Aliaksandr, <zag@cpan.org>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005-2006 by Zahatski Aliaksandr
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut