sub
new
{
my
(
$class
) =
shift
;
my
(
$isCover
) =
shift
;
my
(
$self
) = {};
$self
->{
'cover'
} =
$isCover
;
$self
->{
'count'
} = 0;
if
(
$isCover
)
{
my
(
$v
);
foreach
$v
(
@_
)
{
$self
->{
'val'
}{
$v
} =
$self
->{
'count'
}++; }
}
else
{
$self
->{
'val'
} = {
@_
}; }
bless
$self
,
$class
;
}
sub
read
{
my
(
$self
,
$fh
) =
@_
;
my
(
$dat
,
$fmt
,
$num
,
$i
,
$c
);
$fh
->
read
(
$dat
, 4);
(
$fmt
,
$num
) =
unpack
(
"n2"
,
$dat
);
$self
->{
'fmt'
} =
$fmt
;
if
(
$self
->{
'cover'
})
{
if
(
$fmt
== 1)
{
$fh
->
read
(
$dat
,
$num
<< 1);
map
{
$self
->{
'val'
}{
$_
} =
$i
++}
unpack
(
"n*"
,
$dat
);
}
elsif
(
$fmt
== 2)
{
$fh
->
read
(
$dat
,
$num
* 6);
for
(
$i
= 0;
$i
<
$num
;
$i
++)
{
(
$first
,
$last
,
$c
) =
unpack
(
"n3"
,
substr
(
$dat
,
$i
* 6, 6));
map
{
$self
->{
'val'
}{
$_
} =
$c
++} (
$first
..
$last
);
}
}
}
elsif
(
$fmt
== 1)
{
$fh
->
read
(
$dat
, 2);
$first
=
$num
;
(
$num
) =
unpack
(
"n"
,
$dat
);
$fh
->
read
(
$dat
,
$num
<< 1);
map
{
$self
->{
'val'
}{
$first
++} =
$_
}
unpack
(
"n*"
,
$dat
);
}
elsif
(
$fmt
== 2)
{
$fh
->
read
(
$dat
,
$num
* 6);
for
(
$i
= 0;
$i
<
$num
;
$i
++)
{
(
$first
,
$last
,
$c
) =
unpack
(
"n3"
,
substr
(
$dat
,
$i
* 6, 6));
map
{
$self
->{
'val'
}{
$_
} =
$c
} (
$first
..
$last
);
}
}
$self
;
}
sub
out
{
my
(
$self
,
$fh
,
$state
) =
@_
;
my
(
$g
,
$eff
,
$grp
,
$out
);
my
(
$shipout
) = (
$state
?
sub
{
$out
.=
$_
[0];} :
sub
{
$fh
->
print
(
$_
[0]);});
my
(
@gids
) =
sort
{
$a
<=>
$b
}
keys
%{
$self
->{
'val'
}};
$fmt
= 1;
$grp
= 1;
for
(
$i
= 1;
$i
<=
$#gids
;
$i
++)
{
if
(
$self
->{
'val'
}{
$gids
[
$i
]} <
$self
->{
'val'
}{
$gids
[
$i
-1]} &&
$self
->{
'cover'
})
{
$fmt
= 2;
last
;
}
elsif
(
$gids
[
$i
] ==
$gids
[
$i
-1] + 1)
{
$eff
++; }
else
{
$grp
++; }
}
if
(
$self
->{
'cover'
})
{
$fmt
= 2
if
(
$eff
/
$grp
> 4); }
else
{
$fmt
= 2
if
(
$grp
> 1); }
if
(
$fmt
== 1 &&
$self
->{
'cover'
})
{
my
(
$last
) = 0;
&$shipout
(
pack
(
'n2'
, 1,
scalar
@gids
));
&$shipout
(
pack
(
'n*'
,
@gids
));
}
elsif
(
$fmt
== 1)
{
my
(
$last
) =
$gids
[0];
&$shipout
(
pack
(
"n3"
, 1,
$last
,
$gids
[-1] -
$last
+ 1));
foreach
$g
(
@gids
)
{
if
(
$g
>
$last
+ 1)
{
&$shipout
(
pack
(
'n*'
, 0 x (
$g
-
$last
- 1))); }
&$shipout
(
pack
(
'n'
,
$self
->{
'val'
}{
$g
}));
$last
=
$g
;
}
}
else
{
my
(
$start
,
$end
,
$ind
,
$numloc
,
$endloc
,
$num
);
&$shipout
(
pack
(
"n2"
, 2, 0));
$numloc
=
$fh
->
tell
() - 2
unless
$state
;
$start
= 0;
$end
= 0;
$num
= 0;
while
(
$end
<
$#gids
)
{
if
(
$gids
[
$end
+ 1] ==
$gids
[
$end
] + 1
&&
$self
->{
'val'
}{
$gids
[
$end
+ 1]}
==
$self
->{
'val'
}{
$gids
[
$end
]}
+ (
$self
->{
'cover'
} ? 1 : 0))
{
$end
++;
next
;
}
&$shipout
(
pack
(
"n3"
,
$gids
[
$start
],
$gids
[
$end
],
$self
->{
'val'
}{
$gids
[
$start
]}));
$start
=
$end
+ 1;
$end
++;
$num
++;
}
&$shipout
(
pack
(
"n3"
,
$gids
[
$start
],
$gids
[
$end
],
$self
->{
'val'
}{
$gids
[
$start
]}));
$num
++;
if
(
$state
)
{
substr
(
$out
, 2, 2) =
pack
(
'n'
,
$num
); }
else
{
$endloc
=
$fh
->
tell
();
$fh
->
seek
(
$numloc
, 0);
$fh
->
print
(
pack
(
"n"
,
$num
));
$fh
->
seek
(
$endloc
, 0);
}
}
return
(
$state
?
$out
:
$self
);
}
sub
add
{
my
(
$self
,
$gid
) =
@_
;
return
$self
->{
'val'
}{
$gid
}
if
(
defined
$self
->{
'val'
}{
$gid
});
$self
->{
'val'
}{
$gid
} =
$self
->{
'count'
};
return
$self
->{
'count'
}++;
}
sub
out_xml
{
my
(
$self
,
$context
,
$depth
) =
@_
;
my
(
$fh
) =
$context
->{
'fh'
};
$fh
->
print
(
"$depth<"
. (
$self
->{
'cover'
} ?
'coverage'
:
'class'
) .
">\n"
);
foreach
$gid
(
sort
{
$a
<=>
$b
}
keys
%{
$self
->{
'val'
}})
{
$fh
->
printf
(
"$depth$context->{'indent'}<gref glyph='%s' val='%s'/>\n"
,
$gid
,
$self
->{
'val'
}{
$gid
});
}
$fh
->
print
(
"$depth</"
. (
$self
->{
'cover'
} ?
'coverage'
:
'class'
) .
">\n"
);
$self
;
}
sub
release
{ }
1;