#! /usr/bin/perl

use strict;
use warnings;

### sub routines ############################################################

sub read_elements {
  my $file = shift;
  my @elements;
  
  open my $infh, '<', $file or die "open(ro,$file) failed: $!\n";
  while ( my $line = <$infh> ) {
    chomp $line;
    push @elements, substr( $line, 0, 4 );
  }
  close $infh;
  
  return @elements;
}

# lese Regio-Datei ein; fuer jeden definierten Standort werden die ihm
# nachfolgenden zeilen eingelesen
# die gelesenen Daten werden in einem Hash-of-Arrays (HoA) abgelegt;  als
# Schluessel wird die Standort-Kennzahl verwendet, als Value wird eine 
# Referenz auf einen Array mit den Standortdaten abgelegt
# siehe auch dokumentation: perldoc perldsc
sub read_regio {
        my $file = shift;
        my %regio;
        
        my $regio = '';
        my $lines = 0;
        my @values;
        open my $infh, '<', $file or die "open(ro, $file) failed: $!\n";
        while ( my $line = <$infh> ) {
                chomp $line;
                
                # $regio/$lines nur setzen, wenn keine Zeile mehr zu lesen ist...
                if ( $lines == 0 && $line =~ m/^(\d+)\s+(\d+)$/ ) {
                        $regio = $1;
                        $lines = $2;
                }
                elsif ( defined( $regio ) && $lines > 0 ) {
                        push @{ $regio{$regio} }, $line;
                        $lines--;
                }
        }
        
        close $infh;

        return %regio;
}

### main programm ###########################################################

my @elements = read_elements( "elemente.txt"     );
my %regio    = read_regio(    "hq_regio_neu.txt" );

# zur Kontrolle bei Entwicklung
use Data::Dumper;
print Data::Dumper->Dump( 
  [ \@elements, \%regio ], [ qw( elements regio ) ] 
);


for my $element ( @elements ) {

        # weiter mit naechstem Element, wenn keine Daten vorhanden sind
        next if !exists $regio{$element};

        my $file = "$element.txt";
        
        # ueberschreibendes Schreiben
        open my $outfh, '>', $file or die "open(w, $file) failed: $!\n";
        # anhaengendes Schreiben
        #open my $outfh, '>>', $file or die "open(w+, $file) failed: $!\n";
        print $outfh join( "\n", @{ $regio{$element} } );
        close $outfh or die "close(w+, $file) failed: $!\n";
}

__END__