Beefy Boxes and Bandwidth Generously Provided by pair Networks vroom
go ahead... be a heretic
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
I doubt this will help, but here you go, it was a fun diversion :)
#!/usr/bin/perl -- use strict; use warnings; use Path::Class qw[ file dir ]; use autodie; # does error checking on open/close... use DBI; use DBD::SQLite; Main( @ARGV ); exit( 0 ); sub Main { Demo(); } ## end sub Main sub CreateSampleInput { # creates sample data files as input.0.txt... my @sample = ( "a\t1\nb\t2\nc\t3\n", "a\t5\nd\t3\n", "a\t1\nx\t4\n", ); for my $ix ( 0 .. 2 ){ open my($fh), '>', "input.$ix.txt"; print $fh $sample[$ix]; close $fh; } } ## end sub CreateSampleInput sub Demo { chdir file(__FILE__)->absolute->dir; # cd to directory of this fil +e CreateSampleInput(); my $dbh = OpenInitDb(); FilesIntoDb( $dbh, glob 'input.*.txt' ); PrintDbReport( $dbh ); CleanDb( $dbh ); } ## end sub Demo sub FilesIntoDb { # iterates over a list of file and imports into data +base my( $dbh, @files ) = @_; for my $file ( @files ){ eval { ReadFileIntoDb( $dbh, $file ); } or warn $@; } } ## end sub FilesIntoDb sub CleanDb { # closes database handle my( $dbh ) = @_; $dbh->disconnect; unlink 'temp.test.sqlite'; # deletes temporary database file } ## end sub CleanDb sub OpenInitDb { ## creates temporary sqlite database in current direc +tory my $dbh = DBI->connect( 'dbi:SQLite:dbname=temp.test.sqlite', undef, undef, { RaiseError => 1, PrintError => 1, }, ); eval { $dbh->do(' CREATE TABLE fileKeyValue ( file TEST NOT NULL, key TEXT NOT NULL, value TEXT ); '); } or warn $@; return $dbh; } ## end sub OpenInitDb sub ReadFileIntoDb { # reads key/value pairs from file into database my( $dbh, $file ) = @_; open my($fh), '<', $file; my $sth = $dbh->prepare_cached(' INSERT INTO fileKeyValue ( file, key, value ) VALUES ( ?, ?, ?) ' ); while(defined( my $line = <$fh> )){ chomp $line; my( $key, $value ) = split /\s+/, $line, 2; $sth->execute($file, $key, $value ); } close $fh; } ## end sub ReadFileIntoDb sub PrintNice { # kills evil flesh eating zombies with STDOUT awesomen +ess #~ print join " ", @_, "\n"; my $template = join ' ', map{'%-15s'} @_; printf "$template\n", @_; } ## end sub PrintNice sub PrintDbReport { my( $dbh ) = @_; #~ http://www.w3schools.com/sql/sql_distinct.asp #~ http://search.cpan.org/perldoc?DBI#selectall_arrayref my @files = map {@$_} @{ $dbh->selectall_arrayref('SELECT DISTINCT file FROM fileKeyV +alue') }; PrintNice( "NAME", @files ); my $sth = $dbh->prepare_cached(' SELECT file, key, value FROM fileKeyValue ORDER BY key ' ); $sth->execute; #~ http://search.cpan.org/perldoc?DBI#bind_columns # each fetchrow puts new values into these variables my( $file, $key, $value ); $sth->bind_columns( \( $file, $key, $value ) ); my $prevKey = ""; my %FileValue; # temporaryily associate filenames with values while( $sth->fetchrow_arrayref ){ #~ warn " file($file) prevKey($prevKey) key($key) value($value) "; if( $key ne $prevKey ){ if( %FileValue ){ PrintNice( $prevKey, map { $FileValue{$_} } @files ); } %FileValue=map { $_ => 0 } @files; # init #~ @FileValue{@files} = ( 0 )x@files; #init, same } $prevKey = $key; $FileValue{$file} = $value; } if( %FileValue ){ # print anything we haven't printed yet PrintNice( $key, map { $FileValue{$_} } @files ); # empty FileValue, redundant since its the end of sub PrintDbR +eport undef %FileValue; } $sth->finish; } ## end sub PrintDbReport __END__ NAME input.0.txt input.1.txt input.2.txt a 1 5 1 b 2 0 0 c 3 0 0 d 0 3 0 x 0 0 4

In reply to Re: Open multiple file handles? by Anonymous Monk
in thread Open multiple file handles? by onlyIDleft

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others rifling through the Monastery: (7)
    As of 2014-04-20 08:44 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      April first is:







      Results (485 votes), past polls