Perl "Toolkit" Code Snippets

To whet your appetite for the next modules in the "Learning Perl" series, I'm going to include some "snippets" from the MFD and T&C "toolkits".  This is similar to the Perl Cookbook - a whole book devoted to Perl "recipes".

Let's backup a file, i. e., make another copy!  First, name the file:

	$BACKUP_FILE = "c:\\teleform\\exp\\kmt856ob.hld";

	(Note:  We need to "escape" the backslash [\] using a backslash)

then open the file for output:

	open(BACKUP,">$BACKUP_FILE") || die "cannot create $BACKUP_FILE:  $!";

and, finally, as part of our while read, print the copy:

	while($RECORD = <INPUT>) {

		print BACKUP $RECORD;

	}

and, don't forget to close the file:

	close(BACKUP);

How about spliting the fields of a comma separated values file whose name is stored in the variable name $RECORD into an array named @FIELDS?  That's as easy as

	@FIELDS = split(/,/,$RECORD);

Want HTML output?  Then, just define it and print!

$open_HTML="<html>\n";
$open_HTML_header="<head>\n";
$open_HTML_title="<title>\n";
$title="\t" . "HL Verifier\n";
$close_HTML_title="<\/title>\n";
$close_HTML_header="<\/head>\n";
$HTML_body="<body>\n";
$open_table="<table>\n";
$open_table_heading="<th nowrap colspan=\"5\">\n";
$close_table_heading="<\/th>\n";

o

o

o

=pod

 Print HTML Header, Title, Body, and Table elements up to the ROW loop to the output file

=cut

print OUTPUT $open_HTML;
print OUTPUT $open_HTML_header;
print OUTPUT $open_HTML_title;
print OUTPUT $title;
print OUTPUT $close_HTML_title;
print OUTPUT $close_HTML_header;
print OUTPUT $HTML_body;
print OUTPUT $open_table;
print OUTPUT $open_table_heading;
$table_heading="\t$input_filename\n";
print OUTPUT $table_heading;
print OUTPUT $close_table_heading;

Finally, let's call a subroutine to adjust the length of a field based on three parameters passed to the routine - fieldname, type of field, and length:

	$FIELDS[1] = &adjust_length($FIELDS[1],"AN",15);
and here's the code for the subroutine (with pod):
sub adjust_length {

=head1 Documentation for adjust_length subroutine

 To smooth the parameters for the sort, the sort keys are all "fixed length" fields.  
 In order, to insure "fixed length" this generic routine has been developed to adjust 
 lengths to the maximum length for the sort key's field

 Declare "local" variables

=cut

	my($field, $type, $maximum);

=pod

 Set variables to values passed to this subroutine

=cut

	($field, $type, $maximum) = @_;

=pod

 AN is alpha-numeric - left-justified and filled with spaces on the right based on 
 the length of original data in field (with addition of 2 for the beginning and 
 ending double-quotes)

=cut

	if ($type eq "AN") {
		$size = length($field);
		if ($size<$maximum+2) {
			for ($ndx = $size;$ndx < $maximum+2;$ndx++) {
				substr($field,$ndx-1,1) = " ";
			}
			$field = $field . '"';
		}
	}

=pod

 QN is quoted-numeric - right-justified and filled with zeroes on the left based on 
 the length of original data in field (with addition of 2 for the beginning and 
 ending double-quotes)

=cut

	elsif ($type eq "QN") {
			$size = length($field);
			if ($size<$maximum+2) {
				for ($ndx = $size;$ndx < $maximum+2;$ndx++) {
					substr($field,1,1) = "0";

					print 'QN = ' . $field . " ";

				}
				$field = '"' . $field;

				print 'QN at completion = ' . $field . '^';

			}
			print 'QN at maximum upon input = ' . $field . '^';
	}

=pod

 N is numeric - right-justified and filled with leading zeroes based on the length 
 of the original data in the field

=cut

	elsif ($type eq "N") {
			$size = length($field);
			if ($size<$maximum) {
				for ($ndx = $size;$ndx < $maximum;$ndx++) {
					substr($field,1,1) = "0";

					print 'N = ' . $field . '^';

				}

				print 'N at completion = ' . $field . '^';

			}
	}

=pod

 return value of $field upon completion

=cut

	return $field;
}

Well, there's loads more scripts from where those came from:

and if we can do that, then

So, keep an eye out for the second cycle of Learning Perl modules!