#!/usr/bin/perl -w
# Copyright ? 2004 Jamie Zawinski <jwz@jwz.org>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as ifs" without express or 
# implied warranty.
#
# Created:  3-Mar-2004 by Jamie Zawinski, Anonymous, and Jacob Post.
##############################################################################
#
# Original: https://www.jwz.org/hacks/mork.pl
# Copyright of the extended version 2024 by Günter Gersdorf <g.gersdorf@ggbs.de>
# Version 1.0 17.01.2024
# https://www.ggbs.de/extensions/mork.pl
#
##############################################################################
#
# This is a program that can read the Mozilla URL history file --
# normally $HOME/.mozilla/default/*.slt/history.dat -- and prints out
# a list of URLs and their time of last access.  With no arguments,
# it prints lines like
#
#	1078333826	1	https://www.jwz.org/hacks/
#
# where the first number is a ctime (number of seconds since Jan 1 1970 GMT)
# and the second number is how many times this URL was visited.  The URLs are
# printed most-recent-first.
#
# With -vv, it prints all the information known about each URL,
# including time of first visit, last visit, document title, etc.
##
##############################################################################
#
# And Now, The Ugly Truth Laid Bare:
#
#   In Netscape Navigator 1.0 through 4.0, the history.db file was just a
#   Berkeley DBM file.  You could trivially bind to it from Perl, and
#   pull out the URLs and last-access time.  In Mozilla, this has been
#   replaced with a "Mork" database for which no tools exist.
#
#   Let me make it clear that McCusker is a complete barking lunatic.
#   This is just about the stupidest file format I've ever seen.
#
#       http://www.mozilla.org/mailnews/arch/mork/primer.txt
#       http://jwz.livejournal.com/312657.html
#       https://www.jwz.org/doc/mailsum.html
#       http://bugzilla.mozilla.org/show_bug.cgi?id=241438
#
#   In brief, let's count its sins:
#
#     - Two different numerical namespaces that overlap.
#
#     - It can't decide what kind of character-quoting syntax to use:
#       Backslash?  Hex encoding with dollar-sign?
#
#     - C++ line comments are allowed sometimes, but sometimes // is just
#       a pair of characters in a URL.
#
#     - It goes to all this serious compression effort (two different 
#       string-interning hash tables) and then writes out Unicode strings
#       without using UTF-8: writes out the unpacked wchar_t characters!
#       without using UTF-8: writes out the unpacked wchar_t characters!
#
#     - Worse, it hex-encodes each wchar_t with a 3-byte encoding,
#       meaning the file size will be 3x or 6x (depending on whether
#       whchar_t is 2 bytes or 4 bytes.)
#
#     - It masquerades as a "textual" file format when in fact it's just
#       another binary-blob file, except that it represents all its magic
#       numbers in ASCII.  It's not human-readable, it's not hand-editable,
#       so the only benefit there is to the fact that it uses short lines
#       and doesn't use binary characters is that it makes the file bigger.
#       Oh wait, my mistake, that isn't actually a benefit at all.
#
# Pure comedy.
#
##############################################################################

#see:
#https://en.wikipedia.org/wiki/Mork_(file_format)
#https://www-archive.mozilla.org/mailnews/arch/mork/primer.txt
#https://www-archive.mozilla.org/mailnews/arch/mork/grammar.txt (V1.1, aktuell ist 1.4)
#https://developer.mozilla.org.cach3.com/en-US/docs/Mozilla/Tech/Mork/Structure

#Thunderbird:
# Addressbooks (*.mab, obsolete, up to TB68)
# Mailbox indexfiles (.msf, still in use)
# Mail folder cache (panacea.dat, obsolete, up to TB91?)
#Firefox:
# History file (history.dat, obsolete)

#scopes:
#ns:msg:db:row:scope:msgs:all
# Die Mails
#   msgThreadId     Referenz zum Thread-Starter
#   threadParent    Referenz auf Thread Parent (-1 wenn keiner)
#ns:msg:db:row:scope:threads:all
# Info über Threads, ID ist dieselbe wie die ID der Mail, die den
#   Thread gestartet hat, ansonsten nur Subjekt
#m
# Info über Threads
#   threadId        Referenz zum ?, sehr oft identisch mit threadRoot
#   threadRoot      Referenz zum Thread-Starter
#   threadNewestMsgDate Zeit des neuesten Mitglieds des Threads
#   threadFlags     immer 0 (jedenfalls in all meinen Ordnern)

#ns:msg:db:row:scope:ops:all
#ns:msg:db:row:scope:pending:all
#ns:msg:db:row:scope:dbfolderinfo:all
# Informationen über den Ordner, z.B. welche Spalten sichtbar sind und an
#   welcher Position (aber nicht die Breite), wonach sortiert wird etc.

#dictionaries:  < .. >
#    dict ::= < (metadict | alias)* >
#    metadict ::= < (cell)* >
#    alias ::= ( id value )
#    value ::= ^oid | =literal
#    oid ::= id | id:scope
#tables:        { .. }
#    table ::= { toid (metatable | row | roid )* }
#    toid ::= oid /*default scope is c*/
#    metatable ::= { (cell)* }
#rows:          [ .. ]
#    row ::= [ roid (metarow | cell)* ]
#    roid ::= oid /*default scope is rowScope from table*/
#    metarow ::= [ (cell)* ]
#    cell ::= ( col slot )
#    col ::= ^oid /*default scope is c*/ | name
#    slot ::= ^oid /*default scope is a*/ | =literal
#cells:         ( .. )
#    cell ::= ( col slot )
#    col ::= ^oid /*default scope is c*/ | name
#    name ::= [a-zA-Z:_] [a-zA-Z:_+-?!]*
#    slot ::= ^oid /*default scope is a*/ | =literal
#    oid ::= id | id:scope
#groups (sections)    @$${x{@ .. @$$}x}@
#    group ::= gather items (commit | abort)
#    gather ::= space @$${ id {@
#    commit ::= space @$$} id }@
#    abort ::= space @$$}~abort~ id }@

require 5;
#use diagnostics;
use strict;
use POSIX qw(strftime);
use Encode qw(decode encode);

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.14 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $verbose = 0;
my $test = 0;

my (%key_table, %val_table, %tables, %refs);
my ($total, $skipped) = (0, 0);

#in scope=ns:msg:db:row:scope:msgs:all
#key='flags'
my %msgflags=( # see https://searchfox.org/comm-esr115/source/mailnews/base/public/nsMsgMessageFlags.idl
  0x00000001 => 'Read',
  0x00000002 => 'Replied',
  0x00000004 => 'Marked',
  0x00000008 => 'Expunged',
  0x00000010 => 'HasRe',
  0x00000020 => 'Elided',       # The children of this sub-thread are folded in the display
  0x00000040 => 'FeedMsg', 
  0x00000080 => 'Offline',      # This news article or IMAP message is present in the disk cache
  0x00000100 => 'Watched',
  0x00000200 => 'SenderAuthed',
  0x00000400 => 'Partial', 
  0x00000800 => 'Queued',
  0x00001000 => 'Forwarded',
  0x00002000 => 'Redirected',
  0x0000E000 => 'Priority=13', 
  0x00010000 => 'New',
  0x00040000 => 'Ignored',
  0x00200000 => 'IMAPDeleted',
  0x00400000 => 'MDNReportNeeded',
  0x00800000 => 'MDNReportSent',
  0x01000000 => 'Template',
  0x10000000 => 'Attachment',   # This message has files attached to it
  0x0E000000 => 'Labels=25',
 );
my @msgflags_keys=sort {$a <=> $b} keys %msgflags;


#in scope=ns:msg:db:row:scope:dbfolderinfo:all
#key='flags'
my %folderflags=( # see https://searchfox.org/comm-esr115/source/mailnews/base/public/nsMsgFolderFlags.idl
  0x00000001 => 'Newsgroup',
  0x00000002 => 'Unused3',
  0x00000004 => 'Mail',
  0x00000008 => 'Directory',
  0x00000010 => 'Elided',   #Whether the children of this folder are currently hidden in the listing
  0x00000020 => 'Virtual',
  0x00000040 => 'Unused5', 
  0x00000080 => 'Unused2',
  0x00000100 => 'Trash',
  0x00000200 => 'SentMail',
  0x00000400 => 'Drafts', 
  0x00000800 => 'Queue',
  0x00001000 => 'Inbox',
  0x00002000 => 'ImapBox',
  0x00004000 => 'Archive', 
  0x00008000 => 'Unused1', 
  0x00010000 => 'Unused4',
  0x00020000 => 'Unused7',
  0x00040000 => 'Unused6',
  0x00080000 => 'ImapPersonal',
  0x00100000 => 'ImapPublic',
  0x00200000 => 'ImapOtherUser',
  0x00400000 => 'Templates',
  0x00800000 => 'PersonalShared',
  0x01000000 => 'ImapNoselect',
  0x02000000 => 'CreatedOffline',
  0x04000000 => 'ImapNoinferiors',
  0x08000000 => 'Offline',
  0x10000000 => 'OfflineEvents',
  0x20000000 => 'CheckNew',
  0x40000000 => 'Junk',
  0x80000000 => 'Favorite',
 );
my @folderflags_keys=sort {$a <=> $b} keys %folderflags;

#key='sortType', 'sortColumns'
my %foldersorttype=( # see https://searchfox.org/comm-esr115/source/mailnews/base/public/nsIMsgDBView.idl
  0x11 => 'byNone',
  0x12 => 'byDate',
  0x13 => 'bySubject',
  0x14 => 'byAuthor',
  0x15 => 'byId',
  0x16 => 'byThread',
  0x17 => 'byPriority',
  0x18 => 'byStatus',
  0x19 => 'bySize',
  0x1a => 'byFlagged',
  0x1b => 'byUnread',
  0x1c => 'byRecipient',
  0x1d => 'byLocation',
  0x1e => 'byTags',
  0x1f => 'byJunkStatus',
  0x20 => 'byAttachments',
  0x21 => 'byAccount',
  0x22 => 'byCustom',
  0x23 => 'byReceived',
  0x24 => 'byCorrespondent'
);
#key='sortOrder', 'sortColumns'
my %foldersortorder=( # see https://searchfox.org/comm-esr115/source/mailnews/base/public/nsIMsgDBView.idl
  0 => 'none',
  1 => 'ascending',
  2 => 'descending'
);
#key='viewFlags'
my %folderviewflags=( # see https://searchfox.org/comm-esr115/source/mailnews/base/public/nsIMsgDBView.idl
  #kNone = 0x0;
  0x1  => 'kThreadedDisplay',
  0x8  => 'kShowIgnored',
  0x10 => 'kUnreadOnly',
  0x20 => 'kExpandAll',
  0x40 => 'kGroupBySort'
);
my @folderviewflags_keys=sort {$a <=> $b} keys %folderviewflags;
#key='viewType'
my %folderviewtype=( # see https://searchfox.org/comm-esr115/source/mailnews/base/public/nsIMsgDBView.idl
  0 => 'eShowAllThreads',
  2 => 'eShowThreadsWithUnread',
  3 => 'eShowWatchedThreadsWithUnread',
  4 => 'eShowQuickSearchResults',
  5 => 'eShowVirtualFolderResults',
  6 => 'eShowSearch'
);

#in scope=m
#key='threadFlags (seems to be the same as msgflags, but is always zero)
my %threadFlags=(
);

#in scope=ns:msg:db:row:scope:ops:all
#key='op'
my %ImapOpsFlags=(  # see https://searchfox.org/comm-esr115/source/mailnews/db/msgdb/public/nsIMsgOfflineImapOperation.idl
  0x1   => 'kFlagsChanged',
  0x2   => 'kMsgMoved',
  0x4   => 'kMsgCopy',
  0x8   => 'kMoveResult',
  0x10  => 'kAppendDraft',
  0x20  => 'kAddedHeader',
  0x40  => 'kDeletedMsg',
  0x80  => 'kMsgMarkedDeleted',
  0x100 => 'kAppendTemplate',
  0x200 => 'kDeleteAllMsgs',
  0x400 => 'kAddKeywords',
  0x800 => 'kRemoveKeywords'
);
my @ImapOpsFlags_keys=sort {$a <=> $b} keys %ImapOpsFlags;

#key='newFlags'?
my %ImapMsgFlags=(  # see https://searchfox.org/comm-esr115/source/mailnews/imap/src/nsImapCore.h
#define kNoImapMsgFlag                0x0000
#define kImapMsgSeenFlag              0x0001
#define kImapMsgAnsweredFlag          0x0002
#define kImapMsgFlaggedFlag           0x0004
#define kImapMsgDeletedFlag           0x0008
#define kImapMsgDraftFlag             0x0010
#define kImapMsgRecentFlag            0x0020
#define kImapMsgForwardedFlag         0x0040  /* Not always supported, check mailbox folder */
#define kImapMsgMDNSentFlag           0x0080  /* Not always supported. check mailbox folder */
#define kImapMsgCustomKeywordFlag     0x0100  /* this msg has a custom keyword */
#define kImapMsgSupportMDNSentFlag    0x2000
#define kImapMsgSupportForwardedFlag  0x4000
);

my %table_sort = (
  'ns:msg:db:row:scope:msgs:all'		     => ' 0 ',
  'ns:msg:db:row:scope:dbfolderinfo:all' => ' 1 ',
  'ns:msg:db:row:scope:threads:all'      => ' 2 ',
  'm'		                                 => ' 3 ',
  'ns:msg:db:row:scope:ops:all'          => ' 4 ',
  'ns:msg:db:row:scope:pending:all'      => ' 5 ',
  'ns:addrbk:db:row:scope:card:all'      => ' 6 ',
  'ns:addrbk:db:row:scope:data:all'      => ' 7 ',
  'ns:addrbk:db:row:scope:list:all'      => ' 8 ',
  'ns:msg:db:row:scope:folders:all'      => ' 9 ',
  'ns:history:db:row:scope:history:all'  => ' 10 '
);
my %key_sort = (
  'ID'		          => ' 0 ',
  '_scope'          => ' 1 ',
  '_section'        => ' 2 ',
  '_info'           => ' 3 ',
  'date'		        => ' 4 ',
  'dateReceived'	  => ' 5 ',
  'sender'	        => ' 6 ',
  'recipients'      => ' 7 ',
  'subject'	        => ' 8 ',
  'size'	          => ' 9 '
);

# Returns a list of hashes, the contents of the mork file.
#
sub mork_parse_file {
  my ($file) = @_;
  local $/ = undef;
  local *IN;

  ##########################################################################
  # Define the messy regexen up here
  ##########################################################################

  my $top_level_comment = qr@//.*\n@;

  my $key_table_re = qr/  < \s* <             # "< <"
                         \( a=c \) >          # "(a=c)>"
                         (?> ([^>]*) ) > \s*  # Grab anything that's not ">"
                     /sx;

  my $value_table_re = qr/ < ( .*?\) )> \s* /sx;

  my $table_re = qr/ \{ ( -?        # "{" or "{-"
                    [\da-f]+ :    # hex, ":"
                    (?> .*?\{ ))   # Eat up to a {...
                   ((?> .*?\} )   # and then the closing }...   (the metatable)
                    (?> .*?\} ))  # Finally, grab the table section
                 \s* /six;

  my $row_re = qr/ ( (?> \[ [^]]* \]  # "["..."]"
                         \s*)+ )      # Perhaps repeated many times
                 /sx;

  my $section_begin_re = qr/ \@\$\$\{    # "@$${"
                             ([\dA-F]+)  # hex
                             \{\@ \s*    # "{@"
                           /six;

  my $section_end_re = undef;
  my $section = "top level";

  ##########################################################################
  # Read in the file.
  ##########################################################################
  open (IN, "<$file") || error ("$file: $!");
  print STDERR "reading $file...\n" if ($verbose);

  my $body = <IN>;
  close IN;

  $body =~ s/\r\n/\n/gs;    # Windows Mozilla uses \r\n
  $body =~ s/\r/\n/gs;      # Presumably Mac Mozilla is similarly dumb

  $body =~ s/\\\\/\$5C/gs;  # Sometimes backslash is quoted with a
                            #  backslash; convert to hex.
  $body =~ s/\\\)/\$29/gs;  # close-paren is quoted with a backslash;
                            #  convert to hex.
  $body =~ s/\\\n//gs;      # backslash at end of line is continuation.

  # convert [] in 'received' lines
  $body =~ s/\[\]/\$5B\$5D/gs;
  $body =~ s/\[unix socket\]/\$5Bunix socket\$5D/gs;
  $body =~ s/\[Authenticated ID \((\d+)\$29\]/\$5BAuthenticated ID ($1\$29\$5D/gs; #[Authenticated ID (679844\)]
  $body =~ s/\[(\d+\.\d+\.\d+\.\d+)\]/\$5B$1\$5D/gs;    #ipv4 addresses
  $body =~ s/\[((?:IPv6)?[\da-f\.:%]+)\]/\$5B$1\$5D/gsi; #ipv6 addresses
  # convert } in json values
  sub rep { my $s=shift; $s=~s/}/\$7D/g; $s; }
  $body =~ s/(\=\{.*?\}\))/rep($1)/egs;

if ($verbose>1) {
  (my $o=$file)=~s/.*[\/\\]//;
  $o=~s/\.msf$/.mod.msf/;
  open O,">T:/temp/$o";
  binmode O;
  print O $body;
  close O;
  (my $d=$file)=~s/.*[\/\\]//;
  $d=~s/\.msf$/.debug.txt/;
  print STDERR "Creating T:/temp/$d\n";
  open D,">T:/temp/$d";
}

  ##########################################################################
  # Figure out what we're looking at, and parse it.
  ##########################################################################

  print STDERR "parsing...\n" if ($verbose);

  pos($body) = 0;
  my $length = length($body);

  while( pos($body) < $length ) {

    # Key table

    if ( $body =~ m/\G$key_table_re/gc ) {
print D "##Parse key table at ".pos($body)."\n" if $verbose > 1;
print D "++KT++$1%%\n" if $verbose > 1;
      mork_parse_key_table($section, $1);

    # Values
    } elsif ( $body =~ m/\G$value_table_re/gco ) {
print D "##Parse value table at ".pos($body)."\n" if $verbose > 1;
print D "++VT++$1%%\n" if $verbose > 1;
      mork_parse_value_table($section, $1);

    # Table
    } elsif ( $body =~ m/\G$table_re/gco ) {
print D "##Parse table at ".pos($body)."\n" if $verbose > 1;
print D "++RT++$1||$2%%\n" if $verbose > 1;
      mork_parse_table($section, $2, $1);

    # Rows (-> table)
    } elsif ( $body =~ m/\G$row_re/gco ) {
print D "##Parse table row at ".pos($body)."\n" if $verbose > 1;
print D "++TR++$1%%\n" if $verbose > 1;
      mork_parse_table($section, $1, '');

    # Section begin
    } elsif ( $body =~ m/\G$section_begin_re/gco ) {
      if ($section ne "top level") {
print D "##Section abort at ".pos($body)."\n" if $verbose > 1;
print D "++SA++$section%%\n" if $verbose > 1;
      }
print D "##Section begin at ".pos($body)."\n" if $verbose > 1;
print D "++SB++$1%%\n" if $verbose > 1;
      $section = $1;
      $section_end_re = qr/\@\$\$\}$section\}\@\s*/s;

    # Section end
    } elsif ( $section_end_re && $body =~ m/\G$section_end_re/gc ) {
print D "##Section end at ".pos($body)."\n" if $verbose > 1;
print D "++SE++$section%%\n" if $verbose > 1;
      $section_end_re = undef;
      $section = "top level";

    # Comment
    } elsif ( $body =~ m/\G$top_level_comment/gco ) {
print D "##Comment at ".pos($body)."\n" if $verbose > 1;
      #no-op

    } else {
      $body =~ m/\G (.{0,300}) /gcsx;
print D "##Cannot parse $1 at ".pos($body)."\n" if $verbose > 1;
      error("$section: Cannot parse");
    }
  }

  if($section_end_re) {
    error("Unterminated section $section");
  }

if ($verbose>1) {
  close D;
}

  return;
}


##########################################################################
# parse a row and column table
##########################################################################

sub mork_parse_table {
  my($section, $meta_table_part, $id_part) = (@_);

print D "++Meta+TablePart%%$meta_table_part%%\n" if $verbose>2;

  my $mscope='';
  my $sid;
  my $tid;
  my $refs;
  my $trefs;
  if ($id_part) { #  7:^80 {
print D "++IdPart%%$id_part%%\n" if $verbose>2;
    ($tid, $sid)=$id_part=~/\s*(-?[\da-fA-F]+):\^([^\s]+)\s*{$/;
#e.g.:
#{1:^80 {(k^96:c)(s=9)} ids* }              contains all mails
# 80=ns:msg:db:row:scope:msgs:all 96=ns:msg:db:table:kind:msgs
# kommt sehr oft vor, aber immer immer 1:^80 und k^96 zusammen
#{x:^80 {(k^97:c)(s=9)1:m } ids* }          contains a thread
# 80=ns:msg:db:row:scope:msgs:all 97=ns:msg:db:table:kind:thread
# kommt oft vor, immer mit x:^80 und k^97 und y:m dahinter
#{FFFFFFFD:^99 {(k^98:c)(s=9)}              seems to contain thread starter
# 99=ns:msg:db:row:scope:threads:all 98=ns:msg:db:table:kind:allthreads
# kommt oft vor, immer mit FFFFFFFD:^99 und k^98
#{1:^9E {(k^9F:c)(s=9)}                    folder
# 9E=ns:msg:db:row:scope:dbfolderinfo:all 9F=ns:msg:db:table:kind:dbfolderinfo
# genau einmal für den ordner
#{-1:^C0 {||(k^C1:c)(s=9)}
# C0=ns:msg:db:row:scope:pending:all C1=ns:msg:db:table:kind:pending
# gelegentlich, immer mit -1:^C0 und k^C1
#{-1:^D4 {||(k^D5:c)(s=9)}
# D4=ns:msg:db:row:scope:ops:all D5=ns:msg:db:table:kind:ops
# gelegentlich, immer mit -1:^D4 und k^C5
#die k^nn sind die defaults für reine rowids innerhalb der table
    $mscope=$key_table{$sid};
print D "++Id-Scope%%$tid-$mscope%%\n" if $verbose>2;
    if ($refs{"$sid:$tid"}) {
print D "++Refs reuse%%$sid:$tid%%\n" if $verbose>2;
      $refs=$refs{"$sid:$tid"};
    } else {
print D "++Refs new%%$sid:$tid%%\n" if $verbose>2;
      $refs=$refs{"$sid:$tid"}={};
    }
  }

  my ($meta_part, $table_part)=$meta_table_part=~m/^([^\}]*\})?(.*)$/s;
  $meta_part='' if !defined $meta_part;
  if ($meta_part) {
print D "++MetaPart%%$meta_part%%\n" if $verbose>2;
#leer
#(k^96:c)(s=9)}             ns:msg:db:table:kind:msgs             oft
#(k^97:c)(s=9)100:m }       ns:msg:db:table:kind:thread           oft, aber jeder Wert (statt 100) nur einmal
#(k^98:c)(s=9)}             ns:msg:db:table:kind:allthreads       oft
#(k^9F:c)(s=9)}             ns:msg:db:table:kind:dbfolderinfo     einmal
#(k^C1:c)(s=9)}             ns:msg:db:table:kind:pending          gelegentlich
#(k^D5:c)(s=9)}             ns:msg:db:table:kind:ops              gelegentlich
#(k^81:c)(s=9)[1(^8C=LE)]}  ns:history:db:row:scope:history:all   history.dat
#   there might be 's=9u'
    my ($kind, $thread)=$meta_part=~/^\(k\^([\dA-F]+):c\)\(s=9u?\)(?:([\dA-F]+):m\s+)?\}$/;
    if (!$kind) { #check history
      ($kind, my $xid, my $cell)=$meta_part=~/^\(k\^([\dA-F]+):c\)\(s=9u?\)\[(.*)\((.*)\)\]\}$/;
#print STDERR "Metapart in history.dat: '$kind' with id='$xid' and cell '$cell'\n";
#                     cell: ^8C=LE      #8C probably 'ByteOrder', LE='LowEndian'?
      #TODO ???
    }
print STDERR "Metapart '$meta_part' not parsed\n" if !$kind;
print D "!!Metapart not parsed\n" if !$kind && $verbose>2;
    $thread='' if !defined $thread;
#print D "!!kind and thread illegal\n" if $thread && $kind ne '97' || !$thread && $kind eq '97' && $verbose>2;
print D "++Kind+Thread%%$kind%%$thread%%\n" if $verbose>2;
    if ($thread) {
      if ($refs{"m:$thread"}) {
print D "++Refs reuse%%m:$thread%%\n" if $verbose>2;
        $trefs=$refs{"m:$thread"};
      } else {
print D "++Refs new%%m:$thread%%\n" if $verbose>2;
        $trefs=$refs{"m:$thread"}={};
      }
    }
  }

print D "++TablePart%%$table_part%%\n" if $verbose>2;
  my $rows=0;
  my $singleminus=0;

  #Grab each complete [...] block or rowids
  while( $table_part =~ m/\G \s* (?: (-?[\da-fA-F]*) |  # find a rowid     
                           \[ ( [^]]+ ) \]        # find a "[" and capture up to "]"
                        ) /gcx ) {
#TODO: erkennt keine 'metarow' innerhalb der row, kommt aber anscheinend nicht vor
    $rows++;
    if ($1) {
      $_ = $1;
print D "++NextPart is RowID%%$_%%\n" if $verbose>2;
      if ($_ eq '-') {
print D "!!RowID is single minus\n" if $_ eq '-' && $verbose>2;
        $singleminus=1; # gilt nur für die nächste id (which is a row with rowid only)
      } else {
#print D "!!x RowId with single minus\n" if $singleminus && $verbose>2;
        my ($m, $id, $d, $scope)=$_=~/^(-?)([\da-zA-Z]+)(:(.*))?$/;
#print D "!!x RowId with scope\n" if defined $scope && $verbose>2;
        #if ($singleminus) ... # kommt nicht vor!
#print D "!!x id $id added as rowID in refs for $sid:$tid\n" if $id_part && $verbose>2;
        $$refs{$id}=1 if $refs;
        $$trefs{$id}=1 if $trefs;
      }
    } elsif ($2) {
      $_ = $2;
print D "++NextPart is Row%%$_%%\n" if $verbose>2;
#print D "!!NextPart is Row with single minus\n" if $singleminus && $verbose>2;

      my ($oid, $cells) = split (m/[(]/s, $_, 2);
#print D "  oid|cells%%$oid|$cells%%\n" if $verbose>3;
      $oid=~s/\s+$//;

#TODO: work with singleminus and oid only
      my ($m, $id, $d, $scope)=$oid=~/^(-?)([\da-zA-Z]+)(:(.*))?$/;
      $m='' if !defined $m;
      #$m eq '-' means: all values are reset ???
      if (!defined $scope || $scope eq '') {
        $scope=$mscope;
      } else {
        $scope=$key_table{$1} if $scope=~/^\^(.*)$/;
      }
#print D "!!scope differs mscope=$mscope scope=$scope\n" if $verbose>2;
#  if ($mscope && $mscope ne $scope);    # kommt nicht vor
#print D "!!no scope\n" if !$scope && $verbose>2;    # kommt nicht vor

      if ($id_part) {
        if ($singleminus) {
#print D "!!x id $id removed from refs for $sid:$tid\n" if $verbose>2;
          delete $$refs{$id};
          $singleminus=0;
        } else {
#print D "!!x id $id added as row in refs for $sid:$tid\n" if $verbose>2;
          $$refs{$id}=1;
          $$trefs{$id}=1 if $trefs;
        }
      }
      next unless defined $cells;
#print D "  Splitting cells%%$cells%%\n" if $verbose>3;

      my @cells = split (m/[)]/s, $cells);
      next unless scalar(@cells); #kommt nicht vor

      my $hash;
      my $table;

      if ($tables{$scope}) {
        $table=$tables{$scope};
#print D "!!Reuse table for $scope%%\n" if $verbose>2;
      } else {
        $table={};
#print D "!!New table for $scope%%\n" if $verbose>2;
        $tables{$scope}=$table;
      }

#print D "!!Id with minus, but hash not found\n" if $m eq '-' && !$table->{$id} && $verbose>2;
print D "!!Id not defined\n" if !$id && $verbose>1;

#1    my $reuse=0;
      if ($table->{$id}) {
#1   print D "!!Reuse hash for $scope|$id%%\n" if $verbose>2;
        $hash = $table->{$id};
#1   $reuse=1;
#1   #outhash(\%hash, \*D) if ($verbose>2);
      } else {
#1 print D "!!New hash for $scope|$id%%\n" if $verbose>2;
#2 # nee. Das - meint doch noch was anderes
#2 print STDERR "should reuse table $scope|$id but does not exist\n" if $m eq '-';
#2 print D "!!should reuse table $scope|$id but does not exist\n" if $m eq '-' && $verbose>2;
        $hash = { 'ID'    => $id,
                  '_sort' => id2dec($id),
                  '_section' => $section,
                  '_scope'   => $scope
                };
      }

      foreach (@cells) {
        s/^\s*\(//s;
        next unless $_;
print D "++Cell%%$_%%\n" if $verbose>3;
          #
        my ($keyi, $which, $vali) =
          m/^\^ ([-\dA-F]+)
                \s*([\^=])
                (.*)     
            $/xi;
#print D "  Cell parsed keyi|which%%$keyi|$which\n" if $verbose>3;

        error ("unparsable cell: $_\n") unless defined ($vali);

        # If the key isn't in the key table, ignore it
        #
        my $key = $key_table{$keyi};
        next unless defined($key);

        my $val  = ($which eq '='
                    ? $vali
                    : $val_table{$vali});

#1 if ($reuse && $verbose>2) {
#1   if (defined $hash->{$key}) {
#1     print D "Reset $key from ".$hash->{$key}." -> $val\n" if $verbose>2;
#1   } else {
#1     print D "Set $key -> $val\n" if $verbose>2;
#1   }
#1}
        $hash->{$key} = $val;
      }
#1 #if ($reuse && $verbose>2) {
#1 #print D "jetzt:\n";
#1 #outhash($hash, \*D);
#1 #}
      $total++;
      $table->{$id}=$hash if $id;
    }
  }
#print D "  finished mork_parse_table\n" if $verbose>3;

  if (!$rows) {
    print D "!!Parse of Table fails\n" if $verbose>2;
#there are tables like:
#{1:^80 {(k^96:c)(s=9)} -
#  [-439B]}
# with a - sign in place of a rowid
  }

#3 if ($meta_part) {
#3   if ($rows) {
#3     print D "!!Table with rows and meta_table:$meta_part\n" if $verbose>2;
#3   } else {
#3     print D "!!Table without rows and meta_table:$meta_part\n" if $verbose>2;
#3   }
#3 } elsif (!$rows) {
#3 #kommt nicht vor
#3   print STDERR "Table without rows and no meta_table\n";
#3   print D "!!Table without rows and no meta_table\n" if $verbose>2;
#3 }

}

##########################################################################
# parse a values table
##########################################################################

sub mork_parse_value_table {
  my($section, $val_part) = (@_);

  return unless $val_part;

  my @pairs = split (m/\(([^\)]+)\)/, $val_part);
  $val_part = undef;

  foreach (@pairs) {
    next unless (m/[^\s]/s);
    my ($key, $val) = m/([\dA-F]*)[\t\n ]*=[\t\n ]*(.*)/i;

    if (! defined ($val)) {
print D "##Section $section: unparsable val: $_\n" if $verbose>1;
      print STDERR "Section $section: unparsable val: $_\n";
      next;
    }

    # Assume that URLs and LastVisited are never hexilated; so
    # don't bother unhexilating if we won't be using Name, etc.
    if($val =~ m/\$/) {
      # Approximate wchar_t -> ASCII and remove NULs
      $val =~ s/\$00//g;  # faster if we remove these first
      $val =~ s/\$0D//g;  # remove CR, the LF reinserts it
      $val =~ s/(?<!\\)\$([\dA-F]{2})/chr(hex($1))/gei;   # not \$...
#      $val =~ s/\\\$/\$/g; # no, needed later
    }

if (defined $val_table{$key}) {
  print D "value key $key already set\n";
  print D " was ".$val_table{$key}."\n";
  print D " now ".$val."\n";
}
    $val_table{$key} = $val;
    print D "Section $section: val $key = \"$val\"\n"
      if ($verbose > 3);
  }
}


##########################################################################
# parse a key table
##########################################################################

sub mork_parse_key_table {
  my ($section, $key_table) = (@_);

  $key_table =~ s@\s+//.*$@@gm;   # remove comments

  my @pairs = split (m/\(([^\)]+)\)/s, $key_table);
  $key_table = undef;

  foreach (@pairs) {
    next unless (m/[^\s]/s);
    my ($key, $val) = m/([\dA-F]+)\s*=\s*(.*)/i;
    error ("$section: unparsable key: $_") unless defined ($val);

if (defined $key_table{$key}) {
  print D "key key $key already set\n";
  print D " was ".$key_table{$key}."\n";
  print D " now ".$val."\n";
}
    $key_table{$key} = $val;
    print D "Section $section: key $key = \"$val\"\n"
      if ($verbose > 3);
  }
}


sub output {
  my ($sids) = @_;

#use Data::Dumper;
#print "Tables\n";
#print Dumper(%tables);
#print "Refs\n";
#print Dumper(%refs);

  my $msgs=$tables{"ns:msg:db:row:scope:msgs:all"};
  my $refs=$refs{"80:1"};
  foreach my $k (keys %$msgs) {
#    print STDERR "msg $k not in refs\n" if !exists $refs->{$k};
    #alle negativen (FFFFFFxx) ids
    if (!exists $refs->{$k}) {
      my $hash=$msgs->{$k};
      $hash->{_info}='Message deleted';
    }
  }
#  foreach my $k (keys %$refs) {
#    print STDERR "ref $k not in messages\n" if !exists $msgs->{$k};
#  }

  if ($test) {
    $sids=[];
    my $table=$tables{"m"};
    while (my ($key, $hash)=each %$table) {
      if ($hash->{threadFlags} != '0') {
print STDERR "nonzero threadFlag $key\n";
        push (@$sids, "m|0x$key");
      }
      if ($hash->{threadId} ne $hash->{threadRoot}) {
print STDERR "different thread references $key\n";
        push (@$sids, "m|0x$key");
      }
    }
    exit(0) if !@$sids;
    #make sids uniq
  }

  if (@$sids) {
    my $mainscope=$key_table{'80'};
    # ns:msg:db:row:scope:msgs:all
    # ns:addrbk:db:row:scope:card:all
#print "Mainscope=$mainscope\n";
    foreach my $sid (@$sids) {
      my $hash;
      my $scope;
      if ($sid eq 'f') {
        $hash=$tables{"ns:msg:db:row:scope:dbfolderinfo:all"}->{'1'};
      } else {
        my $rsid='';
        if ($sid=~/^(.*)\|(.*)$/) {
          $scope=$1;
          $sid=$2;
        } else {
          $scope=$mainscope;
        }
        if ($sid=~/^0[xX](.*)/) { $rsid=uc($1); }
        elsif ($sid ne '') { $rsid=sprintf("%X", $sid); }
        $hash=$tables{$scope}{$rsid};
      }
      if (!defined $hash) { print STDERR "Id '$sid' not found\n"; }
      else { outhash($hash, \*STDOUT) };
    }
  } else {

    foreach my $tableid ( sort { $table_sort{$a} cmp $table_sort{$b} } keys(%tables)) {
      print "\n==========================================================\n";
      print "$tableid\n\n";
      my $table=$tables{$tableid};
      foreach my $rowid ( sort { $table->{$b}->{_sort} <=> $table->{$a}->{_sort} } keys(%$table)) {
        outhash($table->{$rowid}, \*STDOUT);
      }
    }

=pod
    print "\n==========================================================\n";
    my $refs=$refs{"99:FFFFFFFD"};
    my $keys=join(' ', keys %$refs);
    if ($keys) {
      print "\nRefs for ns:msg:db:row:scope:threads:all\n  ";
      print $keys."\n";
      $msgs=$tables{"ns:msg:db:row:scope:threads:all"};
      foreach my $k (keys %$msgs) {
        print "thread $k not in refs\n" if !exists $refs->{$k};
      }
      foreach my $k (keys %$refs) {
        print "ref $k not in threads\n" if !exists $msgs->{$k};
      }
    }

#    $refs=$refs{"9E:-1"};    # is empty
#    $keys=join(' ', keys %$refs);
#    if ($keys) {
#      print "Refs for ns:msg:db:row:scope:dbfolderinfo:all\n  ";
#      print $keys."\n";
#    }

    $refs=$refs{"C0:-1"};
    $keys=join(' ', keys %$refs);
    if ($keys) {
      print "\nRefs for ns:msg:db:row:scope:pending:all\n  ";
      print $keys."\n";
      $msgs=$tables{"ns:msg:db:row:scope:pending:all"};
      foreach my $k (keys %$msgs) {
        print "pending $k not in refs\n" if !exists $refs->{$k};
      }
      foreach my $k (keys %$refs) {
        print "ref $k not in pending\n" if !exists $msgs->{$k};
      }
    }

    $refs=$refs{"D4:-1"};
    $keys=join(' ', keys %$refs);
    if ($keys) {
      print "\nRefs for ns:msg:db:row:scope:ops:all\n  ";
      print $keys."\n";
      $msgs=$tables{"ns:msg:db:row:scope:ops:all"};
      foreach my $k (keys %$msgs) {
        if (!exists $refs->{$k}) {
          if ($msgs->{$k}{op}) {
            print "ops $k not in refs and 'op' is nonzero\n";
          } else {
            print "ops $k not in refs (expected, since 'op' is zero)\n";
          }
        }
      }
      foreach my $k (keys %$refs) {
        print "ref $k not in ops\n" if !exists $msgs->{$k};
      }
    }
=cut
  }
}
sub outhash {
  my $hash=shift;
  my $fh=shift;

  foreach my $key (sort { ($key_sort{$a} || lc($a)) cmp
                          ($key_sort{$b} || lc($b))
                        } (keys(%$hash))) {
    next if $key eq '_sort';
    my $v=my $val = $hash->{$key};
    next if $key eq '_scope' && $v eq '' && !$verbose;
    next if $key eq '_section' && $v eq 'top level' && !$verbose;
    if ($key eq 'date' || $key eq 'dateReceived'
        || $key eq 'threadNewestMsgDate' || $key eq 'folderDate' ||
            length($val) == 8 && $key eq 'LastModifiedDate' ) {
      $val .= ' ('.localtime (hex($val)).')';
    } elsif ($key eq 'MRMTime' || $key eq 'MRUTime' ||
            length($val) > 8 && $key eq 'LastModifiedDate') {
      $val .= ' ('.localtime ($val).')';
    } elsif ($key eq 'FirstVisitDate' || $key eq 'LastVisitDate') {
      $val .= ' ('.localtime ($val/1000000).')';
    } elsif ($key=~/Cellular|Phone|Zip/) {
      #nothing to do, but dn't treat as hex
    } elsif ($key eq 'flags' || $key eq 'newFlags') {
      my $h=hex($v);
      $val.=' (';
      if ($hash->{_scope}=~/dbfolderinfo/) {
        foreach my $f (@folderflags_keys) {
          my $v=$folderflags{$f};
          $val.=' '.$v if $f&$h;
        }
      } else {
        foreach my $f (@msgflags_keys) {
          my $v=$msgflags{$f};
          $v.=($f&$h)>>int($1) if $v=~s/=(\d+)$/=/ ;
          $val.=' '.$v if $f&$h;
        }
      }
      $val.=' )';
    } elsif ($key eq 'folderSize') {
      if ($val eq 'ffffffffffffffff') { $val='-1'; }
      #elsif ($val ne 0) { $val=$val.' ('.hex($val).')'; }
      elsif ($val ne '0') { $val=hex($val); }
    } elsif ($key eq 'hierDelim') {
      $val=chr(hex($val));
    } elsif ($key eq 'sortType') {    # if ($tableid=~/dbfolderinfo/)
      $val.=' ( '.$foldersorttype{hex($v)}.' )';
    } elsif ($key eq 'sortOrder') {   # if ($tableid=~/dbfolderinfo/)
      $val.=' ( '.$foldersortorder{$v}.' )';
    } elsif ($key eq 'sortColumns') {
      my $i=0;
      $val='';
      my $p1=substr($v, $i, 1);
      my $p2=substr($v, $i+1, 1);
      $val.=sprintf(" %s (%s)", $foldersorttype{ord($p1)}, $foldersortorder{$p2});
      $i+=2;
      if ($i<length($v)) {
        $p1=substr($v, $i, 1);
        $p2=substr($v, $i+1, 1);
        $val.=sprintf(" %s (%s)", $foldersorttype{ord($p1)}, $foldersortorder{$p2});
        $i+=2;
        if ($i<length($v)) {
          my $r=substr($v, $i);
          $val.=' '.$r if $r;
        }
      }
    } elsif ($key eq 'viewFlags') {
      my $h=hex($v);
      $val.=' (';
      #if ($hash->{_scope}=~/dbfolderinfo/) {
      foreach my $f (@folderviewflags_keys) {
        my $v=$folderviewflags{$f};
        $val.=' '.$v if $f&$h;
      }
      $val.=' )';
    } elsif ($key eq 'viewType') {    # if ($hash->{_scope}=~/dbfolderinfo/)
      $val.=' ( '.$folderviewtype{hex($v)}.' )';
    } elsif ($key eq 'op') {    # if ($hash->{_scope}=~/ops/)
      my $h=hex($v);
      $val.=' (';
      #if ($hash->{_scope}=~/ops/) {
      foreach my $f (@ImapOpsFlags_keys) {
        my $v=$ImapOpsFlags{$f};
        $val.=' '.$v if $f&$h;
      }
      $val.=' )';
    } elsif ($val=~/^[\da-fA-F]{1,8}$/) { #else might be a telephone number
#        if ($val eq 'ffffffff')  { $val="$val (-1)"; }
#        elsif (hex($val)>=10)    { $val="$val (".hex($val).")"; }
      my $d=id2dec($val);
      if ($d>=10 || $d<0)    { $val="$val ($d)"; }
    } else {
      $val =~ s/(?<!\\)\$([\dA-F]{2})/chr(hex($1))/gei; 
      $val =~ s/\\\$/\$/g;
      if ($val=~/\?[qb]}?/i)  {
        my $nval=decode('MIME-Header', $val);
#        $val.=sprintf ("\n%16s = %s", '', decode("ISO-8859-1", $nval)) if $nval ne $val;
#        $val.=sprintf ("\n%16s = %s", '', $nval) if $nval ne $val;
        $val.=sprintf ("\n%16s = %s", '', encode("UTF-8", $nval)) if $nval ne $val;
      }
    }

    print $fh sprintf ("%16s = %s\n", $key, $val);
  }
  my $id=$hash->{'ID'};
  my $refs;
  if ($hash->{_scope} eq 'ns:msg:db:row:scope:msgs:all') {
    $refs=$refs{"80:$id"} if $id ne '1';
  } elsif ($hash->{_scope} eq 'm') {  # das kann nicht wirklich stimmen
    $refs=$refs{"m:$id"};
  }
  if ($refs) {
    print $fh sprintf ("%16s = %s\n", '_refs', join(' ', sort keys %$refs));
  }
  print $fh "\n";
}
sub id2dec {
  my $id=shift;
  my $hid=hex($id);
  if ($hid&0x80000000) {
    return unpack('l>', pack('H8', $id));
  } else {
    return $hid;
  }
}

sub error {
  ($_) = @_;
  print STDERR "$_\n";
  exit 1;
}

sub usage {
  print STDERR "usage: $progname [--verbose] " .
                    "file.msf [ id ]\n";
  exit 1;
}

sub main {
  my ($file);
  my @sids;
  while ($#ARGV >= 0) {
    $_ = shift @ARGV;
    if ($_ eq "--verbose") { $verbose++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
#    elsif (m/^-d+$/) { $debug += length($_)-1; }
    elsif (m/^-t+$/) { $test += length($_)-1; }
    elsif (m/^-./) { usage; }
    elsif ($_ eq '') { }
    elsif (!defined($file)) { $file = $_; }
    else { push(@sids, $_); }
#    elsif (!defined($sid)) { $sid = $_; }
#    else { usage; }
  }

  usage() unless defined($file);

  mork_parse_file ($file);
  output(\@sids);
}

main;
exit 0;
