Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: Open multiple file handles?

by Anonymous Monk
on May 07, 2011 at 07:46 UTC ( #903521=note: print w/ replies, xml ) Need Help??


in reply to Open multiple file handles?

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


Comment on Re: Open multiple file handles?
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://903521]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (14)
As of 2014-10-20 18:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (88 votes), past polls