#!/usr/bin/env perl
use
5.010;
my
$args
= new Getopt::Declare
q{
[strict]
[mutex: -h -w]
[mutex: -a -r]
[mutex: -header -n]
-header extract the tune header (record structure)
-d[ump] dump the requested feature with file seek addresses
-a[ll] detailed dump of all field descriptors [requires: -d]
-s[ize] print object size [requires: -d]
-h[tml] format as html
-w[iki] format as a wiki table
-r[elative] show relative addersess in the dump [requires: -d]
<file> input file [required]
}
or
exit
(-1);
my
$file
=
$args
->{
"<file>"
};
-e
$file
or
die
"file '$file' does not exist"
;
-f
$file
or
die
"'$file' is not a plain file"
;
-s
$file
or
die
"'$file' has zero size"
;
open
INPUT,
"<$file"
or
die
"can't open '$file': $!"
;
binmode
INPUT;
my
$file_header
= Finnigan::FileHeader->decode(\
*INPUT
);
my
$seq_row
= Finnigan::SeqRow->decode(\
*INPUT
,
$file_header
->version);
my
$cas_info
= Finnigan::CASInfo->decode(\
*INPUT
);
my
$rfi
= Finnigan::RawFileInfo->decode(\
*INPUT
,
$file_header
->version);
my
$run_header_addr
=
$rfi
->preamble->run_header_addr;
seek
INPUT,
$run_header_addr
, 0;
my
$run_header
= Finnigan::RunHeader->decode(\
*INPUT
,
$file_header
->version);
seek
INPUT,
$run_header
->error_log_addr, 0;
my
$error_log_length
= Finnigan::Decoder->
read
(\
*INPUT
, [
'length'
=> [
'V'
,
'UInt32'
]])->{data}->{
length
}->{value};
foreach
my
$i
( 0 ..
$error_log_length
- 1) {
Finnigan::Error->decode(\
*INPUT
);
}
my
$nsegs
= Finnigan::Decoder->
read
(\
*INPUT
, [
'nsegs'
=> [
'V'
,
'UInt32'
]])->{data}->{nsegs}->{value};
foreach
my
$i
( 0 ..
$nsegs
- 1) {
my
$n
= Finnigan::Decoder->
read
(\
*INPUT
, [
'n'
=> [
'V'
,
'UInt32'
]])->{data}->{n}->{value};
foreach
my
$j
( 0 ..
$n
- 1) {
Finnigan::ScanEventTemplate->decode(\
*INPUT
,
$file_header
->version);
}
}
Finnigan::GenericDataHeader->decode(\
*INPUT
);
my
$header
= Finnigan::GenericDataHeader->decode(\
*INPUT
);
if
(
$header
->n == 0) {
say
STDERR
"tune file not present"
;
exit
;
}
if
(
$args
->{
'-header'
} ) {
if
(
exists
$args
->{-d} ) {
if
(
exists
$args
->{-s} ) {
my
$size
=
$header
->size;
say
"size: $size"
;
}
if
(
exists
$args
->{-a}) {
if
(
exists
$args
->{-h} ) {
$header
->
dump
(
style
=>
'html'
,
filter
=> [
'n'
]);
foreach
my
$i
(0 ..
$header
->n - 1) {
$header
->field(
$i
)->
dump
(
style
=>
'html'
,
header
=>
undef
);
}
}
elsif
(
exists
$args
->{-w} ) {
$header
->
dump
(
style
=>
'wiki'
,
filter
=> [
'n'
]);
foreach
my
$i
(0 ..
$header
->n - 1) {
$header
->field(
$i
)->
dump
(
style
=>
'wiki'
,
header
=>
undef
);
}
}
else
{
$header
->
dump
(
relative
=>
exists
$args
->{-r},
filter
=> [
'n'
]);
foreach
my
$i
(0 ..
$header
->n - 1) {
$header
->field(
$i
)->
dump
(
relative
=>
exists
$args
->{-r});
}
}
}
else
{
if
(
exists
$args
->{-h} ) {
$header
->
dump
(
style
=>
'html'
,
relative
=>
exists
$args
->{-r});
}
elsif
(
exists
$args
->{-w} ) {
$header
->
dump
(
style
=>
'wiki'
,
relative
=>
exists
$args
->{-r});
}
else
{
$header
->
dump
(
relative
=>
exists
$args
->{-r});
}
}
}
else
{
foreach
my
$i
(0 ..
$header
->n - 1) {
say
$header
->field(
$i
)->type
.
"\t"
.
$header
->field(
$i
)->
length
.
"\t"
.
$header
->field(
$i
)->label;
}
}
}
else
{
my
$record
= Finnigan::GenericRecord->decode(\
*INPUT
,
$header
->ordered_field_templates);
if
(
exists
$args
->{-d} ) {
if
(
exists
$args
->{-s} ) {
my
$size
=
$record
->size;
say
"size: $size"
;
}
if
(
exists
$args
->{-h} ) {
$record
->
dump
(
style
=>
'html'
,
relative
=>
exists
$args
->{-r});
}
elsif
(
exists
$args
->{-w} ) {
$record
->
dump
(
style
=>
'wiki'
,
relative
=>
exists
$args
->{-r});
}
else
{
$record
->
dump
(
relative
=>
exists
$args
->{-r});
}
}
else
{
if
(
exists
$args
->{-w} ) {
say
"|| label || value ||"
;
foreach
my
$key
(
sort
{(
split
/\|/,
$a
)[0] <=> (
split
/\|/,
$b
)[0]}
keys
%{
$record
->{data}}) {
my
(
$stripped_key
) = (
$key
=~ /^\d+\|(.*)$/);
$stripped_key
||=
''
;
say
"|| "
.
$stripped_key
.
" || "
.
$record
->{data}->{
$key
}->{value}
.
" ||"
;
}
}
else
{
foreach
my
$key
(
sort
{(
split
/\|/,
$a
)[0] <=> (
split
/\|/,
$b
)[0]}
keys
%{
$record
->{data}}) {
my
(
$stripped_key
) = (
$key
=~ /^\d+\|(.*)$/);
$stripped_key
||=
''
;
say
"$stripped_key\t$record->{data}->{$key}->{value}"
;
}
}
}
}