Some CC, please?

JHeaton · 2012-06-16 20:56:33

Hello everyone. About a year ago I wrote a little todo-list manager for myself to track tasks I had to do. It wasn't overly complex, but it was the first program I'd written from scratch that was non-trivial. It was horribly-coded and I didn't really know what I was doing with the language, but after I got it working I left it on the side. I rewrote it today and I think it's better than it was, but could probably still do with some improvements (I'm not a great programmer by any means, but I'd like to learn how to get better!). If someone could look over this and tell me if there's anything that could be improved on (either Perl-specific or general programming practice) then I would appreciate it. No doubt there's something ridiculous in there that I've missed! :)

Payment in e-cookies, of course.

#!/usr/bin/env perl

use strict;
use warnings;

use Env;
use Scalar::Util qw(looks_like_number);

my $conf = $XDG_CONFIG_HOME . "/ptdl.conf";
my %config = &parse_config($conf);
my $list = $config{'list_file'};

&check_list($list);
&parse_args($list);

# Subroutines
sub add_item
{
    my ($list_file, $task) = @_;

    open(LIST, ">>$list_file");
    print LIST "[ ] $task\n";
    close(LIST);

    print "$task added succesfully!\n";
}

sub check_list
{
    my ($list_file) = $_[0];

    if (! -e $list_file)
    {
        print "No list file exists at present. Create one now (y/n)? ";
        my ($yes_no);
        $yes_no = <STDIN>;
        chomp($yes_no);

        if (lc($yes_no) eq 'y')
        {
            open(LIST, ">$list");
            close(LIST);
        }
        else
        {
            die "No list file created. ptdl requires a list in order to run.\n";
        }
    }
}

sub delete_item
{
    my ($list_file, $task_num) = @_;

    if (looks_like_number($task_num))
    {
        open(LIST, $list_file);
        my (@list_data) = <LIST>;
        close(LIST);

        if ($task_num <= ($#list_data + 1))
        {
            splice(@list_data, ($task_num - 1), 1);

            open(LIST, ">$list_file");
            print LIST @list_data;
            close(LIST);

            print "Task $task_num was successfully removed.\n";
        }
        else
        {
            die "Line $task_num is beyond the end of the file.\n"
        }
    }
    else
    {
        die "$task_num is not a valid record ID. Please enter a number.\n";
    }
}

sub list
{
    my ($list_file, $selection) = @_;

    open(LIST, $list_file);
    while (<LIST>)
    {
        if ($selection eq "a")
        {
            print;
        }
        elsif ($selection eq "c")
        {
            if (substr($_, 0, 3) eq '[*]')
            {
                print;
            }
        }
        elsif ($selection eq "i")
        {
            if (substr($_, 0, 3) eq '[ ]')
            {
                print;
            }
        }
    }
    close(LIST);
}

sub parse_args
{
    my ($list_file) = $_[0];
    my (@args);
    my ($arg);

    if (@ARGV)
    {
        @args = @ARGV;

        do
        {
            $arg = shift(@args);

            if ($arg eq "-c" || $arg eq "--complete")
            {
                my ($task_num) = shift(@args)
                    or die "You must specify a task to mark.\n";

                &toggle_complete($list_file, $task_num);
            }
            elsif ($arg eq "-d" || $arg eq "--delete")
            {
                my ($task_num) = shift(@args)
                    or die "You must specify a task to delete.\n";

                &delete_item($list_file, $task_num);
            }
            elsif ($arg eq "-h" || $arg eq "--help")
            {
                &usage();
            }
            elsif ($arg eq "-l" || $arg eq "--list")
            {
                &list($list_file, "a");
            }
            elsif ($arg eq "--list-complete")
            {
                &list($list_file, "c");
            }
            elsif ($arg eq "--list-incomplete")
            {
                &list($list_file, "i");
            }
            elsif ($arg eq "-n" || $arg eq "--new")
            {
                my ($string);
                my (@string);

                while (@args)
                {
                    if (substr($args[0], 0, 1) ne "-")
                    {
                        my ($param) = shift(@args)
                            or die "You must provide a task to add.\n";
                        push(@string, $param);
                    }
                }

                $string = join(' ', @string);

                &add_item($list_file, $string);
            }
            else
            {
                die "Unrecognised argument $arg.\n";
            }
        }
        until (!@args);
    }
    else
    {
        &usage();
    }        
}

sub parse_config
{
    my ($config_file) = $_[0];

    if (-e $config_file)
    {
        my (%config_vals);

        open(CONF, $config_file);
        while(<CONF>)
        {
            next if (/^#|^\s*$/);
            my ($key, $val) = split /=/;
            $config_vals{$key} = $val;

            return %config_vals;
        }
    }
    else
    {
        print "No configuration file found at $config_file. Create now (y/n)? ";
        my ($yes_no);
        $yes_no = <STDIN>;
        chomp($yes_no);

        if (lc($yes_no) eq "y")
        {
            print "Creating default config file.\n";
            open(CONF, ">$config_file");
            print CONF "list_file=$HOME/todo.list";
            close(CONF);
        }
        else
        {
            die "No config file available.\n";
        }
    }
}

sub toggle_complete
{
    my ($list_file, $task_num) = @_;

    if (looks_like_number($task_num))
    {
        open(LIST, $list_file);
        my (@list_data) = <LIST>;
        close(LIST);

        if ($task_num <= ($#list_data + 1))
        {
            my ($str) = $list_data[$task_num - 1];
            my ($str_check) = $str;
            $str_check = substr($str_check, 0, 3);

            if ($str_check eq '[ ]')
            {
                substr($str, index($str, '[ ]'), 3, '[*]');

                print "Task $task_num marked complete.\n";
            }
            else
            {
                substr($str, index($str, '[*]'), 3, '[ ]');

                print "Task $task_num marked incomplete.\n";
            }

            splice(@list_data, ($task_num - 1), 1, $str);

            open(LIST, ">$list_file");
            print LIST @list_data;
            close(LIST)
        }
        else
        {
            die "Line $task_num is beyond the end of the file.\n";
        }
    }
    else
    {
        die "$task_num is not a valid record ID. Please enter a number.\n";
    }
}

sub usage
{
    print << "EOF";
usage $0 [opt] [arg]
  -c, --complete <id>     toggles selected task between complete and incomplete
  -d, --delete <id>       removes the specified task from the list
  -h, --help              displays this help text
  -l, --list              lists all tasks
      --list-complete     lists complete tasks only
      --list-incomplete   lists incomplete tasks only
  -n, --new <string>      adds the text as a new task
EOF

    print "\n";
    exit;
}

juster · 2012-06-17 18:19:07

Most people use %ENV instead of the module Env. Env is sketchy when people don't have env. vars defined.

looks_like_number returns true for many more types of numbers than you account for. This returns true for negative numbers and numbers in scientific notation. You'd be better off just using a regex like: $foo =~ /^\d+$/;.

A good habit is to always use the three-argument form of open. The two argument form is vulnerable to injection by modifying the first character in the filename (i.e. prepending $path with '|rm -rf;echo').

The Getopt::Long and Tie::File modules would make things much easier for you.

Calling a subroutine with an ampersand prefixing its name (&foo();) is perl4 syntax from a long long time ago. Some people say it looks nice. I think it looks like crap. In perl5, when you do this you are telling perl to ignore the prototypes of the sub you are calling. This might bite you in the ass one day.

List context is weird. At the top of your subs you take the one parameter like this:

sub parse_config
{
    my ($config_file) = $_[0];
...

($config_file) is a list of one scalar: $config_file. $_[0] is not a list, just a scalar. It is converted into a list of one element. The RHS list is stored into the LHS list and viola. You can write it the same as all your other subs, though, because ($config_file) is a list and @_ is an array. The array turns into a list and the RHS list is stored into the LHS list. Anyways, you can write it like this:

sub parse_config
{
    my ($config_file) = @_;
...

You can also use my $foo; instead of my ($foo); if you would like to. I noticed you always use parenthesis. The parenthesis aren't required and actually mean something slightly different because of list context. Like here on like 35:

        my ($yes_no);
        $yes_no = <STDIN>;

Could simply be:

        my $yes_no = <STDIN>;

The second example reads <STDIN> in scalar context, which only reads a line. If you did my ($yes_no) = <STDIN> this would not do what you wanted because it reads <STDIN> in list context, which reads all lines.

edit: I forgot to mention that parse_config does not return a hash when it creates the config file. Line 10 expects a hash to always be returned.

Last edited by juster (2012-06-17 18:20:52)

JHeaton · 2012-06-17 21:15:12

Hi juster, thank you very much, I appreciate you taking the time to read through and reply.

Most people use %ENV instead of the module Env. Env is sketchy when people don't have env. vars defined.

Okay, noted. I'll look in to this. I guess I assumed that the variables I wanted to use would be defined by default, so if that's the case then I shall work on changing it.

looks_like_number returns true for many more types of numbers than you account for. This returns true for negative numbers and numbers in scientific notation. You'd be better off just using a regex like: $foo =~ /^\d+$/;.

Didn't realise this, thanks for pointing it out. I don't really know much about regexes but it looks like it might be time to start investigating. Are there any other recommended ways of making this check?

A good habit is to always use the three-argument form of open. The two argument form is vulnerable to injection by modifying the first character in the filename (i.e. prepending $path with '|rm -rf;echo').

That would be:

open(LIST, "<", $list_file);

Rather than:

open(LIST, $list_file);

Right?

Calling a subroutine with an ampersand prefixing its name (&foo();) is perl4 syntax from a long long time ago. Some people say it looks nice. I think it looks like crap. In perl5, when you do this you are telling perl to ignore the prototypes of the sub you are calling. This might bite you in the ass one day.

So as long as I make sure to always call with parentheses, I can just ditch the ampersand completely (except if I'm crazy and give my sub the same name as a builtin)?

The Getopt::Long and Tie::File modules would make things much easier for you.

In the previous version of this program, I did actually make use of Getopt::Long, but I found it a bit more awkward to deal with allowing a user to enter a string separated by spaces without quotation marks; the if/elsif way actually felt easier for me. It might be that I overlooked something last time and will need to take another look at the module, though, so I'll do that. Tie::File looks quite handy at first glance so I will definitely be reading up how that works, too.

List context is weird....
...($config_file) is a list of one scalar: $config_file. $_[0] is not a list, just a scalar. It is converted into a list of one element. The RHS list is stored into the LHS list and viola. You can write it the same as all your other subs, though, because ($config_file) is a list and @_ is an array. The array turns into a list and the RHS list is stored into the LHS list. Anyways, you can write it like this:
sub parse_config
{
    my ($config_file) = @_;
...

Ah, okay. Now that it's pointed out, that makes sense; I was using the $_[x] way as that was what I had seen when reading up on how to deal with parameters in subroutines.

You can also use my $foo; instead of my ($foo); if you would like to. I noticed you always use parenthesis. The parenthesis aren't required and actually mean something slightly different because of list context. Like here on like 35:
        my ($yes_no);
        $yes_no = <STDIN>;
Could simply be:
        my $yes_no = <STDIN>;
The second example reads <STDIN> in scalar context, which only reads a line. If you did my ($yes_no) = <STDIN> this would not do what you wanted because it reads <STDIN> in list context, which reads all lines.

Hmm, this is a little confusing. I was using the parentheses because, in Learning Perl, it states that this is the correct way to declare a local variable within a scope, rather than creating a global variable. So my understanding was that this:

        my $yes_no = <STDIN>;

Would create a global variable, which any of the other sections of the code could access. My intention here was to keep them within the scope of the blocks they were in only. Is there another way that I should be doing this?

edit: I forgot to mention that parse_config does not return a hash when it creates the config file. Line 10 expects a hash to always be returned.

I'll get on to fixing that ASAP.

I really appreciate the feedback. I'll be working on this some more tomorrow after work, and will be taking in to account the things you've said. Thank you.

juster · 2012-06-18 01:18:12

I would just use the regex to check for an non-negative integer. That is actually the fairly standard way because perl converts between strings and numbers so seamlessly. Of course... this is perl... TIMTOWTDI.

You got the 3-arg open call right.

Yeah you can just drop the ampersands. Prototypes can apply to more than just builtins though. You can define prototypes for subs that will make them behave like builtins. Creating a sub that mimics push @foo, 'bar' -where the first-argument (array) is automatically passed by reference - is impossible otherwise. I would avoid prototypes for the time being. You hardly ever need them and they are almost always misused and misunderstood.

Hmm, this is a little confusing. I was using the parentheses because, in Learning Perl, it states that this is the correct way to declare a local variable within a scope, rather than creating a global variable. So my understanding was that this:
        my $yes_no = <STDIN>;
Would create a global variable, which any of the other sections of the code could access. My intention here was to keep them within the scope of the blocks they were in only. Is there another way that I should be doing this?

With either notation my creates a lexical variable. Global variables are defined with our. Without strict mode, variables that are automatically created (without my) are global.

You're welcome. Have fun and don't take me too seriously. My word isn't law or anything. Like if you want to use the Env module that's cool. That reminds me, you can specify which environment variables you wish to use when you use Env, this way:

use Env qw(HOME XDG_CONFIG_HOME);

This way if XDG_CONFIG_HOME is not defined in the user's environment and you try to use it, the scalar $XDG_CONFIG_HOME will simply be empty instead of non-existant. I have never seen Env used before but I kind of like it.

JHeaton · 2012-06-18 20:29:03

Aha, thanks.

I've decided to stick with Env for the moment whilst I do a bit of testing to see what happens under different conditions etc. but I've fixed the issue with parse_config not always returning a hash and also the variable declarations. It's helpful to have someone more experienced with the language and programming in general looking over your work to catch these things.

The regex method is something I'd have to look in to, because I know very little about them, but it looks like that's something I can use to fill in the gaps between race sessions this weekend. Once again, thanks for your time and advice!

Arch Linux

#1 2012-06-16 20:56:33

Some CC, please?

#2 2012-06-17 18:19:07

Re: Some CC, please?

#3 2012-06-17 21:15:12

Re: Some CC, please?

#4 2012-06-18 01:18:12

Re: Some CC, please?

#5 2012-06-18 20:29:03

Re: Some CC, please?

Board footer