view release on metacpan or  search on metacpan

infobrief.PL  view on Meta::CPAN

print OUT <<'!NO!SUBS!';
eval 'exec perl -S $0 "$@"'
    if 0;

use InfoBrief;
use Getopt::Long;
use Pod::Usage;
use vars qw(%OPT);

my %CC = (
       'A'   => 'Österreich',
       'CH'  => 'Schweiz',
       'F'   => 'Frankreich',
       'GB'  => 'Great Britain',
       'H'   => 'Ungarn',
       'IRL' => 'Irland',
       'J'   => 'Japan',
       'L'   => 'Luxemburg',
       'NL'  => 'Niederlande',
       'PL'  => 'Polen',
       'USA' => 'USA',
       'GR'  => 'Griechenland',
       'B'   => 'Belgien',
       'BG'  => 'Bulgarien',
       );

$OPT{packed} = 1;

GetOptions (\%OPT,
            'a4!',
            'b5!',
            'c6!',
            'stempel!',
            'foreign!',
            'help!',
            'man!',
            'packed!',
            'sender=s@',
            'infobrief!',
            'numbering!',
            'verbose:i',
           ) || pod2usage(2);
pod2usage(1)  if ($OPT{help});
pod2usage(VERBOSE => 2)  if ($opt{MAN});

unless (exists $OPT{stempel}) {
  $OPT{stempel} = ! $OPT{foreign};
}

my $x = new InfoBrief %OPT;


print $x->preamble;

if ($OPT{packed}) {
  $/="\r\n";
  chomp($_ = <>);
  @fld = split /;/, $_;
} else {
  $/="";
}

while (<>) {
  if ($OPT{packed}) {
    chomp;
    $_ =~ s/;;/; ;/g;
    @rec = split /;/, $_;
    my %rec;
    for (@fld) {
      $rec{$_} = shift @rec;
      $rec{$_} =~ s/^ $//;
      #print STDERR "$_\t$rec{$_}\n";
    }
    if ($rec{Land}) {
      next unless $OPT{foreign};
      $rec{S} = $rec{Land};
      $rec{Land} = $CC{$rec{S}};
      print STDERR "WOAH: $rec{S}: $rec{Land}\n" ;
      if ($rec{S} eq 'USA') {
        $rec{S}   = '';
        $rec{PLZ} = '';
      }
    } else {
      next if $OPT{foreign};
    }
    #$c_rec ++;
    #$row = int(($c_rec-1)/3)+1;
    #next if $row % 9;
    record(%rec);
    #last if ++$x > 10;
  } else {
    my @rec = split /\n/, $_;
    my $last = pop @rec;
    push @rec, '', $last;
    print $x->page(@rec);
  }
}

print $x->trailer;

sub record {
  my %rec = @_;

  delete $rec{S} if $rec{S} eq 'D';
  my @rec = 
    grep /./,                   # grep /./, ($rec{Anrede}, $rec{Titel})),
    (
     join(' ', grep /./, ($rec{Titel}, $rec{Name}, $rec{Vorname})),
     $rec{Firma},
     $rec{Abteilung},
     $rec{Strasse},
     'lf',
     join(' ', grep /./, ((($rec{S})?$rec{S}.'-':'').$rec{PLZ}, $rec{Ort})),
     $rec{Land},
    );
  map s/^lf//, @rec;
  print $x->page(@rec);
}

__END__