Code Review Time!

[linuxkid]

So, I have some code, that always errors, this is the error:No -label at C:/strawberry/perl/site/lib/Tk/Widget.pm line 256. Here is the code that does causes it, it gets annoying. I Updated the code listing on here.

#!/usr/bin/perl
#############################################
# Call List Manager, Copyright 2012 Sam     #
# Flint, [e-mail].                #
# Licensed under the GNU GPLv3              #
#############################################
# PMDF                                      #
# Version: 1.0                              #
# License: GNU GPLv3                        #
# Name: Call List Manager                   #
# File: clm.pl                              #
# Author: Sam Flint, [e-mail]     #
# Maintainer: Sam Flint, [e-mail] #
# Commenting: verbose                       #
#############################################

#Extensions Needed
use Tk;
use PDF::Reuse;
use YAML::Tiny;
use Tk::Tree;
use Tk::ROText;
use Tk::LabEntry;
use Tk::Text;

$iparse = YAML::Tiny->new();

$Mw = MainWindow->new(-title=> "Calling List Manager");
$menuitems = 
[
   [Cascade => "File", -menuitems=>
      [
         [Button => "~Open", -command=> \&open],
         [Button => "~Save", -command=> \&savefile],
         [Button => "Save ~As", -command=> \&saveas],
         #[Seperator => ""],
         [Button => "E~xit", -command=> \&exitprog],
      ]
   ],
   [Cascade => "Edit", -menuitems=>
      [
         [Button => "Add Calle~r", -command=> \&acaller],
         [Button => "Add Calle~e", -command=> \&acallee],
         #[Seperator => ""],
         [Button => "Remove Caller", -command=> \&rcaller],
         [Button => "Remove Callee", -command=> \&rcallee],
         #[Seperator => ""],
         [Button => "~Generate Call Lists", -command=> \&generate],
         [Button => "~Mail Call Lists", -command=> \&mailout],
         #[Seperator => ""],
         [Button => "~Preferences", -command=> \&prefs],
      ]
   ],
   [Cascade => "Help",  -menuitems=>
      [
         [Button => "~About", -command=> \&about],
         [Button => "~Help", -command=> \&help],
      ]
   ]
];
$menubar = $Mw->Menu(-menuitems => $menuitems);
$Mw->configure(-menu => $menubar);
$wframe = $Mw->Frame()->pack(-side=>'top', -fill=>'both', -expand => 1
+);
$tree = $wframe->Scrolled(
   'Tree',
   -relief             => 'flat',
   -scrollbars         => 'osoe',
   -borderwidth        => 0,
   -separator         => '.',
   -drawbranch        => 'true',
   -indicator         => 'true',
)->pack(-side => 'top', -fill => 'both', -expand => 1);
$inf = $Mw->Frame()->pack(-side=> "top", -fill=> "x", -expand=> 1);
$inf->Label(-text=> "Status:")->pack(-side=>'left', -expand=> 1);
$inf->Label(-textvariable=> \$message)->pack(-side=>'left', -fill=>'x'
+, -expand=> 1);
$inf->Label(-text=> "Save State")->pack(-side=>'left', -fill=>'x',, -e
+xpand => 1);
$inf->Label(-textvariable=> \$savestate)->pack(-side=>'left', -fill=>'
+x', -expand => 1);

#openprefs();
MainLoop();

# main Subs

$helptext = <<EOF;

EOF

sub ginf {
   $tree->info('selection');
}


sub openfile   {
   our $file = $Mw->getOpenFile();
   our $data = $iparse->read($file) || $Mw->Dialog(-title=> "File Open
+ Error", -text=>"$!: Cannot Open File: $file!", -buttons=>["Ok"], -de
+faultbutton=>"Ok", -bitmap=> "warning")->show();;
   our @list;
   our @callers;
   foreach (<FH>) {
      if ($type eq "caller")  {
         $id = shift @fields;
         $phnum = shift @fields;
         $email = shift @fields;
         $address = shift @fields;
         $notes = shift @fields;
         $data->{$id}->{type} = 'caller';
         $data->{$id}->{name} = $id;
         $data->{$id}->{phnum} = $phnum;
         $data->{$id}->{email} = $email;
         $data->{$id}->{addr} = $address;
         $data->{$id}->{notes} = $notes;
         push @list, $id;
         push @callers, $id;
      }  elsif($type eq "callee")   {
         $caller = shift @fields;
         $name = shift @fields;
         $phnum = shift @fields;
         $email = shift @fields;
         $address = shift @fields;
         $notes = shift @fields;
         $id = $caller.'.'.$name;
         $data->{$id}->{type} = 'callee';
         $data->{$id}->{name} = $name;
         $data->{$id}->{phnum} = $phnum;
         $data->{$id}->{email} = $email;
         $data->{$id}->{addr} = $address;
         $data->{$id}->{caller} = $caller;
         $data->{$id}->{notes} = $notes;
         push @list, $id;
      }  else  {
         next;
      }
   }
   redotree();
}

sub redotree   {
   $tree->delete(0, 'end');
   my $col = 0;
   foreach $node (@job_list) {
      $node_name = (split('.', $node))[-1];
      $node_name = $node if ($node_name eq '');
      $tree->add($node);
      $tree->itemCreate(
         $node, $col,
         -text     => $node_name,
         -itemtype => 'text');
   }
   $tree->autosetmode();
}

sub savefile   {
   $sfile = $file;
   $sfile ||= shift;
   $data->write($sfile);
}

sub saveas     {
   savefile($Mw->getSaveFile());
}

sub exitprog   {
   savefile();
   $Mw->Withdraw();
   exit;
}

sub acaller    {
   editentry("boogie", "new", "caller");
}
   
sub acallee    {
   editentry("boogie", "new", "callee");
}

sub rcaller    {
   
}

sub rcallee    {
   
}

sub generate   {
   
}

sub mailout    {
   
}

sub prefs      {
   
}

sub about      {
   $tlw = $Mw->Toplevel(-title=> "About");
   $info = $tlw->ROText()->pack(-side => 'top', -fill => 'both', -expa
+nd => 1);
   $info->insert('end', "Calling List Manager, Copyright, 2012 Sam Fli
+nt.\n");
   $info->insert('end', "Version 1.0\n");
   $info->insert('end', "Registered to $conf->{registered}\n");
   $tlw->Button(-text=> "Ok", -command=> sub { $tlw->withdraw })->pack
+();
}

sub help       {
   $tlw = $Mw->Toplevel(-title=>"Help");
   $info = $tlw->ROText()->pack(-side => 'top', -fill => 'both', -expa
+nd => 1);
   $tlw->Button(-text=> "Ok", -command=> sub { $tlw->withdraw })->pack
+();
   $info->insert('end', $helptext);
}

sub editentry  {
   $path = shift;
   $stat = shift;
   $type = shift || $data->{$path}->{type};
   if ($stat eq 'new')  {
      $tlw = $Mw->Toplevel("New Entry");
      if ($type eq "caller")  {
         $tlw->LabEntry(-text=>"Name", -textvariable=>\$id)->pack(-fil
+l=>'x');
         $tlw->LabEntry(-text=>"Phone Number", -textvariable=>\$phnum)
+->pack(-fill=>'x');
         $tlw->LabEntry(-text=>"Email", -textvariable=>\$id)->pack(-fi
+ll=>'x');
         $tlw->LabEntry(-text=>"Address", -textvariable=>\$id)->pack(-
+fill=>'x');
         $tlw->Text(-text=>"Name", -textvariable=>\$notes)->pack(-fill
+=>'x');
         $tlw->Button(-text=> "Ok", -command=> 
            sub {
               $data->{$id}->{name} = $name;
               $data->{$id}->{type} = 'caller';
               $data->{$id}->{phnum} = $phnum;
               $data->{$id}->{email} = $email;
               $data->{$id}->{addr} = $address;
               $data->{$id}->{notes} = $notes;
         })->pack(-fill=>'x');
      }  elsif($type eq "callee")   {
         
      }  else  {
         $tlw->withdraw();
      }
   }  elsif($stat eq 'old')   {
      $tlw = $Mw->Toplevel(-title=> "Edit Entry");
   }  else  {
      redotree();
   }
}

sub openprefs  {
   open FH, "~/clm.conf";
   bless our $conf;
   foreach (<FH>) {
      ($key, $value) = split /:/;
      $conf->{$key} = $value;
   }
}

__END__

Please ignore unwritten subs, I have to get the interface working, otherwise it won't matter.

[davido]

Your question's title "Code Review Time!" gives me the impression you're looking for comments on the code. But the body of your post seems to be asking a question about a specific error, which is quite different from a code review. Which would you prefer?

If you're really looking for a code review, start with Perl::Critic. Install the module, then "perlcritic yourscript.pl" Once you resolve any of the critiques there that make sense for your particular code (such as code before strictures), and once your code can be run with 'warnings' and 'strict', without generating warnings and errors, you might be ready for a human code review, although I would first re-run perlcritic at a stronger severity level, addressing as many of the additional critiques it comes up with as is practical. I've found that it isn't always relevant, possible, or wise to apply all of its advice, but at least looking at the advice and making conscious decisions about whether or not to take further action is an exercise that sometimes helps to uncover bugs and maintainability shorcomings.

But until then I think you should probably be asking a question that is more specific to the nature of the error you're getting. For that, I think we would need more information, and a code snippet that just produces the error without a bunch of unnecessary code for us to sift through. In particular, you need to try to narrow down the list of dependencies needed to produce the error. I'd rather not install a whole bunch of modules I don't need, but wouldn't be opposed to installing the one or two that are required to replicate the error. You may even find that in trying to narrow the code down to the smallest test case that can possibly produce the error, you'll find out what the error actually is.

Update: I do have one other thought though; when I installed Tk (Strawberry/Windows) I find that it won't even pass its own test suite, nor will several of the modules you're using. If you installed with the 'force' option to make it install despite failing its test suite (as opposed to actually fixing all the problems), you may just be reaping what you sewed.

[linuxkid]

well, yes i forced. but this was going to be pacaged with pp for a standalone executable for a charity i work with that make alot of calls. now i have to fanagle with stuff

[jwkrahn]

When I compile your code I get:

$ perl -c   959680.pl
Type of arg 1 to push must be array (not scalar dereference) at 959680
+.pl line 95, near "@list;"
Type of arg 1 to push must be array (not scalar dereference) at 959680
+.pl line 96, near "@callers;"
Type of arg 1 to push must be array (not scalar dereference) at 959680
+.pl line 112, near "@list;"
959680.pl had compilation errors.

Which refers to these three lines:

     95          push $id, @list;
     96          push $id, @callers;

    112          push $id, @list;

The first argument to push must be an array.    Perhaps you meant:

     95          push @list, $id;
     96          push @callers, $id;

    112          push @list, $id;





If I enable warnings I get these messages:

$ perl -Mwarnings -c   959680.pl
Name "main::key" used only once: possible typo at 959680.pl line 232.
Name "main::savestate" used only once: possible typo at 959680.pl line
+ 65.
Name "main::job_list" used only once: possible typo at 959680.pl line 
+123.
Name "main::message" used only once: possible typo at 959680.pl line 6
+3.
959680.pl syntax OK

[Anonymous Monk]

The first argument to push must be an array.

If you're not using perl 5.14

http://pastehtml.com/view/1e8ud19.html#p5140-Array_and_hash_container_functions_accept_references

[thundergnat]

Umm. wow. You've got some problems here. Ok, to very narrowly answer your question; the error:

No -label at C:/strawberry/perl/site/lib/Tk/Widget.pm line 256.

is caused by your menu commands not having any -label parameter. -text (or in this case, text) is not a valid parameter name for a Tk menu command. Look up valid parameters in perldoc Tk::Menu under $menu->add(type, ?option, value, option, value, ...?)

Some other problems that jumped out after a brief perusal:

There's no menu method seperator, it is spelled separator. Weird since you have it spelled correctly in some places, not in others.

The array and value being pushed are reversed in several push operations. push @list, $id; not push $id, @list;

You are missing a sigil on $key in line 237: $conf->{$key} = $value; not $conf->{key} = $value;

Seriously, activate the warnings and strict pragmas and fix or at least investigate everything that they report. If you are a fairly new Perl programmer it is worth it. Yes, turning them on will make perl complain about things that are not necessarily "wrong", but it will reduce the effort you need to spend debugging by orders of magnitude.

[zentara]

As far as code review goes, the first thing to do is add

use warnings;
use strict;

as others pointed out. It helps avoid the very type of problem you experience, and makes it easier for others, like us, to work with your code.