The easiest option here would be to use Tie::IxHash, which gives you order-preserving hashes:

#!/usr/bin/env perl    

use strict;
use warnings;

use Tie::IxHash;

my %hash;
tie(%hash, 'Tie::IxHash');
while (<DATA>) {
  chomp;
  $hash{$_}++;
}

print "$_: $hash{$_}\n" for keys %hash;

__DATA__
foo
bar
baz
foo
foo
bar

Output:

foo: 3
bar: 2
baz: 1

GingerC, on 21 March 2013 - 03:36 PM, said:

Hello and welcome aboard!

A general tip first which will make the process of learning Perl much more pleasant, or at least much easier: Always start programs (after the #!/usr/bin/perl line) with:

use strict;
use warnings;

They will catch and notify you of a broad range of problems with your code - including an error or two that I see in the code you posted.

Now, onward to your code!

if ($params{ZIP} = "Y" {
                                &Zip;
                        }

There are two problems here (aside from the missing parenthesis):

1) if ($params{ZIP} = "Y") sets $params{ZIP} to "Y", then always returns true (because "Y" is a true value). If you had turned "warnings" on, this would generate the warning "Found = in conditional, should be ==" to inform you of this problem, although that's not quite accurate - since you're doing a string comparison, you actually want eq, not ==. (Although, if you used ==, you'd get a different warning for using == to compare non-numeric values, so "warnings" would still get you where you needed to go.)

2) Calling user-defined subs by prefixing them with & is a holdover from Perl 4 and has non-obvious side-effects. The preferred practice in modern versions of Perl would be to call it as Zip() if you were using it as a regular function. However, the use of $self in the Zip code suggests that it's actually an object method, in which case you should be calling it as $some_object->Zip.
---

  my $self      = FormatSelf(@_);

That is... very strange. I can't say that it's wrong, since I have no idea what FormatSelf does, but the normal way for an object to find itself in Perl is

  my $self = shift;

---

opendir(CMDDIR, "$self->{SourceDir}") || $badcnt++;

Using bareword dirhandles is considered to be deprecated. The preferred option is to use a lexical dirhandle, like so:

opendir(my $cmd_dir, $self->{SourceDir});  # Removed useless use of quotes
unless (defined $cmd_dir) {
  print "ERROR: Cannot open <$self->{SourceDir}> directory for processing: $! \n";
  return 1;
} else {

Note that this also eliminates the need for $badcnt, so I redid the error-checking block for it, too. While I was at it, I added $! to the error message if the directory open fails. $! contains the operating system's error message, so this change will cause it to tell you why the directory couldn't be opened.
---

    @cf = readdir(CMDDIR);
    foreach (@cf) {
      if (/$self->{InputFileName}/) {
        #create an array containing the desired filenames
        push(@FILES, $_);
      }
    }

This can be simplified to:

@FILES = grep /$self->{InputFileName}/, readdir($cmd_dir);

---

        $func_exit =
          system("rm -f  $self->{DestDir}/$self->{OutputFileName}.zip");

You can do this directly within Perl:

unless (unlink "$self->{DestDir}/$self->{OutputFileName}.zip") {
  print "ERROR: Unable to delete <$self->{OutputFileName}.zip> file from <$self->{DestDir}> directory: $! \n"
  return 1;
}

Keeping it within Perl is a little more efficient (it avoids opening a new shell process to run the external command) and also avoids any potential security issues (e.g., if a malicious person were to install a rogue "rm" binary on your path ahead of the real one), so I recommend doing so when possible.
---

        $func_exit = system(
          "zip -j  $self->{DestDir}/$self->{OutputFileName}.zip $self->{SourceDir}/$_"

Keeping this within Perl is also good for the same reasons as I mentioned above, but Perl doesn't have a built-in "zip" function. However, we do have CPAN and several good modules implementing zip file compression, such as Archive::Zip. If you install that, you can then do:

use Archive::Zip ':CONSTANTS';
my $zip = Archive::Zip->new;
$zip->add_file("$self->{SourceDir}/$_");
unless($zip->writeToFileNamed("$self->{DestDir}/$self->{OutputFileName}.zip") == AZ_OK) {
  print "ERROR: Unable to zip/compress <$_> file into <$self->{OutputFileName}.zip> file. $!\n"
}

(Disclaimer: I've never actually used Archive::Zip myself. This code should be correct, or close to it, based on the Archive::Zip documentation, but I could be wrong.)
---
Finally, as a general point of style, you use the pattern

if ($something_went_wrong) {
  print "Error message";
  return 1;
} else {
  # do stuff
}

multiple times.

While this works, there's no need for the else block. Given that any code after the return won't be executed anyhow, it just pushes the indentation a bit further over for no good reason. Most programmers find it easier to read code with fewer levels of indentation, so it's generally preferred to use:

if ($something_went_wrong) {
  print "Error message";
  return 1;
}

# do stuff

instead.


So there are the things I see that could be improved in your code. As for whether you're actually doing it right or not, you'll need to run it and see whether it does what you intended or not - but it looks to me like it probably should do what you want it to.

jhay89, on 20 March 2013 - 08:20 PM, said:

On the one hand, push @array, [@$row] seems superficially like wasted effort - first you dereference $row, then create a reference to a brand-new anonymous array containing a copy of the array referenced by $row.

On the other hand, that may not be wasted effort because referencing a new array is a good thing in cases when the original could change. From memory, this is one of those cases - although I can't find documentation to confirm it, I seem to recall that DBI reuses its anonymous data structures behind the scenes, which means that if you just push @array, $row, you'll end up with several copies of the last returned row instead of one copy of each row.

On the gripping hand, DBI also provides a fetchall_arrayref method which would be the simplest way for you to get a reference to an array containing all rows. my $result = $sth->fetchall_arrayref; and you're done. />

jhay89, on 18 March 2013 - 06:48 PM, said:

In that case, you'll probably also want to use warnings; to get notifications about anywhere that you use uninitialized variables, mixing up numeric and string operators (e.g., checking $foo == "bar" instead of $foo eq "bar"), or other common mistakes that aren't serious enough to make strict shut everything down. (If you're already using perl -w, then warnings checks for the same things, but warnings is preferred over -w because warnings lets you selectively turn specific types of checks on or off in small sections of code, while -w is all-or-nothing.)

There's also use diagnostics, which gives more detailed explanations of any problems reported by use warnings, which can be helpful when you're not familiar with what all the standard warnings mean or why they might indicate problems.

jhay89, on 16 March 2013 - 12:05 AM, said:

You have a typo in that line, although it could just be a transcription error and not exist in your actual code. $row[1] should be $row->[1]. As written here, it's pulling element 1 from the array @row, which probably doesn't exist, rather than from the anonymous array referenced by $row.

If this typo exists in the actual code, then you definitely want to add use strict; near the beginning of your program. Doing so will turn typos like this into a compile-time error, causing the program to die with a message that you used a nonexistent variable, @row. Even if that line is correct in your actual program, you should still use strict; if you aren't already doing so - it's immensely helpful for finding bugs.

jhay89, on 16 March 2013 - 12:05 AM, said:

Your posted code doesn't show how you're attempting to access the data, but, if you're getting "HASH(0xdeadbeef)" as the value, that means you haven't dereferenced the reference. Try something like this:

for (sort keys %$result) {
  print $_ . "\t\ttimes: " . $result->{$_}{times} . "\tresult: " . $result->{$_}{result} . "\n";
}

or this (if you want to be a little more explicit about things):

for (sort keys %$result) {
  # $record is the anonymous hashref created by the line you asked about
  my $record = $result->{$_}
  print $_ . "\t\ttimes: " . $record->{times} . "\tresult: " . $record->{result} . "\n";
}

.