Re^2: Overwriting temp file

[Jeri]

I would but it's large, I'll modify the code in the post.

[Anonymous Monk]

I would but it's large, I'll modify the code in the post.

Well it doesn't have to be real live realsize data, it just has to match your regexes, ie

#!/usr/bin/perl --
#~ 2011-09-21-11:45:38PDT by Anonymous Monk
#~ perltidy -csc -otr -opr -ce -nibc -i=4     
use strict;
use warnings;
use autodie; # dies if open/close... fail

Main( @ARGV );
exit( 0 );

sub Main {
    if ( @_ == 1 ) {
        NotDemoMeaningfulName( @_, 'temp', \&DiddleSomeTemp );
    } else {
        Demo();
        print '#' x 33, "\n", Usage();
    }
} ## end sub Main

sub NotDemoMeaningfulName {
    my ( $inputFile, $outputFile, $callBack ) = @_;

    my $flag    = 0;
    my $outMode = '+>';
    open my ($inFh), '<', $inputFile;
    open my ($outFh), $outMode, $outputFile;
    while (<$inFh>) {
        if (/^#/) {
            if ( not $flag ) {
                $flag++;
                close $outFh;
                open $outFh, $outMode, $outputFile;
            } else {
                seek $outFh, 0, 0;
                $callBack->($outFh);
                close $outFh;
                open $outFh, $outMode, $outputFile;
            } ## end else [ if ( not $flag ) ]
        } else {
            print $outFh $_;
        }
    } ## end while (<$inFh>)
    close $inFh;
    close $outFh;
} ## end sub NotDemoMeaningfulName

sub Usage {
    <<"__USAGE__";


$0    
$0    dataFile     
    
    perl ${\__FILE__}    
    perl ${\__FILE__}    dataFile     


__USAGE__
} ## end sub Usage

sub DiddleSomeTemp {
    warn "Hey diddle diddle @_\n";
    my $f = shift;
    warn "#$_" while <$f>;
}

sub Demo {
    my ( $Input, $WantedOutput ) = DemoData();
    my $Output;

    require Test::More;
    NotDemoMeaningfulName(
        $Input,
        \$Output,
        sub {
            Test::More::is( $Output, $WantedOutput->[0],
                ' NotDemoMeaningfulName Works Aas Designed' );
            shift @$WantedOutput;
        },
    );
    Test::More::done_testing();
} ## end sub Demo

sub DemoData {

#~ http://perlmonks.com/?abspart=1;displaytype=displaycode;node_id=927
+193;part=1
    my $One = <<'__One__';
#
A
B
C
#
D
E
F
#
__One__

    my @Two = (

#~ http://perlmonks.com/?abspart=1;displaytype=displaycode;node_id=927
+193;part=2
        <<'__Two__',
A
B
C blah
__Two__

#~ http://perlmonks.com/?abspart=1;displaytype=displaycode;node_id=927
+193;part=3
        <<'__Two__',
D
E
F blah
__Two__

    );
    return \$One, \@Two;
} ## end sub DemoData

__END__
$ perl pm.927193.pl
not ok 1 -  NotDemoMeaningfulName Works Aas Designed
#   Failed test ' NotDemoMeaningfulName Works Aas Designed'
#   at pm.927193.pl line 76.
#          got: 'A
# B
# C
# '
#     expected: 'A
# B
# C blah
# '
not ok 2 -  NotDemoMeaningfulName Works Aas Designed
#   Failed test ' NotDemoMeaningfulName Works Aas Designed'
#   at pm.927193.pl line 76.
#          got: 'D
# E
# F
# '
#     expected: 'D
# E
# F blah
# '
1..2
#################################


pm.927193.pl
pm.927193.pl    dataFile

    perl pm.927193.pl
    perl pm.927193.pl    dataFile


# Looks like you failed 2 tests of 2.

As you can see, the logic is sound, temp gets overwritten, pretty much what you already have

Note the expected data doesn't match on purpose ;)

[Jeri]

Thanks Again. Works like I want it too! Seek was good idea. You're pretty brainy. Here's what I ended up using.

 #!/usr/bin/perl5.8.8

use strict;
use warnings;
#use autodie; dies if open/close...fail 

print "Enter file to process\t";
my $count = <>; #captures input from STNDIN and finds the file associa
+ted with that number
chomp $count;

tempProteinFamFileCreator(); #creates a temp file with protein family

sub tempProteinFamFileCreator
{
my $infile = $count."_ProFam"; #iterates through all the protein famil
+y files with the count variable
open (my $INFILE,"<", $infile);

my $flag = 0;
open (my $TEMPfa,">",'temp');

while(<$INFILE>)
{
        if ($_ =~/^##UniRef90_([\w\d]+) Protein Family/)
        {
        close ($TEMPfa);
        open ($TEMPfa,">",'temp');
        seek $TEMPfa, 0 ,0;
        }

        if ($_ =~/^>UniRef90_[\w\d]+\.UniRef100_[\w\d]+/ || $_ =~/^[\w
+\d]+/)
        {
        chomp $_;
        print $TEMPfa "$_\n"; 
        }

        if ($_ =~/^>File/)
        {
        close ($TEMPfa);
        }

} #end of while loop
close ($INFILE); #closes the $INFILE handle
} #end of subroutine tempProteinFamFileCreator

[Anonymous Monk]

Seek was good idea.

My demo program needed seek because I did not want to touch the filesystem, so I used in-memory filehandles, and passed the filehandle around

You don't need to use seek, it does nothing for you

[Jeri]

Thanks for replying so quickly. I'm not quite as advanced as you, and I understood most everything, except the following...

 my $outMode = '+>';

Is the +> telling the file to move out? What is the '+' for?

 open my ($outFh), $outMode, $outputFile;

Here, I know you open a filehandle and then there's the $outMode again (+>) and I'm assuming the name of the output file?

 $callBack->($outFh);

I'm just confused here.

 not $flag

I looked this up in perldocs. Does it return true if $flag = 0?

I didn't mean to turn this into a tutoring session, but it would help me out so much if I understood it! You've been a great help so far.Thanks.

[Khen1950fx]

'+>' means that you want both read and write access, but note that it clobbers the file first. For a read/write update that doesn't clobber the file first, do '+<', for non-text files mostly. See: open.

[Jeri]

If I don't use seek with the last code I posted, it still appends.

[Anonymous Monk]

If I don't use seek with the last code I posted, it still appends.

Its not that I don't believe you, but that is just not possible :)

What does autodie say?