Question : Perl Iteration issue

See attached code.  This is the main part of my Perl program.  Here is my data.txt file:

TYPE:
C:\Users\ddecker\Desktop\Dad\tiffs\filename.tif:
TIFF Directory at offset 0x10eb4
  Image Width: 1728 Image Length: 2376
  Resolution: 200, 200 pixels/inch
  Bits/Sample: 1
  Compression Scheme: CCITT Group 4
  Photometric Interpretation: min-is-white
  FillOrder: lsb-to-msb
  Document Name: "Standard Input"
  Image Description: "converted PBM file"
  Orientation: row 0 top, col 0 lhs
  Samples/Pixel: 1
  Rows/Strip: 2376
  Planar Configuration: single image plane
TYPE:
C:\Users\ddecker\Desktop\Dad\tiffs\filename2.tif:
TIFF Directory at offset 0x4aac
  Image Width: 1728 Image Length: 2376
  Resolution: 200, 200 pixels/inch
  Bits/Sample: 1
  Compression Scheme: CCITT Group 4
  Photometric Interpretation: min-is-white
  FillOrder: lsb-to-msb
  Document Name: "Standard Input"
  Image Description: "converted PBM file"
  Orientation: row 0 top, col 0 lhs
  Samples/Pixel: 1
  Rows/Strip: 2376
  Planar Configuration: single image plane
TYPE:
C:\Users\ddecker\Desktop\Dad\tiffs\filename3.tif:
TIFF Directory at offset 0x8
  Subfile Type: (0 = 0x0)
  Image Width: 124 Image Length: 124
  Resolution: 31, 31 pixels/inch
  Bits/Sample: 8
  Compression Scheme: None
  Photometric Interpretation: RGB color
  Software: "¼"
  Samples/Pixel: 3
  Rows/Strip: 55
  Planar Configuration: single image plane

Basically the program goes through and treats each section or "block" between each "TYPE:" sections.  So, everytime the program sees "TYPE:", it treats it as a new "set", and performs the code seen in the perl code.

If you look at the comments, there is some information for error checking.  My problem is the fact that when the program starts out with all needed information, but then the second block has missing information, then it doesn't work.  For example, take this data.txt sample (different from above; filename2.tif is missing Sample/Pixel.):

TYPE:
C:\Users\ddecker\Desktop\Dad\tiffs\filename.tif:
TIFF Directory at offset 0x10eb4
  Image Width: 1728 Image Length: 2376
  Resolution: 200, 200 pixels/inch
  Bits/Sample: 1
  Compression Scheme: CCITT Group 4
  Photometric Interpretation: min-is-white
  FillOrder: lsb-to-msb
  Document Name: "Standard Input"
  Image Description: "converted PBM file"
  Orientation: row 0 top, col 0 lhs
  Samples/Pixel: 1
  Rows/Strip: 2376
  Planar Configuration: single image plane
TYPE:
C:\Users\ddecker\Desktop\Dad\tiffs\filename2.tif:
TIFF Directory at offset 0x4aac
  Image Width: 1728 Image Length: 2376
  Resolution: 200, 200 pixels/inch
  Bits/Sample: 1
  Compression Scheme: CCITT Group 4
  Photometric Interpretation: min-is-white
  FillOrder: lsb-to-msb
  Document Name: "Standard Input"
  Image Description: "converted PBM file"
  Orientation: row 0 top, col 0 lhs
  Rows/Strip: 2376
  Planar Configuration: single image plane
TYPE:
C:\Users\ddecker\Desktop\Dad\tiffs\filename3.tif:
TIFF Directory at offset 0x8
  Subfile Type: (0 = 0x0)
  Image Width: 124 Image Length: 124
  Resolution: 31, 31 pixels/inch
  Bits/Sample: 8
  Compression Scheme: None
  Photometric Interpretation: RGB color
  Software: "¼"
  Samples/Pixel: 3
  Rows/Strip: 55
  Planar Configuration: single image plane

Normal output for the program is the following:

Processing filename.tif
Processing filename2.tif
Processing filename3.tif

However, when missing the data from above it should be:

Processing filename.tif
[ERROR]: Sample/Pixels data for filename2.tif not found.
[INFO]: filename.tif was not processed, too many errors.
Processing filename3.tif
Error log saved.

HOWEVER, it isn't doing this, the output is:

Processing filename.tif
Processing filename2.tif
Processing filename3.tif

Which means, that when it starts out with a good record, and then hits a "bad" or "missing data" record, it thinks it's good data for some reasons, and treats it as good and processes the data.  If I remove EVERYTHING from "TYPE: ... FILENAME ... and TIFF Directory at offset 0x4aac", from a record, THEN it sees the errors.  Makes no sense.  See this example:

TYPE:
C:\Users\ddecker\Desktop\Dad\tiffs\filename.tif:
TIFF Directory at offset 0x10eb4
  Image Width: 1728 Image Length: 2376
  Resolution: 200, 200 pixels/inch
  Bits/Sample: 1
  Compression Scheme: CCITT Group 4
  Photometric Interpretation: min-is-white
  FillOrder: lsb-to-msb
  Document Name: "Standard Input"
  Image Description: "converted PBM file"
  Orientation: row 0 top, col 0 lhs
  Samples/Pixel: 1
  Rows/Strip: 2376
  Planar Configuration: single image plane
TYPE:
C:\Users\ddecker\Desktop\Dad\tiffs\filename2.tif:
TIFF Directory at offset 0x4aac
TYPE:
C:\Users\ddecker\Desktop\Dad\tiffs\filename3.tif:
TIFF Directory at offset 0x8
  Subfile Type: (0 = 0x0)
  Image Width: 124 Image Length: 124
  Resolution: 31, 31 pixels/inch
  Bits/Sample: 8
  Compression Scheme: None
  Photometric Interpretation: RGB color
  Software: "¼"
  Samples/Pixel: 3
  Rows/Strip: 55
  Planar Configuration: single image plane

The output is as follows:

Processing filename.tif
[ERROR]: Width for filename2.tif not found.
[ERROR]: Length for filename2.tif not found.
[ERROR]: Resolution for filename2.tif not found.
[INFO]: filename2.tif was not processed, too many errors.
Processing filename3.tif
Error log saved.

So, basically, when NO data is present for a record, it works, but when 1 or more values (but not ALL) are missing for a record that is needed for output, it treats it as no errors.

Can anyone shed some light on this.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
$infile = 'data.txt';
#$infile = $batOutput;

## Output File Handles (open)
open(OUT1,"> \!".$state.$status."INFO.txt") or die "Can't open \!".$state.$status."INFO.txt: $!"; 
open(OUT2,"> \!".$state.$status."INFOspdsht.txt") or die "Can't open \!".$state.$status."INFO.txt $!";
open(ERRLOG,"> \!errors.log") or die "Can't open !errors.log $!";

## Print Headers To spdsht file
print OUT2 ";;;;Whitespace;;DPI ReSize;;;\n";
print OUT2 "Filename;Comp;AlphCnl;Foto;Wid;Len;Res 0;x0;;;MB\n";

## Configuration Data for masking data output
my %config = (
    'LZW'                               => 'colors',
    'Lempel-Ziv & Welch encoding'       => 'colors',
    'CCITT Group 4'                     => 'bkwhts',
    'CCITT Group 4 facsimile encoding'  => 'bkwhts',
    'None'                              => 'none',
    'none'								=> 'none',
    'RGB color'                         => 'colors',
    'min-is-white'                      => 'bkwhts',
    'min-is-black'                      => 'bkwhts',
    'palette color (RGB from colormap)' => 'colors',
    'Resolution'                        => sub {
                                            my @r = split(/, /, shift);
                                            $r[0] =~ s/\D//g;
                                            $r[1] =~ s/\D//g;
                                            return @r[0,1];
    },
);

my @config = keys %config;

my $file = $infile; # set this as needed.

open my $fh, '<', $file or die "can't open <$file> for reading $!";

$/ = "TYPE:\n";
while ( my $record = <$fh> ) {
    chomp $record;
    next if $record eq '';
    $record =~ s/(TIFF Directory at offset .+)\n//;
	
	## Future use, for incrementing errors
	$errorCount = 0;

    my ($fullpath, $data) = split(/\n/, $record, 2);
    $fullpath =~ s/:$//;

    my ($drv, $path, $file) = File::Spec->splitpath($fullpath);

	## Get Compression Scheme data
	$cs = $config{$1} if ($data =~ s/\s{2}Compression Scheme:\s+(.*?)\n//);
	if (!defined $cs) {
		print "[ERROR]: Compression Scheme for $file not found.\n";
		print ERRLOG "[ERROR]: Compression Scheme for $file not found.\n";
		$errorCount++;
		#next;
	}	
 	
 	## Get Photometric Interpretation data
 	$pi = $config{$1} if ($data =~ s/\s{2}Photometric Interpretation:\s+(.*?)\n//);
    if (!defined $pi) {
    	print "[ERROR]: Photometric Interpretation for $file not found.\n";
    	print ERRLOG "[ERROR]: Photometric Interpretation for $file not found.\n";
    	$errorCount++;
    	#next;
    }
    
    ## Get Bits/Sample data
    $bits = $1 if ($data =~ s/\s{2}Bits\/Sample:\s+(.*?)\n//);
    if (!defined $bits) {
    	print "[ERROR]: Bits/Sample data for $file not found.\n";
    	print ERRLOG "[ERROR]: Bits/Sample data for $file not found.\n";
    	$errorCount++;
    	#next;
    }
    
    ## Get Samples/Pixel data
    $pixels = $1 if ($data =~ s/\s{2}Samples\/Pixel:\s+(.*?)\n//);
    if (!defined $pixels) {
    	print "[ERROR]: Samples/Pixel data for $file not found.\n";
    	print ERRLOG "[ERROR]: Samples/Pixel data for $file not found.\n";
    	$errorCount++;
    	#next;
    }
    
    ## Get AlphaChnl Value (bits * pixels)
    $alphachnl = $bits * $pixels;
    if ($alphachnl == 1) {
    	$alphachnl = "bkwhts";
    }
    elsif ($alphachnl == 8) {
    	$alphachnl = "colors";
    }
    elsif ($alphachnl == 24) {
    	$alphachnl = "doLOGO";
    }
    else {
    	$alphachnl = "unknwn";
    }
    
    ## Get Resolution data
    my @r = $config{'Resolution'}->($1) if ($data =~ s/\s{2}Resolution:\s+(.*?)\n//);
    
    ## Get Width/Length data
    my ($w, $l) = ($1, $2) if ($data =~ s/\s{2}Image Width: (\d+) Image Length: (\d+)\n//);
    
    ## Width
	if (!defined $w) {
		print "[ERROR]: Width for $file not found.\n";
		print ERRLOG "[ERROR]: Width for $file not found.\n";
		$errorCount++;
		#next;
	}

    ## Length
	if (!defined $l) {
		print "[ERROR]: Length for $file not found.\n";
		print ERRLOG "[ERROR]: Length for $file not found.\n";
		$errorCount++;
		#next;
	}
	
	## Resolution
	if (!defined $r[0] || !defined $r[1]) {
		print "[ERROR]: Resolution for $file not found.\n";
		print ERRLOG "[ERROR]: Resolution for $file not found.\n";
		$errorCount++;
		#next;
	}	
		
	## Get Size of TIF(F) file(s)
	my $filesize = (-s $fullpath) / (1024 * 1024);
    my $size_in_mb = sprintf "%.2f", $filesize;
    
    ## Error Check
    if ($errorCount > 0) {
    	print "[INFO]: $file was not processed, too many errors.\n";
    	next;
    }
    
    $data =~ s/\n$//;

	## ** For Debugging - Prints To Screen **
    ## print $/, join(':', $file, $cs, $bits, $pi, $w, $l, @r, $size_in_mb, "\n"), $data, "\n";
    print "Processing $file\n";

    print OUT1 $/, join(';', $file, $cs, $bits, $pixels, $pi, $w, $l, @r, $size_in_mb, "\n"), $data, "\n";
    
    ## LA Output
    if ($state eq "LA") {
    	print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];;;", "$size_in_mb;;","\'$batch;;;;","start;","$file;;;;;;;;;;","$size_in_mb;","move;","$file;","$dir_root\\done;", "\n";	
    }
    ## NM Output
    elsif ($state eq "NM") {
    	print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];;;", "$size_in_mb;;","\'$batch;;;;","start;","$file;","$size_in_mb;","move;","$file;","$dir_root\\done;", "\n";
    	next;
    }
    ## OK/UT Output
    elsif ($state eq "OK" || $state eq "UT") {
    	print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];;;", "$size_in_mb;;","\'$batch;;;;","start;","$file;","$size_in_mb;","move;","$file;","$dir_root\\done;","start;",$file."f;","move;",$file."f;","$dir_root\\done\\TEMPdone;", "\n";
    	next;
    }
    ## TX/WY Output
    elsif ($state eq "TX" || $state eq "WY") {
    	print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];", "move $dir_root\\$file $dir_root\\$cs\\$file;;", "$size_in_mb;;", "\'$batch;;;","start;", "$dir_root\\$cs\\$file;", "$file;","$size_in_mb;","move;", "$dir_root\\$cs\\$file;", "$dir_root\\done;","start;", $file."f;", "move;", $file."f;", "$dir_root\\done\\TEMPdone;", "\n";
    	next;
    }
    elsif ($state eq "NONE" || $state eq "--" || $state eq "OTHER") {
    	print OUT2 "$file;", "$cs;", "$alphachnl;", "$pi;", "$w;", "$l;", "$r[0];$r[1];", "$size_in_mb\n";
    	next;
    }
}

close (OUT1) or die "Can't close out1: $!"; 
close (OUT2) or die "Can't close out2: $!"; 
close (ERRLOG) or die "Can't close error log: $!";
close ($fh) or die "Can't close $fh: $!";

Answer : Perl Iteration issue

Is the email address the ONLY item in that memo field? I"m betting it's not, so you'd have to have some method to find that Email address in the Memo field, and AFAIK there is no builtin macro action that will do that - you'll need to use Regular Expressions, which can evaluate a text string/file and return to you a matched string, based on the "expression" you supply.

The code attached below will do this. Just copy/paste those items into a new Standard Module (name that module basTextFunctions, or something like that), and then use the FindEmailInString function to return the first Email address located in the string. To do that, assuming you have a Form on which the Memo field is present, you could include a button to show the value:

Sub MyButton_Click()
  Msgbox  FindEmailInString(Me.YourMemoField)
End Sub

Note the code for that Regular Expression came from John Nurick's excellent page here: http://www.j.nurick.dial.pipex.com/Code/index.htm

To read more about Regular Expressions, see our own Patrick Matthew's article on Reg Ex: http://www.experts-exchange.com/articles/Programming/Languages/Visual_Basic/Using-Regular-Expressions-in-Visual-Basic-for-Applications-and-Visual-Basic-6.html?sfQueryTermInfo=1+30+express+regular





1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
Public Function FindEmailInString(StringToSearch As String) As String

Dim sExp As String

sExp = "\b[A-Z0-9._%+-][email protected][A-Z0-9.-]+\.[A-Z]{2,4}\b"
FindEmailInString rgxExtract(StringToSearch, sExp)

End Function
Public Function rgxExtract(Optional ByVal Target As Variant, _
    Optional Pattern As String = "", _
    Optional ByVal Item As Long = 0, _
    Optional CaseSensitive As Boolean = False, _
    Optional FailOnError As Boolean = True, _
    Optional Persist As Boolean = False) _
  As Variant
   
  'Regular expression matching function suitable for use
  'in VB/A generally and in Access queries.
  'By John Nurick. Updated 14 Jan 06.
   
  'Takes a search string (Target) and a regular expression
  '(Pattern), and an optional Item argument.
  '- If Item is omitted and a substring of Target matches Pattern,
  '  returns that substring.
  '- If Pattern includes grouping parentheses, a substring of Target
  '  matches Pattern, and Item is an integer, returns the submatch
  '  specified by Item (first submatch is item 0). If there aren't
  '  enough submatches, returns Null. Negative values of Item start
  '  counting with the last submatch.
  '- If no match, returns Null.
  '- Returns Null on error unless FailOnError is True.
  '  Always matches against the entire Target (i.e. Global and
  '  Multiline are True).
  
  'CaseSensitive matches regardless of case.
 
  'Persist controls whether the compiled RegExp object
  'remains in memory ready for the next call to the
  'function or whether it is disposed of immediately. This
  'means the function can be used in queries without having
  'to create, compile, use and destroy a new RegExp object for
  'each row being processed. But it also means that the object
  'remains in memory after the query has run. To destroy the
  'object and release the memory, call this function one
  'last time with no arguments.
  '
  'Calling the function with different arguments (e.g. a new
  'Pattern) recompiles the RegExp object, so
  'the function can be used in different queries. However there
  'may be problems if two threads are calling the function at
  'the same time.
 
  Const rgxPROC_NAME = "rgxExtract"
  Static oRE As Object 'VBScript_RegExp_55.RegExp
    'Static declaration means we don't have to create
    'and compile the RegExp object every single time
    'the function is called.
  Dim oMatches As Object 'VBScript_RegExp_55.MatchCollection
   
  On Error GoTo ErrHandler
  rgxExtract = Null 'Default return value
    'NB: if FailOnError is false, returns Null on error
 
  If IsMissing(Target) Then
    'This is the signal to dispose of oRE
    Set oRE = Nothing
    Exit Function 'with default value
  End If
   
  'Create the RegExp object if necessary
  If oRE Is Nothing Then
    Set oRE = CreateObject("VBScript.Regexp")
  End If
 
  With oRE
    'Check whether the current arguments (other than Target)
    'are different from those stored in oRE, and update them
    '(thereby recompiling the regex) only if necessary.
    If CaseSensitive = .IgnoreCase Then
      .IgnoreCase = Not .IgnoreCase
    End If
    .Global = True
    .Multiline = True
'    If Multiline <> .Multiline Then
'      .Multiline = Multiline
'    End If
    If Pattern <> .Pattern Then
      .Pattern = Pattern
    End If
 
  'Finally, execute the match
    If IsNull(Target) Then
      rgxExtract = Null
    Else
      Set oMatches = oRE.Execute(Target)
      If oMatches.Count > 0 Then
        If oMatches(0).SubMatches.Count = 0 Then
          'No ( ) group in Pattern: return the match
          If Item < 0 Then 'we're counting from last item
            'convert to count from the first item
            Item = oMatches.Count + Item
          End If
          Select Case Item
            Case Is < 0
              'Negative Item originally passed exceeded the
              'number of matches
              rgxExtract = Null
              If FailOnError Then
                Err.Raise 9
              End If
            Case Is >= oMatches.Count
              'Positive Item exceeded the number of matches
              rgxExtract = Null
              If FailOnError Then
                Err.Raise 9
              End If
            Case Else
              rgxExtract = oMatches(Item)
          End Select
         
        Else  'There are one or more ( ) captured groups in Pattern
              'return the one specified by Item
          With oMatches(0).SubMatches
            If Item < 0 Then 'we're counting from last item
              'convert to count from the first item
              Item = .Count + Item
            End If
            Select Case Item
              Case Is < 0
                'Negative Item originally passed exceeded the
                'number of submatches
                rgxExtract = Null
                If FailOnError Then
                  Err.Raise 9
                End If
              Case Is >= .Count
                'Positive Item exceeded the number of submatches
                rgxExtract = Null
                If FailOnError Then
                  Err.Raise 9
                End If
              Case Else 'valid Item number
                rgxExtract = .Item(Item)
            End Select
          End With
        End If
      Else
        rgxExtract = Null
      End If
    End If
  End With
 
  'Tidy up and normal exit
  If Not Persist Then Set oRE = Nothing
  Exit Function
 
ErrHandler:
  If FailOnError Then
    With Err
      Select Case .Number
        'Replace the default "object-defined error" message
        Case 9: .Description = "Subscript out of range (the Item number requested " _
          & "was greater than the number of matches found, or than the number of " _
          & "(...) grouping/capturing parentheses in the Pattern)."
        Case 13: .Description = "Type mismatch, probably because " _
          & "the ""Target"" argument could not be converted to a string"
        Case 5017: .Description = "Syntax error in regular expression"
        Case 5018: .Description = "Unexpected quantifier in regular expression"
        Case 5019: .Description = "Expected ']' in regular expression"
        Case 5020: .Description = "Expected ')' in regular expression"
      Case Else
        If oRE Is Nothing Then 'Failed to create Regexp object
          .Description = "Could not create VBScript.RegExp object. " & Err.Description
        Else 'Unexpected error
          .Description = rgxPROC_NAME & ": " & .Description
        End If
      End Select
      Set oRE = Nothing
      .Raise Err.Number, rgxPROC_NAME, _
          rgxPROC_NAME & "(): " & .Description
    End With
  Else 'Fail silently
    Err.Clear
    Set oRE = Nothing
  End If
End Function
Random Solutions  
 
programming4us programming4us