Win:

I think you're going to get verbally mauled for that post because your code is SO long and your "question" is clearly unclear. :-) Who could 'advise you' to start over, when they have NO idea what your problem/goal is? Remember... we're not in your cubicle right now. :)

That being said.... let me just say three things about your style, to start off the 'constructive criticism':

1) Scalar MADNESS = Your program has WAY to many dollar sign sigils ($) everywhere. Consider looking up %hashes and using a 'data structure.'

2) Variable naming -- you're BEGGING for trouble using such long and mixed cased variable names (at least you have strict&warnings at the top!!) People/Monks can't care to read that many characters, so use $short $good $names.

3) Subroutine LENGTH -- You should be able to describe your goal/problem in a couple of paragraphs/sentences (ie. WTF you're trying to do. :-) ) Take that description and make a sub{} for each logically part.

Please, re-edit your node in accordance with the Community's Standard, and I'm sure people will be lining up to help you. :-)

Kurt

Consider:

#! perl -w scipt

use strict;
use warnings;

use Data::Dumper 'Dumper';

my @file_names;

my $dir = "csv/";

opendir( DIR, $dir ) || die "can't opendir $dir: $!";
@file_names = grep { /^.*.csv/ && -f "$dir/$_" } readdir(DIR);

closedir DIR;

my $File_number = 0;
my @place_type;
my @place_name;
my @place_tag;
my @reglookup;

open( DIR_A_prep, "$dir/$file_names[0]" )
  || die "can't open file $file_names[0]: $!";

while (<DIR_A_prep>) {

    if ( $_ =~
m/^([^,]+),([^,]+),\d+,\d+,\d+,\d+,,\d+,\d+,\d+,\d+,,\d+,\d+,\d+,\d+/
      )
    {

        my $place_tag_string = $1 . "_" . $2;

        my $reglookup_tag_string = $1 . "," . $2;

        print
"\n>>>>>>>>>>>>>>>>>>>>>>\n$reglookup_tag_string\n>>>>>>>>>>>>>>>>>>>>
+>>.\n";

        $place_tag_string =~ s/ /\_/g;

        #   $place_tag_string  =~ s/\\s/\_/g;
        $place_tag_string =~ s/\"//g;

        $reglookup_tag_string =~ s/ /\\s/g;
        $reglookup_tag_string =~ s/\,/\\,/g;
        $reglookup_tag_string =~ s/\"/\\"/g;
        $reglookup_tag_string =~ s/\(/\\(/g;
        $reglookup_tag_string =~ s/\)/\\(/g;
        $reglookup_tag_string =~ s/\&/\\&/g;

        push( @place_type, $1 );
        push( @place_name, $2 );
        push( @place_tag,  $place_tag_string );
        push( @reglookup,  $reglookup_tag_string );

    }
}
close DIR_A_prep;

my $array_position = -1;

foreach (@place_tag) {

    next unless defined($_);

    $_ =~ s/ /\\s/g;

    $array_position++;


    print "\n@@@@@@@@@@\n\n$reglookup[$array_position]\n\n";

    foreach my $file_name (@file_names) {
        next unless defined($file_name);

        my $rl = $reglookup[$array_position];
        my $pt = $place_tag[$array_position];

        $File_number++;
        print "\n\n\n\n$rl, $dir, $file_name, $File_number, $pt\n\n\n\
+n";
        print_out_files( $rl, $dir, $file_name, $File_number, $pt );
    }
}


sub print_out_files {
    my %files;
    my ( $reglookup, $dir, $file_name, $File_number, $place_tag ) = @_
+;
    my $Is_it_printed = 0;

    $files{Outfile}   = "Result/Result_$place_tag.txt";
    $files{Outfile_B} = "Result/Result_B_$place_tag.txt";

    open( OUTFILE, "+>", $files{Outfile} )
      || die "Can't create output file $files{Outfile}: $!";
    open( OUTFILE_B, "+>", $files{Outfile_B} )
      || die "Can't create output file $files{Outfile_B}: $!";

    print "$file_name\n";
    open( DIR_A, "<$dir/$file_name" ) || die "can't open file $file_na
+me: $!";

    my $Sex_specificity;

    while ( my $line = <DIR_A> ) {
        my %cat;
        my $Cause_of_death_string;
        my $Cause_of_death_ICD;

        if ( $File_number == 1 ) {
            $files{First}{name} = $file_name;

            if ( $line =~ /^Statistic,([^,]*),,*/ ) {
                $files{First}{statistic} = $1;
                print OUTFILE_B "\n$files{First}{statistic}";
            }
            if ( $line =~ /^Age Group,([^,]*),,*/ ) {
                $files{First}{age_group} = $1;
                print OUTFILE_B "\n$files{First}{age_group}";
            }
            if ( $line =~ /^Period,([^,]*),,*/ ) {
                $files{First}{period} = $1;
                print OUTFILE_B "\n$files{First}{period}";
            }
            if ( $line =~ /^Scale,"{0,1}([^,]*)"{0,1},/ ) {
                $files{First}{scale} = $1;

                #    print OUTFILE_B "\n$files{First}{scale";
            }
        } else {
            $files{Current}{name} = $file_name;
            fail( 'statistic method', %files )
              if $line =~ /^Statistic,([^,]*),,*/
              and $files{First}{statistic} ne $1;
            fail( 'age group', %files )
              if $line =~ /^Age Group,([^,]*),,*/
              and $files{First}{age_group} ne $1;
            fail( 'time period', %files )
              if $line =~ /^Period,([^,]*),,*/ and $files{First}{perio
+d} ne $1;
            fail( 'time period', %files )
              if $line =~ /^Scale,"{0,1}([^,]*)"{0,1},/
              and $files{First}{scale} ne $1;
        }

        if ( $_ =~ /^Go to SHA,,MALES,,,,,FEMALES,,,,,PERSONS,,,/ ) {
            $Sex_specificity = "Both";
        } elsif ( $_ =~ /^Go to SHA,,MALES,,,\n/ ) {
            $Sex_specificity = "Males";
        } elsif ( $_ =~ /^Go to SHA,,FEMALES,,,\n/ ) {
            $Sex_specificity = "Females";
        }

        if ( $_ =~ /^Indicator\,\"{0,1}(.+)\"{0,1},,/ ) {
            print OUTFILE $1 . "\t";

            if ( $line =~
                /^Indicator\,\"{0,1}([^(]*)(\([^)]*\))\"{0,1}\:\"{0,1}
+,,/ )
            {
                $Cause_of_death_string = $1;
                $Cause_of_death_ICD    = $2;
            }
        }

        if ( $_ =~ m/^ENG\,ENGLAND,([^\n]+)/ )
        {    # Match any character except new line
            my @pos_A = split /\,/, $1;

            print "This is pos_A:  @pos_A \n\n";
            assignParams( $cat{EngWales}{$_}, splice @pos_A, 0, 4 )
              for qw(First Second Third);
        }

        if ( $_ =~ m/^$reglookup\,([^\n]+)/ ) {
            my @pos = split /\,/, $1;

            assignParams( $cat{PlaceX}{$_}, splice @pos, 0, 4 )
              for qw(First Second Third);
        }
    }

    if ( defined $Sex_specificity ) {
        print OUTFILE_B <<"CAUSE";


Cause of death\tICD-10\tM\tF\tAll\t Obs\tDSR\tL 95% CI\tU 95% CI\tE&W 
+Obs\tE&W DSR\tE&W L 95% CI\tE&W U 95% CI


CAUSE
    }

    if ( $Sex_specificity eq "Both" ) {

        # Do what needs doing here
    } elsif ( $Sex_specificity eq "Males" ) {

        # Do what needs doing here

    } elsif ( $Sex_specificity eq "Females" ) {

        # Do what needs doing here
    }

    close DIR_A;
    close OUTFILE;
    close OUTFILE_B;
}

sub fail {
    my ( $error, %files ) = @_;

    print
"There is a '$error' inconsistency between $files{Current}name and $fi
+les{First}{name}";
    unlink $files{Outfile};
    unlink $files{Outfile_B};
    exit;
}

sub assignParams {
    my ( $hash, @params ) = @_;

    $hash->{observed}                   = $params[0];
    $hash->{DSRs}                       = $params[1];
    $hash->{Lower_95_Confidence_Limits} = $params[2];
    $hash->{Upper_95_Confidence_Limits} = $params[3];
}
[download]

which is about half the length and includes the following changes:

• cleaned up with PerlTidy using default settings (which includes removing "extra" blank lines)
• use a hash for the file name related variables
• use a hash for the "cat" parameter related variables
• use three parameter open
• remove unused global variables
• make all variables as local as possible
• avoid the same name for scalar and array variables
• use $var++ rather than $var = $var + 1
• refactor error reporting code into a fail sub
• use elsif as appropriate to indicate exclusive if clauses
• remove "one use" variables
• refactor parameter extraction code into a assignParams sub
• refactor repeated print code into a single if ( defined $Sex_specificity ) controlled print

The "bug" may be due to the exit (now in sub fail) btw.

Please could people advise me on whether I need to start the program again.

Ditto as above wrt what all the others wrote. Your program makes my eyes bleed, period. Thus if you ask me, then yes: your should rewrite it from scratch. Of course you should first learn how to do so rather than posting either the same very snippets over and over again or whole programs with vague rfcs attached to them. Consider:

Which I got out GrandFather's improved version of your program by further:

• replacing the shebang line with one that makes sense;
• removing unnecessary stuff;
• declaring variables as close as possible to where they're used;
• using saner opens and opendirs;
• using low precedency logical operators for flow control, as is almost always best done;
• replacing the awkward /^.*.csv/ with the equivalent /csv/, provided that that is what you want;
• using a single @place array instead of the three ones you were;
• using more reasonable variable names that are neither extremely short nor too long and error-prone to remember and hard to parse when reading;
• removing the unnecessary and confusing $_ =~;
• writing a hopefully saner regex of the huge monster, (but then is a single regex the best way to do it? I don't think it is and I would go the split way instead, but that's too much of an intervention);
• using next for flow control rather than a huge if block;
• using tr instead of s where appropriate;
• using aliasing for's to avoid =~ madness;
• removing an unnecessary next unless defined $_ in a place where $_ can't be undefined - similarly later;
• removing unnecessary operations, like yet another s/ /\\s/g on something which had already undergone it;
• removing clumsy $array_position logic and also putting @reglookup data into @place
- d'oh, you made me step back some lines;

This is not a complete rewrite because arrived at the point at which I stopped I had grown completely tired, the rest of your code scared me and hey, nobody is paying me for this... I hope you get the picture and can go on yourself.

Consider that where I stopped I got 53 lines of reasonably terse code out of your original 99 ones. And I didn't want to change the logic too much, too.

Hi toolic,

"Does this program work the way you want it to work, and are you just wondering if there is a better way to recode it?"

A good question, and a nice post :) A great many people have told Win to read How do I post a question effectively? over the years, since most of his posts are very poorly written due to the lack of effort he has consistently shown. And yes, these questions are for his job, which he gets paid for. Win has been a member of this forum for years, and spent a vast percentage of that time ignoring the advice that he asks for, and not learning from his mistakes. Take a look at his post history should you wish to get a handle on his level of effort.

Martin

I think he meant 'trashed'.

my $EngWales_First_cat_observed;
  my $EngWales_First_cat_DSRs;
  my $EngWales_First_cat_Lower_95_Confidence_Limits;
  my $EngWales_First_cat_Upper_95_Confidence_Limits;
  
  my $EngWales_Second_cat_observed;
  my $EngWales_Second_cat_DSRs;
  my $EngWales_Second_cat_Lower_95_Confidence_Limits;
  my $EngWales_Second_cat_Upper_95_Confidence_Limits;
  
  my $EngWales_Third_cat_observed;
  my $EngWales_Third_cat_DSRs;
  my $EngWales_Third_cat_Lower_95_Confidence_Limits;
  my $EngWales_Third_cat_Upper_95_Confidence_Limits;

  my $PlaceX_First_cat_observed;
  my $PlaceX_First_cat_DSRs;
  my $PlaceX_First_cat_Lower_95_Confidence_Limits;
  my $PlaceX_First_cat_Upper_95_Confidence_Limits;
  
  my $PlaceX_Second_cat_observed;
  my $PlaceX_Second_cat_DSRs;
  my $PlaceX_Second_cat_Lower_95_Confidence_Limits;
  my $PlaceX_Second_cat_Upper_95_Confidence_Limits;

  my $PlaceX_Third_cat_observed;
  my $PlaceX_Third_cat_DSRs;
  my $PlaceX_Third_cat_Lower_95_Confidence_Limits;
  my $PlaceX_Third_cat_Upper_95_Confidence_Limits;

  my $Sex_specificity;
  
  my $Comparitor_file_statistic;
  my $Comparitor_file_age_group;
  my $Comparitor_file_period;
  my $Comparitor_file_scale;
[download]

overall, I think this program could benefit from an understanding of data structures, particular array and hash references. "Advanced Perl Programming" 2nd edition was great for this. 3rd edition by Cozens is a completely different animals. So, I recommend that you read perldsc and think hard about how it's contents could improve your program.

my $EngWales_First_cat_observed;
  my $EngWales_First_cat_DSRs;
  my $EngWales_First_cat_Lower_95_Confidence_Limits;
  my $EngWales_First_cat_Upper_95_Confidence_Limits;
  
  my $EngWales_Second_cat_observed;
  my $EngWales_Second_cat_DSRs;
  my $EngWales_Second_cat_Lower_95_Confidence_Limits;
  my $EngWales_Second_cat_Upper_95_Confidence_Limits;
[download]