use
vars
qw(@types $VERSION)
;
$VERSION
= 0.0001;
@types
= (
''
,
'C'
,
'n'
,
''
,
'N'
);
sub
new
{
my
(
$class
) =
@_
;
my
(
$self
) = [];
bless
$self
, (
ref
(
$class
) ||
$class
);
}
sub
fastadd_segment
{
my
(
$self
) =
shift
;
my
(
$start
) =
shift
;
my
(
$sparse
) =
shift
;
my
(
$p
,
$i
,
$seg
,
@seg
);
if
(
$sparse
)
{
for
(
$i
= 0;
$i
<=
$#_
;
$i
++)
{
if
(!
defined
$seg
&& ((
$sparse
!= 2 &&
defined
$_
[
$i
]) ||
$_
[
$i
] != 0))
{
$seg
->{
'START'
} =
$start
+
$i
;
$seg
->{
'VAL'
} = []; }
if
(
defined
$seg
&& ((
$sparse
== 2 &&
$_
[
$i
] == 0) || !
defined
$_
[
$i
]))
{
$seg
->{
'LEN'
} =
$start
+
$i
-
$seg
->{
'START'
};
push
(
@seg
,
$seg
);
$seg
=
undef
;
}
elsif
(
defined
$seg
)
{
push
(@{
$seg
->{
'VAL'
}},
$_
[
$i
]); }
}
if
(
defined
$seg
)
{
push
(
@seg
,
$seg
);
$seg
->{
'LEN'
} =
$start
+
$i
-
$seg
->{
'START'
};
}
}
else
{
$seg
->{
'START'
} =
$start
;
$seg
->{
'LEN'
} =
$#_
+ 1;
$seg
->{
'VAL'
} = [
@_
];
@seg
= (
$seg
);
}
for
(
$i
= 0;
$i
<=
$#$self
;
$i
++)
{
if
(
$self
->[
$i
]{
'START'
} >
$start
)
{
splice
(
@$self
,
$i
, 0,
@seg
);
return
wantarray
?
@seg
:
scalar
(
@seg
);
}
}
push
(
@$self
,
@seg
);
return
wantarray
?
@seg
:
scalar
(
@seg
);
}
sub
add_segment
{
my
(
$self
) =
shift
;
my
(
$start
) =
shift
;
my
(
$over
) =
shift
;
my
(
$seg
,
$i
,
$s
,
$offset
,
$j
,
$newi
);
return
$self
->fastadd_segment(
$start
,
$over
,
@_
)
if
(
$#$self
< 0);
$offset
= 0;
for
(
$i
= 0;
$i
<=
$#$self
&&
$offset
<=
$#_
;
$i
++)
{
$s
=
$self
->[
$i
];
if
(
$s
->{
'START'
} <=
$start
+
$offset
)
{
if
(
$s
->{
'START'
} +
$s
->{
'LEN'
} >
$start
+
$#_
)
{
for
(
$j
=
$offset
;
$j
<=
$#_
;
$j
++)
{
if
(
$over
)
{
$s
->{
'VAL'
}[
$start
-
$s
->{
'START'
} +
$j
] =
$_
[
$j
]
if
defined
$_
[
$j
]; }
else
{
$s
->{
'VAL'
}[
$start
-
$s
->{
'START'
} +
$j
] ||=
$_
[
$j
]
if
defined
$_
[
$j
]; }
}
$offset
=
$#_
+ 1;
last
;
}
elsif
(
$s
->{
'START'
} +
$s
->{
'LEN'
} >
$start
+
$offset
)
{
for
(
$j
=
$offset
;
$j
<
$s
->{
'START'
} +
$s
->{
'LEN'
} -
$start
;
$j
++)
{
if
(
$over
)
{
$s
->{
'VAL'
}[
$start
-
$s
->{
'START'
} +
$j
] =
$_
[
$j
]
if
defined
$_
[
$j
]; }
else
{
$s
->{
'VAL'
}[
$start
-
$s
->{
'START'
} +
$j
] ||=
$_
[
$j
]
if
defined
$_
[
$j
]; }
}
$offset
=
$s
->{
'START'
} +
$s
->{
'LEN'
} -
$start
;
}
}
else
{
if
(
$s
->{
'START'
} >
$start
+
$#_
+ 1)
{
$i
+=
$self
->fastadd_segment(
$start
+
$offset
, 1,
@_
[
$offset
..
$#_
]) - 1;
$offset
=
$#_
+ 1;
}
else
{
$i
+=
$self
->fastadd_segment(
$start
+
$offset
, 1,
@_
[
$offset
..
$s
->{
'START'
} -
$start
]) - 1;
$offset
=
$s
->{
'START'
} -
$start
+ 1;
}
}
}
if
(
$offset
<=
$#_
)
{
$seg
->{
'START'
} =
$start
+
$offset
;
$seg
->{
'LEN'
} =
$#_
-
$offset
+ 1;
$seg
->{
'VAL'
} = [
@_
[
$offset
..
$#_
]];
push
(
@$self
,
$seg
);
}
$self
->tidy;
}
sub
tidy
{
my
(
$self
) =
@_
;
my
(
$i
,
$sl
,
$s
);
for
(
$i
= 1;
$i
<=
$#$self
;
$i
++)
{
$sl
=
$self
->[
$i
- 1];
$s
=
$self
->[
$i
];
if
(
$s
->{
'START'
} ==
$sl
->{
'START'
} +
$sl
->{
'LEN'
})
{
$sl
->{
'LEN'
} +=
$s
->{
'LEN'
};
push
(@{
$sl
->{
'VAL'
}}, @{
$s
->{
'VAL'
}});
splice
(
@$self
,
$i
, 1);
$i
--;
}
}
$self
;
}
sub
at
{
my
(
$self
,
$addr
,
$len
) =
@_
;
my
(
$i
,
$dat
,
$s
,
@res
,
$offset
);
$len
= 1
unless
defined
$len
;
$offset
= 0;
for
(
$i
= 0;
$i
<=
$#$self
;
$i
++)
{
$s
=
$self
->[
$i
];
next
if
(
$s
->{
'START'
} +
$s
->{
'LEN'
} <
$addr
+
$offset
);
if
(
$s
->{
'START'
} >
$addr
+
$offset
)
{
push
(
@res
, (
undef
) x (
$s
->{
'START'
} >
$addr
+
$len
?
$len
-
$offset
:
$s
->{
'START'
} -
$addr
-
$offset
));
$offset
=
$s
->{
'START'
} -
$addr
;
}
last
if
(
$s
->{
'START'
} >=
$addr
+
$len
);
if
(
$s
->{
'START'
} +
$s
->{
'LEN'
} >=
$addr
+
$len
)
{
push
(
@res
, @{
$s
->{
'VAL'
}}[
$addr
+
$offset
-
$s
->{
'START'
} ..
$addr
+
$len
-
$s
->{
'START'
} - 1]);
$offset
=
$len
;
last
;
}
else
{
push
(
@res
, @{
$s
->{
'VAL'
}}[
$addr
+
$offset
-
$s
->{
'START'
} ..
$s
->{
'LEN'
} - 1]);
$offset
=
$s
->{
'START'
} +
$s
->{
'LEN'
} -
$addr
;
}
}
push
(
@res
, (
undef
) x (
$len
-
$offset
))
if
(
$offset
<
$len
);
return
wantarray
?
@res
:
$res
[0];
}
sub
remove
{
my
(
$self
,
$addr
,
$len
) =
@_
;
my
(
$i
,
$dat
,
$s
,
@res
,
$offset
);
$len
= 1
unless
defined
$len
;
$offset
= 0;
for
(
$i
= 0;
$i
<=
$#$self
;
$i
++)
{
$s
=
$self
->[
$i
];
next
if
(
$s
->{
'START'
} +
$s
->{
'LEN'
} <
$addr
+
$offset
);
if
(
$s
->{
'START'
} >
$addr
+
$offset
)
{
push
(
@res
, (
undef
) x (
$s
->{
'START'
} >
$addr
+
$len
?
$len
-
$offset
:
$s
->{
'START'
} -
$addr
-
$offset
));
$offset
=
$s
->{
'START'
} -
$addr
;
}
last
if
(
$s
->{
'START'
} >=
$addr
+
$len
);
unless
(
$s
->{
'START'
} ==
$addr
+
$offset
)
{
my
(
$seg
) = {};
$seg
->{
'START'
} =
$s
->{
'START'
};
$seg
->{
'LEN'
} =
$addr
+
$offset
-
$s
->{
'START'
};
$seg
->{
'VAL'
} = [
splice
(@{
$s
->{
'VAL'
}}, 0,
$addr
+
$offset
-
$s
->{
'START'
})];
$s
->{
'LEN'
} -=
$addr
+
$offset
-
$s
->{
'START'
};
$s
->{
'START'
} =
$addr
+
$offset
;
splice
(
@$self
,
$i
, 0,
$seg
);
$i
++;
}
if
(
$s
->{
'START'
} +
$s
->{
'LEN'
} >=
$addr
+
$len
)
{
push
(
@res
,
splice
(@{
$s
->{
'VAL'
}}, 0,
$len
-
$offset
));
$s
->{
'LEN'
} -=
$len
-
$offset
;
$s
->{
'START'
} +=
$len
-
$offset
;
$offset
=
$len
;
last
;
}
else
{
push
(
@res
, @{
$s
->{
'VAL'
}});
$offset
=
$s
->{
'START'
} +
$s
->{
'LEN'
} -
$addr
;
splice
(
@$self
,
$i
, 0);
$i
--;
}
}
push
(
@res
, (
undef
) x (
$len
-
$offset
))
if
(
$offset
<
$len
);
return
wantarray
?
@res
:
$res
[0];
}
sub
copy
{
my
(
$self
) =
@_
;
my
(
$res
,
$p
);
$res
= [];
foreach
$p
(
@$self
)
{
push
(
@$res
,
$self
->copy_seg(
$p
)); }
$res
;
}
sub
copy_seg
{
my
(
$self
,
$seg
) =
@_
;
my
(
$p
,
$res
);
$res
= {};
$res
->{
'VAL'
} = [@{
$seg
->{
'VAL'
}}];
foreach
$p
(
keys
%$seg
)
{
$res
->{
$p
} =
$seg
->{
$p
}
unless
defined
$res
->{
$p
}; }
$res
;
}
1;