sulfericacid has asked for the wisdom of the Perl Monks concerning the following question:

I've posted my script on Tek-Tips the other day asking for help but the person who ran the script on their linux system said it ran without hesitation. Yesterday someone on PerlMonks ran and tested the identical code that's below and they say it works on their Windows XP system.

I am running Windows XP with ActiveState Perl 5.8.0 and the script will not work and will not post back any warnings or errors and no one has been able to help figure this out. Can everyone try running this script and let me know if it runs for you (the only part that doesn't work is the Find (f) feature )? Does anyone have any idea on how I could get this working on my system so I can begin finalizing the script?

Thanks so much.

#!/usr/bin/perl -W

use strict;
use warnings;
use POSIX;
use Fcntl;
use CGI;
use SDBM_File;

my %dbm;
my $test = "test.dbm";
my $name;

tie (%dbm, 'SDBM_File', $test, O_CREAT|O_RDWR, 0644)
   || die "Died tying database\nReason: $!";

# Printing option menu   
print "Aaron's Phonebook System\n\n\n";
print "f - find an entry\n";
print "a - add an entry\n";
print "m - modify an entry\n";
print "d - delete an entry\n";
print "r - read all entries\n";
print "e - erase all entries\n";

chomp(my $option = <STDIN>); 
$option =~s/\r//;

print "Option: $option\n";

#Add An Entry
if ($option eq 'a') {
  print "add an entry test!\n";

  print "Name:";
chomp(my $name = <STDIN>);

  print "Phone number:";
chomp(my $number = <STDIN>);

  print "Email Address:";
chomp(my $email = <STDIN>);

  print "Address Line 1:";
chomp(my $address1 = <STDIN>);

  print "Address Line 2:";
chomp(my $address2 = <STDIN>);

print "$name added to the list!\n";

# combine all data into one nicely snug package...I hope
$dbm{$name}=join "\0",$name,$number,$email,$address1,$address2;
$dbm{$name} =~s/\cM//g;
}

elsif ($option eq 'r') {
  foreach my $key ( sort keys %dbm ) {
    my($name, $number, $email, $addr1, $addr2) = split "\0", $dbm{$key
+};
    print "$name\n$number\n$email\n$addr1\n$addr2\n\n\n";
  }
  }
  
elsif ($option eq 'f') {
  print "Who are you looking for?\n";
  &find;
}
# Delete An Entry
elsif ($option eq 'd') {
  print "What name would you like removed?\n";

  &del;

}
elsif ($option eq 'e') {
  print "To delete all entries press y, to cancel press n\n";

&erase;

}
else {
  print "Wrong button!\n";
}

sub del {
 chomp(my $d = <STDIN>);

  if ($dbm{$d}) {
     delete $dbm{$d};
     print "$d deleted successfully\n";
      }
  else {
     print "$d not found\n";
     }
        }
        
sub find {
   chomp(my $f = <STDIN>);
   # $f=~tr/\r\z//d;
   #$f =~s/\r\z//;
   $f =~s/\cM//g;
     if (exists $dbm{$f}) {
     my($name, $number, $email, $addr1, $addr2) = split "\0", $dbm{$f}
+;  
   print "$name\n$number\n$email\n$addr1\n$addr2\n\n\n";
 }
   else {
     print "Name $f cannot be found in the directory.\n";
}   
      
  }      
        
sub erase {
   chomp(my $e = <STDIN>);
   $e =~s/\r//;

   if ($e eq 'y') {
     %dbm = ();
  
     print "All entries have been deleted.\n";
   }
   elsif ($e eq 'n') {
     print "Deleting process cancelled.\n";
   }
   else {
     print "Key was invalid, deletion process failed\n";
     }
  }        
untie %dbm;

[download]


"Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

sulfericacid

update (broquaint): added <readmore> tag

Replies are listed 'Best First'.
Re: Flawless Script problems?
by AcidHawk (Vicar) on Mar 13, 2003 at 06:41 UTC

    I managed to get it working.

    I changed you code a little here is what I came up with.

    Firstly...
    elsif ($option eq 'f') {
  print "Who are you looking for?\n";
  &find;
}

    [download]
    changed to 
    elsif ($option eq 'f') {
  print "Who are you looking for?\n";
  chomp(my $f = <STDIN>);
  $f =~s/\cM//g;
  if (!&find($f)) {
      print "Name $f cannot be found in the directory.\n";
}

    [download]
    Then I changed you find sub from 
    sub find {
   chomp(my $f = <STDIN>);
   # $f=~tr/\r\z//d;
   #$f =~s/\r\z//;
   $f =~s/\cM//g;
     if (exists $dbm{$f}) {
     my($name, $number, $email, $addr1, $addr2) = split "\0", $dbm{$f}
+;  
   print "$name\n$number\n$email\n$addr1\n$addr2\n\n\n";
 }
   else {
     print "Name $f cannot be found in the directory.\n";
}   
      
  }

    [download]
    to look as follows
    sub find {
    my $rc = 0;
    my $f = shift;
     foreach my $key ( sort keys %dbm ) {
            my($name, $number, $email, $addr1, $addr2) = split "\0", $
+dbm{$key};
            if ($name eq $f) {
                print "$name\n$number\n$email\n$addr1\n$addr2\n\n\n";
                $rc = 1;
                last;
            }
      }
}

    [download]

    Disclaimer: I know nothing about tie and less about SDBM_File but thats why I like perl.

    -----
    Of all the things I've lost in my life, its my mind I miss the most.
[reply]
[d/l]
[select]
      Thanks for your help! I still don't understand why the script would work on some computers but not others...for some people the find feature does work as it is, and it should work cause I see nothing wrong with the script anywhere (not saying I would recognize a problem anyways).

      I think I will end up trying to rewrite that entire section of code since what you did is just outside what I understand right now. (I haven't worked with $rc or shift yet). One thing I do find really interesting is if (!&find($f)) { . I understand what it's trying to say but I don't have the foggiest idea how you get from $dbm{$f} to if (!&find($f)) { .

      I will have a look into that too, lol. Thanks for your help, atleast it's working now :)

      "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

      sulfericacid
[reply]
[d/l]

        Perhaps a brief explination is in order.

        When you enter the option f (for Find) and ask who you want to look for. The answer is captured into $f. I have then run the &find subroutine passing it the name that was received ie: &find($f).

        This function I enclosed in an if not block to check the return of &find. So if the return, from &find, is 0(fail) then &find could not find a matching name otherwise &find returned a 1(pass).

        The &find subroutine is easy to explain...

        First you set a var to 0 (ie: $rc = 0;) this is what will be returned if NO match is found.

        Next we make a local var for &find = the name ($f) we sent to the sub-routine. This is done using shift.

        After that, all we do is, check if foreach key in the hash, equals the name we entered (now $f in &find). If it matches we set $rc to 1 and stop searching through the hash.
        &find returns the var $rc.

        Hope that doesn't comfuse you further.
        Cheers

        -----
        Of all the things I've lost in my life, its my mind I miss the most.
[reply]
[d/l]
[select]
Re: Flawless Script problems?
by AcidHawk (Vicar) on Mar 13, 2003 at 06:06 UTC

    I am running WinXP with AS perl 5.6 build 633. I ran y our script successfully. I could add entries, read all entries, delete entries, pressing m gave me Wrong Button.( I assume this is correct for now.) I could also erase all entries.

    I did have one problem though. I could not find an entry.

    HTH to narrow your search down a little.

    -----
    Of all the things I've lost in my life, its my mind I miss the most.
[reply]
      Thanks for testing out the script, I'm pleased to know the find feature doesn't work for someone other than me. As for right now M shouldn't work, I have no clue at this point on how to modify entries but I'll figure that out once I can get this to work.

      May I ask what HTH means?

      "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

      sulfericacid
[reply]
        May I ask what HTH means?

        Just take a look in the dictionary.

        hth ;)

        regards,
        tomte

[reply]
Re: Flawless Script problems?
by jsprat (Curate) on Mar 13, 2003 at 19:09 UTC
    Comment out use CGI; and it will work as you expect.

    One of the first things CGI.pm does on Win32 is binmode STDIN, STDOUT and STDERR. A side effect of binmode is that perl no longer does its transparent line-end adjustments.

    Try this little demo:

    use strict;
use warnings;

print "Just hit enter (before CGI)";
my $var = <STDIN>;
print ":", ord $_, ":" for (split //, $var);
print "\nChomping\n";
chomp $var;
print ":", ord $_, ":" for (split //, $var);
print "\n";

eval 'use CGI;';
print "Just hit enter (after CGI)";
$var = <STDIN>;
print ":", ord $_, ":" for (split //, $var);
print "\nChomping\n";
chomp $var;
print ":", ord $_, ":" for (split //, $var);

__END__
output:
Just hit enter (before CGI)
:10:
Chomping

Just hit enter (after CGI)
:13::10:
Chomping
:13:

    [download]

    As you see, there is a carriage return left after using CGI that isn't there before CGI.

[reply]
[d/l]
[select]
      + 1000000 votes for you (if i had that many that's how many you'd get, bad sadly I only have two left :( ). I took the line off and it runs like it should have the entire time! I have two questions for you though.

      If programming in commandline will you ever need to use CGI.pm then? Sorry if these seems stupid but I just stopped working on the web so I can learn perl quicker by debugging on my own system.

      If this is to be run on linux would they need to add use CGI; or will it run for them as well?

      Thanks so much!!! You are a life saver!!!!!!!!!

      "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

      sulfericacid

[reply]

        CGI is for parsing the environment passed to a web application. It handles parsing of variables returning from forms and other information passed to the application from the web server. It can also be used to assist in HTTP header and HTML generation. If your application is not being run by a web server in response to a browser request, you don't need to use CGI.

        ---
print map { my ($m)=1<<hex($_)&11?' ':'';
$m.=substr('AHJPacehklnorstu',hex($_),1) }
split //,'2fde0abe76c36c914586c';

        [download]
[reply]
[d/l]
Re: Flawless Script problems?
by sulfericacid (Deacon) on Mar 13, 2003 at 04:40 UTC
    Maybe it has something to do with the database itself. This is a screenshot of the test.dbm.pag file, here.

    When I run the program and click 'r' to read all entries it prints

    test
    test
    test
    test
    test

    Any ideas would be much appreciated.

    "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

    sulfericacid

[reply]
Re: Flawless Script problems?
by caedes (Pilgrim) on Mar 13, 2003 at 05:49 UTC
    You should try to edit your example script down to the smallest version that still doesn't work. That will really help to pinpoint the cause of the error.

    -caedes

[reply]

Back to Seekers of Perl Wisdom