sub
new {
my
(
$pkg
, ) =
@_
;
bless
{
present
=>
undef
,
past
=> [],
future
=> [],
guard
=>
''
,
merge
=>
''
,
last_merge_data
=> [] };
}
sub
set_guard_condition {
my
(
$self
,
$condition
) =
@_
;
return
unless
ref
$condition
eq
'CODE'
;
$self
->{
'guard'
} =
$condition
;
}
sub
set_merge_condition {
my
(
$self
,
$condition
) =
@_
;
return
unless
ref
$condition
eq
'CODE'
;
$self
->{
'merge'
} =
$condition
;
}
sub
can_undo {
int
((@{
$_
[0]->{
'past'
}}) > 0) }
sub
can_redo {
int
((@{
$_
[0]->{
'future'
}}) > 0) }
sub
current_value {
$_
[0]->{
'present'
}
if
defined
$_
[0]->{
'present'
} }
sub
prev_value {
$_
[0]->{
'past'
}[-1]
if
$_
[0]->can_undo }
sub
next_value {
$_
[0]->{
'future'
}[0]
if
$_
[0]->can_redo }
sub
reset
{
my
(
$self
,
$full
) =
@_
;
$self
->{
'past'
} = [];
$self
->{
'future'
} = [];
$self
->{
'present'
} =
undef
if
defined
$full
and
$full
;
}
sub
add_value {
my
(
$self
,
$value
,
@data
) =
@_
;
return
unless
defined
$value
;
return
if
defined
$self
->{
'present'
} and
$value
eq
$self
->{
'present'
};
return
if
$self
->{
'guard'
} and not
$self
->{
'guard'
}->(
$value
);
my
$replace_present
= 0;
if
(
$self
->{
'merge'
} and
@data
) {
$replace_present
=
$self
->{
'merge'
}->( [
@data
],
$self
->{
'last_merge_data'
} );
$self
->{
'last_merge_data'
} = [
@data
];
}
push
@{
$self
->{
'past'
}},
$self
->{
'present'
}
if
not
$replace_present
and
defined
$self
->{
'present'
};
$self
->{
'future'
} = [];
$self
->{
'present'
} =
$value
;
}
sub
undo {
my
(
$self
) =
@_
;
return
unless
$self
->can_undo;
unshift
@{
$self
->{
'future'
} },
$self
->{
'present'
};
$self
->{
'present'
} =
pop
@{
$self
->{
'past'
} };
}
sub
redo
{
my
(
$self
) =
@_
;
return
unless
$self
->can_redo;
push
@{
$self
->{
'past'
} },
$self
->{
'present'
};
$self
->{
'present'
} =
shift
@{
$self
->{
'future'
} };
}
1;