format Header only prints on first of several files

dthacker has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks! It's been awhile.... My goal is to read records from a database and generate roster files based on the content of the field "club". I'm attempting to use format to specify where the fields should go and to print a 2 line header at the top of each file. My header is only showing up on the first file, the other files that are written only have records. Can you show me the error of my ways? My code, the input file, and samples of the output files are below. Thanks in advance!

#!/usr/bin/perl

use strict;
use warnings;

use DBI;
use Getopt::Long;
our ($opt_league, $opt_div);


&GetOptions("league=s", "div=s");

print "Working on the $opt_league league, division $opt_div\n";

#connect to database
my $dbh = DBI->connect("DBI:mysql:database=efl",
                      'auser',
                      'apass',
                      ) or die "Can't connect to database";

#set the root directory of the installation
my $rootdir= "/home/dthacker/efl/dev/";


#open teams.dir for reading
open( CLUB, "<$rootdir/teams.dir"  ) or die "Can't open teams.dir : $!
+";
while (<CLUB>) {
    print $_;
    my $roster_file=$_;
    my $club = substr($_, 0,3);
    my $strsql = <<EOT;

select name, age, nat, st, tk, ps, sh, agg
from players where players.club="$club"
EOT

    my $sth = $dbh->prepare($strsql);


    $sth->execute() or die "Couldn't execute statement: $DBI::errstr; 
+stopped";

    my ($name, $age, $nat, $st, $tk, $ps, $sh, $agg);

format RF =
@<<<<<<<<<<<  @< @<< @< @< @< @< @<
$name, $age, $nat, $st, $tk, $ps, $sh, $agg
.

format RF_TOP =
Name         Age Nat St Tk Ps Sh Ag KAb TAb PAb SAb Gam Sav Ktk Kps Sh
+t Gls Ass  DP Inj Sus
----------------------------------------------------------------------
+---------------------
.

    open (RF, ">$roster_file") or die "Can't open roster file $roster_
+file";

    while ( ($name, $age, $nat, $st, $tk, $ps, $sh, $agg  ) = $sth->fe
+tchrow_array() ) {
        write RF;
    }

    close RF;

}
$dbh->disconnect();


--format of teams.dir--
dthacker@fluffy:~/efl/dev$ more teams.dir
acm.txt
bar.txt
cel.txt
dep.txt
int.txt
lyo.txt
por.txt
ran.txt
rea.txt
val.txt

----end of teams.dir-----

---start of acm.txt (first file produced)----
Name         Age Nat St Tk Ps Sh Ag KAb TAb PAb SAb Gam Sav Ktk Kps Sh
+t Gls Ass  DP Inj Sus
----------------------------------------------------------------------
+---------------------
P_Pipolo      23 ita 12 1  1  1  22
F_Bikmaz      20 tur 8  1  1  1  16
O_Veigneau    23 fra 1  11 6  1  37

----start of bar.txt (second file produced)    
I_Akinfeev    24 rus 11 1  1  1  25
C_Dinganga    21 cod 8  1  1  1  22
G_Bartolucci  27 ita 1  13 7  1  23
M_Licka       27 cze 1  11 9  1  20
D_Traore      32 fra 1  9  4  2  30
[download]

Dave

Code On!

Comment on format Header only prints on first of several files Download Code

Replies are listed 'Best First'.
Re: format Header only prints on first of several files by broomduster (Priest) on Sep 06, 2008 at 16:40 UTC
I use format/write quite a bit, but never exactly this way... ;-) write effectively keeps a running tally of the number of lines printed on the current page. (To be more precise, `$-` holds the number of lines remaining on the current page.) Apparently, `$-` is not getting reset when you close RF and then open it again. You should put `$- = 0;` right after `close RF;`. And in order to get that to work, you need to select your filehandle so that `$-` is associated with RF. Here's a sample: `use strict; use warnings; format RF = testing . format RF_TOP = top_of_form . for ( 1 .. 3 ) { open (RF, ">testfile$_") or die "Can't open file testfile$_: $!"; select(RF); write RF; write RF; close RF; $- = 0; }` [download]	[reply] [d/l] [select]
Re: format Header only prints on first of several files by Sagacity (Monk) on Sep 06, 2008 at 16:30 UTC
At first glance: `open (RF, ">$roster_file"); #Add Header Row here print RF "\nName Age Nat St Tk Ps Sh Ag KAb TAb PAb SAb Ga +m Sav Ktk Kps Sht Gls Ass DP Inj Sus\n", "-------------------------------------------------------- +-----------------------------------\n\n"; # Fetch each row and print it while ( my ($name, $age, $nat, $st, $tk, $ps, $sh, $agg, $kab, $ta +b, $pab, $sab) = $sth->fetchrow_array() ) { print RF "$name, $age, $nat, $st, $tk, $ps, $sh, $agg\n"; } close RF;` [download] Just add the header row as a hard coded print command. That will at least accomplish the task of having a header for each file/club in the directory. You can play with the newlines to format and separate as needed. Hope this helps!	[reply] [d/l]


Syntactic Confectionery Delight
	PerlMonks