Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

format Header only prints on first of several files

by dthacker (Deacon)
on Sep 06, 2008 at 15:48 UTC ( #709515=perlquestion: print w/replies, xml ) Need Help??

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"$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

Code On!

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; }
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;
    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!

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://709515]
Approved by Arunbear
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (5)
As of 2022-12-09 01:53 GMT
Find Nodes?
    Voting Booth?

    No recent polls found