Re^2: Out of memory and While replacements with excel XLSX application

Here is a start at refactoring

diff fudge fudge2

diff fudge2 fudge3

diff fudge3 fudge4

diff fudge4 fudge5

--- fudge4    2012-10-08 02:21:58.968750000 -0700
+++ fudge5    2012-10-08 02:21:55.468750000 -0700
@@ -143,12 +143,21 @@
     }
 
 
-        for my $col ( qw{ 13 14 15 17 18 20 21 22 23 24 25 26 27 32 3
+9 32 33 34 35 36 37 38 39 }){
+        for my $col (
+            qw{
+            13 14 15
+            17 18
+            20 21 22 23 24 25 26 27
+            32 33 34 35 36 37 38 39
+            }
+          )
+        {
             if ( my $val = eval { $Sheet->Cells( $row, $col )->{Value
+} } ) {
                 push @prod, $val;
             }
         }
 
+
                 }
             }
         }
[download]

diff fudge5 fudge6

diff fudge6 fudge7

diff fudge7 fudge8

diff fudge8 fudge9

diff fudge9 fudge10

I end up with fudge10

#!C:\strawberry\perl\bin\perl

####Load Packages
use strict;
use warnings;
use Win32::OLE qw(in with);
#~ use Win32::OLE::Const 'Microsoft Excel';
use Win32::OLE::Variant;
use Win32::OLE::NLS qw(:LOCALE :DATE);
use List::MoreUtils qw(natatime);
#~ use Excel::Writer::XLSX;

############################################################

####Initialize Excel Object and Count Files to Process
$Win32::OLE::Warn = 3;    #die on errors...

#get already active Excel application or open new
my $Excel = Win32::OLE->GetActiveObject('Excel.Application')
  || Win32::OLE->new( 'Excel.Application', 'Quit' );

#Get the file names of the production files and prints a status of the
+ results
my $ProdDirect = 'C:/Users/McLovin/Documents/Thesis/Data/';
opendir DH, $ProdDirect or die "Cannot open $ProdDirect: $!";
my @files = grep { !-d } readdir DH;
print "@files\n";
closedir DH;
my $NumberofFiles = @files;
print "Number of files is: $NumberofFiles\n";

######################################################################
+##########

#################################################################
################Start Processing the Data########################
#################################################################
my $counti;  #used to count the excelfiles
my $usefile; #The file that is being used
my @recID;   #an array of ID's for the worksheets
my $val;     #A test value that is used to test whether a row should b
+e included
my @right
  ; #The first of the arrays that will be filled during the process an
+d will be further disected later
my @prod;     #The second array, same as above
my @legal;    #The third


#####Loop over all the files
for ( $counti = 0 ; $counti < $NumberofFiles ; $counti++ ) {

##### open Excel file -- This is the input data files
    print "Working on file $counti of $NumberofFiles\n";
    $usefile = $files[$counti];
###This points to the folder where the excel files are placed
    my $workfile = "C:/Users/McLovin/Documents/Thesis/Datatal/" . "$us
+efile";
    print "$workfile\n";
    
    
    BlahBlahNameHere(
        $Excel,
        $workfile,
        \@recID, \@right, \@legal, \@prod,
    );
}

######################################################################
+##########
#Prints of the created arrays
#print "@right\n";
#print "@legal\n";
#print "@prod\n";
######################################################################
+##########

######################################################################
+##############
#the process that eliminates duplicates in the @right array based on c
+riteria

#makes a copy of the array as it is destroyed in the next while statem
+ent, This is maybe one of the problems
my @rig = @right;  #copy of array
my @righ;          # a new array that is the result of the while state
+ment below
my %seen;          # a hash that stores agreementnumbers for unique en
+tries

#The array is in exact sets of 9 strings and i want it spliced a inter
+vals of exactly those intervals
while ( my ( $m, $n, $o, $p, $q, $r, $s, $t, $y ) = splice( @right, 0,
+ 9 ) ) {
    last if $m !~ /^\d{10}$/;
    next if $seen{$m}++;
    if ( $n =~ /Specific_region/ ) {
        if ( $o =~ /NG/ ) {
            push @righ, $m, $o, $p, $q, $r, $s, $t;
        }
    }

}

# print "@righ\n";

my @leg;     #an array that holds the result for the next while statem
+ent
my @spli;    #used as a container for certain entries in the while sta
+tement
my @joi;     #another middle of equation array for picking up results
%seen = ()
  ; #emties the previous hash as the uniqueness of entries is also imp
+ortant here
my @tes;    #yet another array for picking up results

######################################################################
+##########
#the process that insures that each returned value is printed in the c
+orrect
#form and coupled with the ten digit number 
#again the array is organized in 6 values in a row that need to be sep
+erated out into rows.

while ( my ( $h, $aa, $rr, $j, $k, $l ) = splice( @legal, 0, 6 ) ) {
    last if $h !~ /^\d{10}$/;
    if ( $aa =~ /Specific_region/ ) {
        if ( $rr =~ /NG/ ) {
            if ( $j =~ /\n/ ) {
                next if $seen{$h}++;
                my @spli = split( /\n/, $j );
                foreach my $n (@spli) {
                    if ( $n =~ /LSD/ ) {
                        my @tes = split( /LSD/, $n );
                        foreach my $lon (@tes) {
                            if ( $lon =~ /SEC/ ) {
                                my @joi = split( /-|W|:|\s|,|\(/, $lon
+ );
                                my $chans = @joi;
                                my $eleg =
                                  join( "", @joi[ 0, 2, 1, $chans - 1 
+] );
                                push @leg, $eleg, $h, $k, $l;
                            }
                        }
                    }
                    elsif ( $n =~ /\(/ ) {
                        my @joi   = split( /-|W|:|\s|\(/, $n );
                        my $chans = @joi;
                        my $eleg  = join( "", @joi[ 0, 2, 1, $chans - 
+2 ] );
                        push @leg, $eleg, $h, $k, $l;
                    }
                    else {
                        my @joi   = split( /-|W|:|\s/, $n );
                        my $chans = @joi;
                        my $eleg  = join( "", @joi[ 0, 2, 1, $chans - 
+1 ] );
                        push @leg, $eleg, $h, $k, $l;
                    }
                }
            }
            else {
                next if $seen{$h}++;
                my @joi   = split( /-|W|:|\s/, $j );
                my $chans = @joi;
                my $eleg  = join( "", @joi[ 0, 2, 1, $chans - 1 ] );
                push @leg, $eleg, $h, $k, $l;
            }
        }
    }

}

#print "@leg\n";
my @peg;

foreach my $loma (@leg) {
    if ( $loma =~ /^\d{7}$/ ) {
        substr( $loma, 6, 0, 0 );
        push @peg, $loma;
    }
    else {
        push @peg, $loma;
    }
}

######################################################################
+##############
#the process that creates the production array for the entries
my @produ;

while (
    my (
        $cp, $aaa, $rrr, $dp, $ep, $fp, $gp, $hp, $ip,
        $jp, $kp,  $lp,  $mp, $np, $op, $pp, $qp, $rp,
        $sp, $tp,  $up,  $vp, $wp, $yp, $xp
    )
    = splice( @prod, 0, 25 )
  )
{
    last if $cp !~ /^\d{10}$/;
    if ( $aaa =~ /Specific_region/ ) {
        if ( $rrr =~ /NG/ ) {
            unless (
                $dp =~ /a specific repeated text for all relevant entr
+ies/ )
            {
#eliminate this if statement for option two, where entries with no act
+ual production is included
                if ( defined($qp) && $qp =~ /\d\d-\d\d-\d{4}/ ) {
                    push @produ, $dp, $ep, $cp, $fp, $gp, $hp, $ip, $j
+p, $kp,
                      $lp, $mp, $np, $op, $pp, $qp, $rp, $sp, $tp, $up
+, $vp,
                      $wp, $yp, $xp;
                }
            }
        }
    }
}

# print "@produ\n";

my @nwells;    #an array that collects the results

#creates the 4.2 entries "agreements with no wells
while ( my ( $mn, $nn, $on, $pn, $qn, $rn, $sn, $tn, $yn ) =
    splice( @rig, 0, 9 ) )
{
    last if $mn !~ /^\d{10}$/;
    if ( $nn =~ /Specific_region/ ) {
        if ( $on =~ /NG/ ) {
            if ( $yn =~ /a specific repeated text for all relevant ent
+ries/ ) {
                push @nwells, $mn, $on, $pn, $qn, $rn, $sn, $tn, $yn;
            }
        }
    }
}

# print "@nwells\n";

#Places results into arrays of arrays for easy computation in excel. u
+ses natatime again the arrays
# are of a specific size. per row. 
my @AAR;
{
    my $iter = natatime 7, @righ;
    while ( my @tmp = $iter->() ) {
        push @AAR, \@tmp;
    }
}

my @BAR;
{
    my $iter = natatime 4, @peg;
    while ( my @tmp = $iter->() ) {
        push @BAR, \@tmp;
    }
}

my @CAR;
{
    my $iter = natatime 23, @produ;
    while ( my @tmp = $iter->() ) {
        push @CAR, \@tmp;
    }
}

my @DAR;
{
    my $iter = natatime 8, @nwells;
    while ( my @tmp = $iter->() ) {
        push @DAR, \@tmp;
    }
}

#####The new excel sheets that should contain the results
my $workbooknew  = Excel::Writer::XLSX->new('re1.xlsx');
my $worksheetnew = $workbooknew->add_worksheet();

$worksheetnew->keep_leading_zeros();
$worksheetnew->set_column( 'A:G', 30 );
$worksheetnew->write_col( 'A2', \@AAR );

####This is the data on the legalnumber - introduce keep_leading zeroe
+s for correct legal form
my $workbooknew1  = Excel::Writer::XLSX->new('re2.xlsx');
my $worksheetnew1 = $workbooknew1->add_worksheet();

$worksheetnew1->keep_leading_zeros();
$worksheetnew1->set_column( 'A:D', 15 );
$worksheetnew1->write_col( 'A2', \@BAR );

# # ####This is the data on the production of the wells - introduce ke
+ep_leading zeroes for correct legal form
my $workbooknew2  = Excel::Writer::XLSX->new('re3.xlsx');
my $worksheetnew2 = $workbooknew2->add_worksheet();
my $worksheetnew3 = $workbooknew2->add_worksheet();

$worksheetnew2->set_column( 'A:W', 50 );
$worksheetnew2->write_col( 'A2', \@CAR );
$worksheetnew3->set_column( 'A:H', 30 );
$worksheetnew3->write_col( 'A2', \@DAR );




sub ValueTargetCols {
    my( $sheet, $targets, $rows, $cols ) = @_;
    for my $col ( @$cols )
    {
        for my $row( @$rows )
        {
            if ( my $val = eval { $sheet->Cells( $row, $col )->{Value}
+ } ) {
                for my $target ( @$targets ){
                    push @{$target}, $val;
                }
            }
        }
    }
    return;
}


    
sub BlahBlahNameHere {
    my( $Excel, $workfile, $recID, $right, $legal, $prod ) = @_;
    my $Book = $Excel->Workbooks->Open($workfile);

    my $sheetcnt = $Book->Worksheets->Count();
#~     foreach my $r ( 1 .. $sheetcnt ) {
    {
        my $Sheet = $Book->Worksheets( 1 );
        push @$recID, $Sheet->{Name};
        print "Worksheet name is $Sheet->{Name}\n";
        my $Tot_Rows = $Sheet->UsedRange->Rows->{'Count'};
        my $Tot_Cols = $Sheet->UsedRange->Columns->{'Count'};
        my $firstCol = eval { $Sheet->Cells( 1, 1)->{'Value'} };
        
        if(  defined $firstCol and $firstCol =~ /^\d{10}$/  )
        {            
            push @$right, $firstCol;
            push @$legal, $firstCol;
            push @$prod,  $firstCol;
            
            ValueTargetCols(
                $Sheet,
                [ $right, $legal, $prod, ],
                [ 1 .. $Tot_Rows ],
                [ qw{ 4 5 } ],
            );
            
            ValueTargetCols(
                $Sheet,
                [ $legal, ],
                [ 1 .. $Tot_Rows ],
                [ qw{ 6 } ],
            );
            
            ValueTargetCols(
                $Sheet,
                [ $right, ],
                [ 1 .. $Tot_Rows ],
                [ qw{ 7 8 9  } ],
            );
            
            ValueTargetCols(
                $Sheet,
                [ $right, $legal, ],
                [ 1 .. $Tot_Rows ],
                [ qw{ 10 11  } ],
            );
            
            ValueTargetCols(
                $Sheet,
                [ $prod, $right, ],
                [ 1 .. $Tot_Rows ],
                [ qw{ 12 } ],
            );
            
            ValueTargetCols(
                $Sheet,
                [ $prod ],
                [ 1 .. $Tot_Rows ],
                [ qw{
                    13 14 15
                    17 18
                    20 21 22 23 24 25 26 27
                    32 33 34 35 36 37 38 39
                    } ],
            );

        }
    }
    $Book->Close;
}
__END__
[download]

Comment on Re^2: Out of memory and While replacements with excel XLSX application Select or Download Code


Pathologically Eclectic Rubbish Lister
	PerlMonks