#! 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 $First_file_statistic; my $First_file_age_group; my $First_file_period; my $First_file_scale; my $First_file_name; 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 $place_type; my $place_name; my $place_tag; my $reglookup; my $array_position = -1; foreach (@place_tag){ next unless defined($_); $_ =~ s/ /\\s/g; $array_position = $array_position +1; $place_tag = $place_tag[$array_position]; $reglookup = $reglookup[$array_position]; print "\n@@@@@@@@@@\n\n$reglookup[$array_position]\n\n"; foreach (@file_names){ my $file_name = $_; next unless defined($file_name); $File_number = $File_number + 1; print "\n\n\n\n$reglookup, $dir, $file_name, $File_number, $place_ +tag\n\n\n\n"; print_out_files($reglookup, $dir, $file_name, $File_number, $place +_tag); #$reglookup, $dir, $file_name, $File_number, $place_tag } } sub print_out_files { print "I am here A";#sleep 1; my ($reglookup, $dir, $file_name, $File_number, $place_tag) = @_; my $Is_it_printed = 0; my $Outfile = "Result/Result_".$place_tag.".txt"; my $Outfile_B = "Result/Result_B_".$place_tag.".txt"; open (OUTFILE, "+>$Outfile") || die "Can't create output file $Outf +ile: $!"; open (OUTFILE_B, "+>$Outfile_B") || die "Can't create output file $ +Outfile_B: $!"; print "$file_name\n"; open (DIR_A, "<$dir/$file_name") || die "can't open file $file_name: + $!"; my $cause; 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; my $Cause_of_death_string; my $Cause_of_death_ICD; my $First_file_name; while (<DIR_A>){ my $line = $_; next unless defined($line); if ($File_number == 1){ $First_file_name = $file_name; if ($line =~ /^Statistic,([^,]*),,*/){ $First_file_statistic = $1; # This will match: Statistic +,Directly age-standardised rates (DSR),,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, +,,,, print OUTFILE_B "\n$First_file_statistic"; } if ($line =~ /^Age Group,([^,]*),,*/){ $First_file_age_group = $1; print OUTFILE_B "\n$First_file_age_group" } if ($line =~ /^Period,([^,]*),,*/){ $First_file_period = $1; print OUTFILE_B "\n$First_file_period"; } if ($line =~ /^Scale,"{0,1}([^,]*)"{0,1},/){ $First_file_scale = $1; # print OUTFILE_B "\n$First_file_scale"; } } else{ if ($line =~ /^Statistic,([^,]*),,*/){ $Comparitor_file_statistic = $1; # This will match: Stat +istic,Directly age-standardised rates (DSR),,,,,,,,,,,,,,,,,,,,,,,,,, +,,,,,,,,, if ($First_file_statistic ne $Comparitor_file_statistic){ print "There is a 'statistic method' inconsistency between ".$fi +le_name." and ".$First_file_name; unlink $Outfile; unlink $Outfile_B; exit; } } if ($line =~ /^Age Group,([^,]*),,*/){ $Comparitor_file_age_group = $1; if ($First_file_age_group ne $Comparitor_file_age_group){ print "There is a 'age group' inconsistency between ".$file_name +." and ".$First_file_name; unlink $Outfile; unlink $Outfile_B; exit; } } if ($line =~ /^Period,([^,]*),,*/){ $Comparitor_file_period = $1; if ($First_file_period ne $Comparitor_file_period){ print "There is a 'time period' inconsistency between ".$file_n +ame." and ".$First_file_name; unlink $Outfile; unlink $Outfile_B; exit; } } if ($line =~ /^Scale,"{0,1}([^,]*)"{0,1},/){ $Comparitor_file_scale = $1; if ($First_file_scale ne $Comparitor_file_scale){ print "There is a 'Scale' inconsistency between ".$file_name." a +nd ".$First_file_name; unlink $Outfile; unlink $Outfile_B; exit; } } } if ($_ =~ /^Go to SHA,,MALES,,,,,FEMALES,,,,,PERSONS,,,/){ $Sex_specificity = "Both"; } if ($_ =~ /^Go to SHA,,MALES,,,\n/){ $Sex_specificity = "Males"; } if ($_ =~ /^Go to SHA,,FEMALES,,,\n/){ $Sex_specificity = "Females" ; } if ($_ =~ /^Indicator\,\"{0,1}(.+)\"{0,1},,/){ $cause = $1; print OUTFILE $cause."\t"; if ($line =~ /^Indicator\,\"{0,1}([^(]*)(\([^)]*\))\"{0,1}\:\"{0 +,1},,/){ $Cause_of_death_string = $1; $Cause_of_death_ICD = $2; } } my @pos_A; if ($_ =~ m/^ENG\,ENGLAND,([^\n]+)/){ # Match any character excep +t new line @pos_A = split/\,/, $1; print "This is pos_A: @pos_A \n\n"; $EngWales_First_cat_observed = $pos_A[0]; $EngWales_First_cat_DSRs = $pos_A[1]; $EngWales_First_cat_Lower_95_Confidence_Limits = $pos_A[2]; $EngWales_First_cat_Upper_95_Confidence_Limits = $pos_A[3]; $EngWales_Second_cat_observed = $pos_A[5]; $EngWales_Second_cat_DSRs = $pos_A[6]; $EngWales_Second_cat_Lower_95_Confidence_Limits = $pos_A[7]; $EngWales_Second_cat_Upper_95_Confidence_Limits = $pos_A[8]; $EngWales_Third_cat_observed = $pos_A[10]; $EngWales_Third_cat_DSRs = $pos_A[11]; $EngWales_Third_cat_Lower_95_Confidence_Limits = $pos_A[12]; $EngWales_Third_cat_Upper_95_Confidence_Limits = $pos_A[13]; } my @pos; if ($_ =~ m/^$reglookup\,([^\n]+)/){ @pos = split/\,/, $1; my $Place = $1; $PlaceX_First_cat_observed = $pos[0]; $PlaceX_First_cat_DSRs = $pos[1]; $PlaceX_First_cat_Lower_95_Confidence_Limits = $pos[2]; $PlaceX_First_cat_Upper_95_Confidence_Limits = $pos[3]; $PlaceX_Second_cat_observed = $pos[5]; $PlaceX_Second_cat_DSRs = $pos[6]; $PlaceX_Second_cat_Lower_95_Confidence_Limits = $pos[7]; $PlaceX_Second_cat_Upper_95_Confidence_Limits = $pos[8]; $PlaceX_Third_cat_observed = $pos[10]; $PlaceX_Third_cat_DSRs = $pos[11]; $PlaceX_Third_cat_Lower_95_Confidence_Limits = $pos[12]; $PlaceX_Third_cat_Upper_95_Confidence_Limits = $pos[13]; } } if ($Sex_specificity eq "Both"){ if ($Is_it_printed == 0 ){ print OUTFILE_B "\n\nCause of death\tICD-10\tM\tF\tAll\t Obs\tDS +R\tL 95% CI\tU 95% CI\tE&W Obs\tE&W DSR\tE&W L 95% CI\tE&W U 95% CI\n +\n"; $Is_it_printed = 1; } # Do what needs doing here } if ($Sex_specificity eq "Males"){ if ($Is_it_printed == 0 ){ print OUTFILE_B "\n\nCause of death\tICD-10\tM\tF\tAll\t Obs\tDS +R\tL 95% CI\tU 95% CI\tE&W Obs\tE&W DSR\tE&W L 95% CI\tE&W U 95% CI\n +\n"; $Is_it_printed = 1; } # Do what needs doing here } if ($Sex_specificity eq "Females"){ if ($Is_it_printed == 0 ){ print OUTFILE_B "\n\nCause of death\tICD-10\tM\tF\tAll\t Obs\tDS +R\tL 95% CI\tU 95% CI\tE&W Obs\tE&W DSR\tE&W L 95% CI\tE&W U 95% CI\n +\n"; $Is_it_printed = 1; } # Do what needs doing here } close DIR_A; close OUTFILE; close OUTFILE_B; }
In reply to Problem with program structure by Win
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |