#----------------------------------------------------------------------------------------
#
# TODO
#
# 1. owning site in Ergebniszeile
# 2. ORACLE-Nutzer, Passwort
#
#!/usr/bin/perl -w


#--------------------------------------------------------------------------------------
#  Heraussuchen alle Aenderungsstaende die DataSets besitzen
Dim SQL_ANZ_IR as String = _
  "select  " & _
  "  count(*) " & _
  "from    " & _
  "  infodba.pitemrevision ir "


Dim SQL_ALLE_IR as String = _
  "select  " & _
  "  distinct i.pitem_id, ir.pitem_revision_id, ir.puid " & _
  "from    " & _
  "  infodba.pitem i, " & _
  "  infodba.pitemrevision ir " & _
  "where   " & _
 "      i.puid      = ir.ritems_tagu  "


Dim SQL_IR_ATTR as String = _
  "select  " & _
  "  pu1.puser_id, pg1.pname, TO_CHAR(pao.pcreation_date,'dd.mm.yyyy hh24:mi'), " & _
  "  pu2.puser_id, TO_CHAR(pao.plast_mod_date,'dd.mm.yyyy hh24:mi') " & _
  "from    " & _
  "  infodba.pitem i, " & _
  "  infodba.pitemrevision ir, " & _
  "  infodba.PPOM_APPLICATION_OBJECT pao,  " & _
  "  infodba.PPOM_GROUP pg1,  " & _
  "  infodba.PPOM_USER pu1,  " & _
  "  infodba.PPOM_USER pu2,  " & _
  "  infodba.pimanrelation pr, " & _
  "  infodba.pdataset pd " & _
  "where   " & _
  "      i.pitem_id = ? " & _
  "  and ir.pitem_revision_id = ? " & _
  "  and i.puid      = ir.ritems_tagu  " & _
  "  -- Besitzer " & _
  "  and pao.puid    = ir.puid " & _
  "  and pao.rowning_useru = pu1.puid  " & _
  "  and pao.rowning_groupu = pg1.puid  " & _
  "  -- Aenderer " & _
  "  and pao.rlast_mod_useru = pu2.puid  " & _
  "  -- UGMaster " & _
  "  and ir.puid=pr.rprimary_objectu " & _
  "  and pr.rsecondary_objectu=pd.puid "


Dim SQL_NORMTEIL_ALT as String = _
    "select  " & _
    "  i.pitem_id " & _
    "from " & _
    "  infodba.pitem i, " & _
    "  infodba.pcontents_0 c," & _
    "  infodba.pworkspaceobject wso, " & _
    "  infodba.pfolder f " & _
    "where " & _
    "      i.puid = c.pvalu_0 " & _
    "  and wso.pobject_name='Family Members' " & _
    "  and wso.puid=f.puid " & _
    "  and c.puid=f.puid "

Dim SQL_NORMTEIL as String = _
    "select  " & _
    "  i.pitem_id, " & _
    "  itf.pitem_id " & _
    "from " & _
    "  infodba.pitem itf " & _
    "  ,infodba.pfolder f " & _
    "  ,infodba.pcontents_0 c " & _
    "  ,infodba.pworkspaceobject wso " & _
    "  ,infodba.pitem i " & _
    "  ,infodba.pimanrelation pr " & _
    "where  " & _
    "      itf.puid=pr.rprimary_objectu " & _
    "  and pr.rsecondary_objectu=f.puid " & _
    "  and f.puid     = wso.puid " & _
    "  and upper(wso.pobject_name) = 'FAMILY MEMBERS' " & _
    "  and c.puid     = f.puid " & _
    "  and i.puid     = c.pvalu_0 "

Dim SQL_BAUGRUPPE as String = _
    "select  " & _
    "  distinct bvr.puid " & _
    "from " & _
    "  infodba.PPSBOMVIEWREVISION bvr, " & _
    "  infodba.pom_backpointer bp, " & _
    "  infodba.pitem i, " & _
    "  infodba.pitemrevision ir " & _
    "where " & _
    "  i.pitem_id = ? " & _
    "  and ir.ritems_tagu=i.puid " & _
    "  and ir.pitem_revision_id = ? " & _
    "  and bp.from_uid=ir.puid  " & _
    "  and bvr.puid=bp.to_uid "

Dim SQL_OWNING_SITE as String = _
    "  select  " & _
    "  distinct i.pitem_id, " & _
    "           s.pname " & _
    "  from " & _
    "    infodba.ppom_object o, " & _
    "    infodba.ppom_imc s, " & _
    "    infodba.pitem i " & _
    "  where  " & _
    "    s.pname is NOT NULL and " & _
    "    s.puid=o.rowning_siteu and " & _
    "    o.puid=i.puid and " & _
    "    i.pitem_id = ? "

Dim SQL_UGMASTER as String = _
    "  select  " & _
    "  distinct i.pitem_id, " & _
    "           s.pname " & _
    "  from " & _
    "    infodba.ppom_object o, " & _
    "    infodba.ppom_imc s, " & _
    "    infodba.pitem i " & _
    "  where  " & _
    "    s.pname is NOT NULL and " & _
    "    s.puid=o.rowning_siteu and " & _
    "    o.puid=i.puid and " & _
    "    i.pitem_id = ? "

Dim SQL_UGMASTER_ATTR as String = _
    "select  " & _
    "  pu1.puser_id, pg1.pname, TO_CHAR(pao.pcreation_date,'dd.mm.yyyy hh24:mi'), " & _
    "  pu2.puser_id, TO_CHAR(pao.plast_mod_date,'dd.mm.yyyy hh24:mi') " & _
    "from    " & _
    "  infodba.pitemrevision ir, " & _
    "  infodba.pimanrelation pr," & _
    "  infodba.pdataset pd, " & _
    "  infodba.pdatasettype pdt, " & _
    "  infodba.PPOM_APPLICATION_OBJECT pao ,  " & _
    "  infodba.PPOM_GROUP pg1,  " & _
    "  infodba.PPOM_USER pu1,  " & _
    "  infodba.PPOM_USER pu2  " & _
    "where   " & _
    "      ir.puid = ? " & _
    "  and ir.puid=pr.rprimary_objectu " & _
    "  and pr.rsecondary_objectu=pd.puid  " & _
    "  and pd.rdataset_typeu=pdt.puid  " & _
    "  and pdt.pdatasettype_name='UGMASTER'  " & _
    "  -- Besitzer " & _
    "  and pao.puid    = pd.puid " & _
    "  and pao.rowning_useru = pu1.puid  " & _
    "  and pao.rowning_groupu = pg1.puid  " & _
    "  -- Aenderer " & _
    "  and pao.rlast_mod_useru = pu2.puid  "



Dim SQL_NAMEDREF_ATTR as String = _
    "select  " & _
    "  pu1.puser_id, pg1.pname, TO_CHAR(pao.pcreation_date,'dd.mm.yyyy hh24:mi'), " & _
    "  pu2.puser_id, TO_CHAR(pao.plast_mod_date,'dd.mm.yyyy hh24:mi') " & _
    "from    " & _
    "  infodba.pitemrevision ir, " & _
    "  infodba.pimanrelation pr," & _
    "  infodba.pdataset pd, " & _
    "  infodba.pdatasettype pdt, " & _
    "  infodba.pref_names_0 rn, " & _
    "  infodba.pref_list_0 rl, " & _
    "  infodba.pimanfile imf, " & _
    "  infodba.PPOM_APPLICATION_OBJECT pao ,  " & _
    "  infodba.PPOM_GROUP pg1,  " & _
    "  infodba.PPOM_USER pu1,  " & _
    "  infodba.PPOM_USER pu2  " & _
    "where   " & _
    "      ir.puid = ? " & _
    "  and ir.puid=pr.rprimary_objectu " & _
    "  and pr.rsecondary_objectu=pd.puid  " & _
    "  and pd.rdataset_typeu=pdt.puid  " & _
    "  and pdt.pdatasettype_name='UGMASTER'  " & _
    "  and pd.puid=rn.puid " & _
    "  and rn.pval_0 = 'UGPART' " & _
    "  and pd.puid=rl.puid " & _
    "  and imf.puid=rl.pvalu_0  " & _
    "  -- Besitzer " & _
    "  and pao.puid    = imf.puid " & _
    "  and pao.rowning_useru = pu1.puid  " & _
    "  and pao.rowning_groupu = pg1.puid  " & _
    "  -- Aenderer " & _
    "  and pao.rlast_mod_useru = pu2.puid  "


Dim SQL_DS as String = _
    "select  " & _
    "  imf.poriginal_file_name, " & _
    "  imv.pwnt_path_name, " & _
    "  imf.psd_path_name,       " & _
    "  imf.pfile_name " & _
    "from  " & _
    "  infodba.pimanrelation pr, " & _
    "  infodba.pdataset pd, " & _
    "  infodba.pdatasettype pt, " & _
    "  infodba.pref_names_0 rn, " & _
    "  infodba.pref_list_0 rl, " & _
    "  infodba.pimanfile imf, " & _
    "  infodba.pimanvolume imv " & _
    "where  " & _
    "  pr.rprimary_objectu = ? and " & _
    "  pr.rsecondary_objectu=pd.puid and " & _
    "  pd.puid=rn.puid and " & _
    "  pd.rdataset_typeu=pt.puid and " & _
    "  pt.pdatasettype_name='UGMASTER' and " & _
    "  rn.pval_0 = 'UGPART' and " & _
    "  pd.puid=rl.puid and " & _
    "  imf.puid=rl.pvalu_0 and " & _
    "  imv.puid=imf.rvolume_tagu "

#--------------------------------------------------------
#
#  Ermitteln Stueckliste (unpraezise; Menge und Mengeneinheit)
#  zu Sachnummer/Aenderungststand
#
#  Parameter:
#
#  1. Sachnummer
#  2. Aenderungsstand
#
Dim SQL_STL_IMPRECISE_QTY as String = _
  "select " & _
  "  ir.puid  " & _
  "FROM   " & _
  "  infodba.pom_backpointer bp, " & _
  "  infodba.pitemrevision ir, " & _
  "  infodba.pitem i, " & _
  "  infodba.PPSBOMVIEWREVISION bvr, " & _
  "  infodba.PPSOCCURRENCE bo " & _
  "WHERE  " & _
  "      bp.from_uid = ?  " & _
  "  and bvr.puid    = bp.to_uid  " & _
  "  and bvr.puid    = bo.rparent_bvru" & _
  "  and i.puid      = bo.rchild_itemu " & _
  "  and i.puid      = bo.rchild_itemu " & _
  "  and ir.ritems_tagu=i.puid " & _
  "order by ir.pitem_revision_id "


#
#  Ermitteln Anzahl Positionen in Stueli
#
Dim SQL_STL_PRECISE_QTY as String = _
  "select " & _
  "  ir.puid  " & _
  "FROM   " & _
  "  infodba.pom_backpointer bp, " & _
  "  infodba.pitemrevision ir, " & _
  "  infodba.PPSBOMVIEWREVISION bvr, " & _
  "  infodba.PPSOCCURRENCE bo " & _
  "WHERE  " & _
  "      bp.from_uid = ?  " & _
  "  and bvr.puid    = bp.to_uid  " & _
  "  and bvr.puid    = bo.rparent_bvru" & _
  "  and ir.puid     = bo.rchild_itemu "


# die "$SQL_STL_PRECISE_QTY"

#---------------------------------------------------------------

sub usage($) {
  my $opt=shift;
  print "\n\nAufruf : IR_fuer_Refile.exe --db --srv --dir --size [--file] [--pat] [--after] [--debug] [--help] "
  print "  --db      .. IMAN-Site (IM7R, IM7W , IM9R, IM9W, IM9T, IM9X oder ITST)"
  print "  --srv     .. Name Datenbankserver"
  print "  --user .. Name Datenbanknutzer"
  print "  --pwd  .. Passwort"
  print "  --dir     .. Verzeichnis fuer INPUT-Files fuer Refile"
  print "  --size    .. Groesse Refile-Packete"
  print "  --file    .. Name File mit kompletter Liste der Aenderungsstaende"
  print "  --pat     .. (optional) Muster zulaessiger Sachnummern, muss in \" eingeschlossen werden!"
  print "  --maxComp .. (optional) Anzahl Komponenten einer Baugruppe bei der Bestimmung"
  print "                Komponentenanzahl abgebrochen werden soll (default=2000)"
  print "  --maxLev  .. (optional) maximale Rekursionstiefe fuer die Bestimmung der"
  print "                Komponentenanzahl einer Baugruppe(default=25)"
  print "  --imprecise.. (optional) BOM-View ist imprecise"
  print "  --after   .. (optional) Datum, ab dem Aenderungsstaende beachtet werden sollen"
  print "  --before  .. (optional) Datum, vor dem dem Aenderungsstaende beachtet werden sollen"
  print "  --debug   .. (optional) mit Zwischendrucken"
  print "  --help    .. (optional) dieser Text "
  print "$opt"
  die;
};
sub datum() {
my ($dat,$tim);
  $dat=`date /t`;
  $dat=~s/\D*(\d+)\.(\d+)\.(\d+).*/$1\.$2\.$3/;
  chop($dat);                                           # Entfernen, abschl. Leerzeichen
  $tim=`time /t`;
  $tim=~s/\D*(\d+)\:(\d+).*/$1:$2/;			            # Entfernen, abschl. Leerzeichen
  chop($tim);
  return $dat."-".$tim;
};
sub dat2int($) {
  my $datum=shift;
  $datum=~/^([0-9]{2})\.([0-9]{2})\.([0-9]{4})/;
  my $itag=$3*366+$2*31+$1;
  return $itag
}
#--------------------------------------------------------------------------------------
#
#  
#
sub anzComp($$$$$$$) {
  my $dbh=shift;
  my $sth=shift;
  my $ir_puid=shift;
  my $lev=shift;
  my $maxComp=shift;
  my $maxLev=shift;
  my $imprecise=shift;
  if ( $lev>$maxLev) {
    print "\nRekurisonstiefe $lev>$maxLev fuer $ir_puid"
    return 0;
  };
  $sth->bind_param(1,$ir_puid);
  my $rc=$sth->execute();
  my $rowref=$sth->fetchall_arrayref();
  my @refs=@{$rowref};
  my $anz=0;
  my $sthc;
  if ( $imprecise==0 ) {
    $sthc=$dbh->prepare($SQL_STL_PRECISE_QTY);
  } else {
    $sthc=$dbh->prepare($SQL_STL_IMPRECISE_QTY);
  };
  foreach my $ref ( @refs ) {
    my $ir_puid_comp=$$ref[0];
    $sthc->bind_param(1,$ir_puid_comp);
    if ( $anz<$maxComp ) { $anz=$anz+anzComp($dbh,$sthc,$ir_puid_comp,$lev+1,$maxComp,$maxLev,$imprecise); };
  };
  $sthc->finish();
  return $anz+$#refs+1;
};
#
#-----------------------------------------------
# 
# Aufrufoptionen
#    
my $db='';
my $srv='';
my $db_user='';
my $db_pwd='';
my $dir='';
my $normteile=0;
my $debug=0;
my $help=0;
my $packet_size=100;
my $maxComp=2000;
my $maxLev=25;
my $file='';
my $pat='.*';
my $datum='';
my $datum1='';
my $imprecise=0;
my $result = GetOptions (
    "db=s"    => \$db,
    "srv=s"   => \$srv,
    "user=s"  => \$db_user,
    "pwd=s"   => \$db_pwd,
    "dir=s"   => \$dir,
    "size:s"  => \$packet_size,
    "file:s"  => \$file,
    "pat:s"   => \$pat,
    "after:s" => \$datum,
    "before:s"=> \$datum1,
    "maxComp:s"=> \$maxComp,
    "maxLev:s" => \$maxLev,
    "imprecise"=> \$imprecise,
    "debug"   => \$debug,
    "help"    => \$help
  );
usage("") if ( $help>0 );
usage("Verzeichnis $dir ex. nicht") unless ( -d $dir );
usage("Paketgroesse $packet_size nicht def.") unless ( $packet_size>0 );
my $mitLOG=0;
if ( length($file)>0 ) {
  open(LOG,">$file") || usage("File $file kann nicht zum Schreiben geoeffnet werden");
  $mitLOG=1;
};
usage("Das angegeben Datum $datum hat nicht die Form  dd.mm.yyyy") unless ( $datum=~/(^$|^[0-9]{2}\.[0-9]{2}\.[0-9]{4}$)/ );
usage("Das angegeben Datum $datum1 hat nicht die Form  dd.mm.yyyy") unless ( $datum1=~/(^$|^[0-9]{2}\.[0-9]{2}\.[0-9]{4}$)/ );
my $idatum=-1; $idatum=dat2int($datum) if ( length($datum)>0 );
my $idatum1=dat2int('01.01.3000'); $idatum1=dat2int($datum1) if ( length($datum1)>0 );   

if ( $debug>0 ) {
  print ""
  print "IMAN-site               : $db"
  print "DB-Server               : $srv"
  print "Ablageverzeichnis       : $dir"
  print "Paketgroesse            : $packet_size"
  print "Name Ausgabefile        : $file"
  print "Muster fuer Sachnummern : $pat"
  print "max.Anzahl Komponenten  : $maxComp"
  print "max.Rekursionstiefe     : $maxLev"
  print "AbDatum                 : $datum" if ( length($datum)>0 );
  print "VorDatum                : $datum" if ( length($datum1)>0 );
  print "STL imprecise" if ( $imprecise>0 );
  print ""
};

#---------------------------------------------------------------------------------
#
# Verbindung zu iMAN
#
if ( $debug>0 ) {
  print ""
  print "ORACLE_HOME             : $ENV{'ORACLE_HOME'}"
  print "NLS_LANG                : $ENV{'NLS_LANG'}"
  print "ORA_NLS33               : $ENV{'ORA_NLS33'}"
  print "ORACLE_SERVER           : $ENV{'ORACLE_SERVER'}"
  print "ORACLE_SID              : $ENV{'ORACLE_SID'}"
  print "PATH                    : $ENV{'PATH'}"
  print ""
  
};
my $user = $db_user;
my $pass = $db_pwd;
my $source = "dbi:Oracle:host=$srv;sid=$db";

my $dbh = DBI->connect($source, $user, $pass, {RaiseError => 0, AutoCommit => 0}) 
    || die "\n ***>Verbindungsaufbau ($source) zu IMAN fehlgeschlagen"

my $sth  = $dbh->prepare($SQL_ANZ_IR);    
my $sth0 = $dbh->prepare($SQL_ALLE_IR);    
my $sth1 = $dbh->prepare($SQL_NORMTEIL);
my $sth2 = $dbh->prepare($SQL_BAUGRUPPE);
my $sth3 = $dbh->prepare($SQL_OWNING_SITE);
my $sth4 = $dbh->prepare($SQL_IR_ATTR);
my $sth5 = $dbh->prepare($SQL_DS);
my $sth6;
if ( $imprecise==0 ) {
  $sth6 = $dbh->prepare($SQL_STL_PRECISE_QTY);
} else {
  $sth6 = $dbh->prepare($SQL_STL_IMPRECISE_QTY);
};
my $sth7 = $dbh->prepare($SQL_NAMEDREF_ATTR);
#
# Anzahl ItemRevision bestimmen
#
my $rc=$sth->execute();
my $rowref=$sth->fetchrow_arrayref();
my $Anzahl_IR=$$rowref[0];
#
#  Normteile finden?
#
my %snr_nt;
$rc=$sth1->execute();
while ( my $rowref1=$sth1->fetchrow_arrayref() ) {
  $snr_nt{$$rowref1[0]}=$$rowref1[1];
};
print "Ermitteln Normteile abgschlossen" if ( $debug>0);
#
# Sachnummern/Aenderungsbuchstabe bestimmen
#
my %snr_aeb;
my @merk;
$rc=$sth0->execute();
my $iii=0;
while ( my $rowref=$sth0->fetchrow_arrayref() ) {
  $iii++;
  my $siii=sprintf "%06s",$iii;
  my $sanz=sprintf "%06s",$Anzahl_IR;
  my $snr=$$rowref[0];
  my $aeb=$$rowref[1];
  print "$siii/$sanz $snr($aeb)" if ( $debug>0 && ($iii%500==0) );
  next unless ( $snr=~/$pat/ );
  my $ir_puid=$$rowref[2];
  next if ( uc($snr)=~/^KBA_METRIC/ );
  #
  #  Attribute zu IR ermitteln
  #
  $sth4->bind_param(1,$snr);
  $sth4->bind_param(2,$aeb);
  $rc=$sth4->execute();
  my $rowref4=$sth4->fetchrow_arrayref();
  next if ( uc(ref($rowref4)) ne 'ARRAY' ); # ItemRevision hat kein UGMaster
  my $cre_user=$$rowref4[0];
  my $cre_grp =$$rowref4[1];
  my $cre_date=$$rowref4[2];
  my $mod_user=$$rowref4[3];
  my $mod_date=$$rowref4[4];
  #
  #  Attribute zu UGMASTER ermitteln
  #
  $sth7->bind_param(1,$ir_puid);
  $rc=$sth7->execute();
  my $rowref7=$sth7->fetchrow_arrayref();
  next if ( uc(ref($rowref7)) ne 'ARRAY' ); # ItemRevision hat kein UGMaster
  my $cre_user_ugm=$$rowref7[0];
  my $cre_grp_ugm =$$rowref7[1];
  my $cre_date_ugm=$$rowref7[2];
  my $mod_user_ugm=$$rowref7[3];
  my $mod_date_ugm=$$rowref7[4];

  my $imod_date_ugm=dat2int($mod_date_ugm);
  #
  # Uebergehen falls Aenderungsdatum nicht im Intervall -before ($idatum1) und -after ($idatum)
  #
  next if ($imod_date_ugm<$idatum || $imod_date_ugm>$idatum1);
  #
  #  Ist Teil Lesekopie (owning_site gesetzt)
  #
  $sth3->bind_param(1,$snr);
  $rc=$sth3->execute();
  my $rowref3=$sth3->fetchrow_arrayref();
  my $owning_site = ( defined $$rowref3[1] ) ? $$rowref3[1] :' ';
  #
  #  Ist Teil Einzelteil?
  #
  $sth2->bind_param(1,$snr);
  $sth2->bind_param(2,$aeb);
  $rc=$sth2->execute();
  my $rowref2=$sth2->fetchrow_arrayref();
  my $et=( defined $$rowref2[0] ) ? 'N' : 'J';
  #
  # Anzahl Komponenten in Baugruppe
  #
  my $anz=0;
  my $lev=0;
  $anz=( defined $$rowref2[0] ) ? anzComp($dbh,$sth6,$ir_puid,$lev,$maxComp,$maxLev,$imprecise) : 0;
  if ($anz>0 ) {
      print "  $iii/$Anzahl_IR : $snr($aeb) hat $anz Komponenten"
  };
  #
  #  kompl. Pfadname in Volume
  #
  $sth5->bind_param(1,$ir_puid);
  $rc=$sth5->execute();
  my $file='';
  while ( my $rowref5=$sth5->fetchrow_arrayref() ) {
    next unless ( uc($$rowref5[3])=~/PRT$/ );
    $file=$file.$$rowref5[1]."\\".$$rowref5[2]."\\".$$rowref5[3].";";
  };
  #
  # Merken in Array
  #
  # my $norm = ( defined $snr_nt{$snr} ) ? $snr_nt{$snr} : 'N';
  my $norm = ( defined $snr_nt{$snr} ) ? 'J' : 'N';
  my $s=$norm."###".$et."###".$mod_date_ugm."###".$mod_date."###".$mod_user."###".$cre_date."###";
     $s=$s.$cre_user."###".$cre_grp."###".$snr."###".$aeb."###".$file."###".$anz."###".$owning_site;
  push(@merk,$s);
  print LOG "$s" if ( $mitLOG==1 );
};
$sth->finish();
$sth0->finish();
$sth1->finish();
$sth2->finish();
$sth3->finish();
$sth4->finish();
$sth5->finish();
$sth6->finish();
$sth7->finish();

$dbh->disconnect();

  #
  # Sortierte Ausgabe Einzelteile
  #
  my $file_templ=$dir."\\et_";
  my $f=$file_templ."0000.txt";
  my $i=0;
  open(F,">$f") || die "File $f kann nicht zum Schreiben geoeffnet werden";
  foreach my $s ( sort @merk ) {
    next unless ( $s=~/^N#/ );
    next if ( $s=~/^N###N###/ );
    $i++;
    if ( $i%$packet_size==0 ) {
      my $n=$i/$packet_size; my $nn=sprintf "%04s",$n;
      $f=$file_templ."$nn.txt";
      close(F); open(F,">$f") || die "File $f kann nicht zum Schreiben geoeffnet werden";
    };
    my @a=split(/###/,$s);
    print F "\@DB/$a[7]/$a[8]"
  };
  close(F);

  #
  # Sortierte Ausgabe Baugruppen
  #
  $file_templ=$dir."\\bg_";
  $f=$file_templ."0000.txt";
  $i=0;
  open(F,">$f") || die "File $f kann nicht zum Schreiben geoeffnet werden";
  foreach my $s ( sort @merk ) {
    next if ( $s=~/^J/ );
    next if ( $s=~/^N###J###/ );
    $i++;
    if ( $i%$packet_size==0 ) {
      my $n=$i/$packet_size; my $nn=sprintf "%04s",$n;
      $f=$file_templ."$nn.txt";
      close(F); open(F,">$f") || die "File $f kann nicht zum Schreiben geoeffnet werden";
    };
    my @a=split(/###/,$s);
    print F "\@DB/$a[7]/$a[8]"
  };
  close(F);

  #
  # Sortierte Ausgabe Normteile
  #
  print "\n\n Zuordnung Refile-Pakete zu Teilefamilie"
  $file_templ=$dir."\\norm_";
  $f=$file_templ."0000.txt";
  $i=0;
  my $tf='';
  open(F,">$f") || die "File $f kann nicht zum Schreiben geoeffnet werden";
  foreach my $s ( sort @merk ) {
    my @a=split(/###/,$s);
    next if ( $s=~/^N#/ );
    $i++;
    if ( $i%$packet_size==0 ) {
      my $n=$i/$packet_size; my $nn=sprintf "%04s",$n;
      $f=$file_templ."$nn.txt";
      close(F); open(F,">$f") || die "File $f kann nicht zum Schreiben geoeffnet werden";
    };
    if ( uc($a[0]) ne uc($tf) ) {
      print "$f : $a[0]"
    };
    print F "\@DB/$a[7]/$a[8]"
  };
  close(F);
