File Coverage

blib/lib/Text/Todo.pm

Criterion	Covered	Total	%
statement	32	43	74.4
branch	5	14	35.7
condition	0	6	0.0
subroutine	8	8	100.0
pod			n/a
total	45	71	63.3

package Text::Todo;

# $AFresh1: Todo.pm,v 1.27 2010/02/16 01:13:12 andrew Exp $

use warnings;
use strict;
use Carp;

use Class::Std::Utils;
use Text::Todo::Entry;
use File::Spec;

use version; our $VERSION = qv('0.2.0');

{

    my @attr_refs = \(
        my %path_of,

        my %list_of,
        my %loaded_of,
        my %known_tags_of,
    );

    sub new {
        my ( $class, $options ) = @_;

        my $self = bless anon_scalar(), $class;
        my $ident = ident($self);

        $path_of{$ident} = {
            todo_dir  => undef,
            todo_file => 'todo.txt',
            done_file => undef,
        };

        my %tags = (
            context => q{@},
            project => q{+},
        );

        if ($options) {
            if ( ref $options eq 'HASH' ) {
                foreach my $opt ( keys %{$options} ) {
                    if ( exists $path_of{$ident}{$opt} ) {
                        $self->_path_to( $opt, $options->{$opt} );
                    }
                    elsif ( $opt eq 'tags'
                        && ref $options->{$opt} eq 'HASH' )
                    {
                        %tags = ( %tags, %{ $options->{$opt} } );
                    }
                    else {

                        #carp "Invalid option [$opt]";
                    }
                }
            }
            else {
                if ( -d $options ) {
                    $self->_path_to( 'todo_dir', $options );
                }
                elsif ( $options =~ /\.txt$/ixms ) {
                    $self->_path_to( 'todo_file', $options );
                }
                else {
                    carp "Unknown options [$options]";
                }
            }
        }

        $known_tags_of{$ident} = \%tags;

        my $file = $self->_path_to('todo_file');
        if ( defined $file && -e $file ) {
            $self->load();
        }

        return $self;
    }

    sub _path_to {
        my ( $self, $type, $path ) = @_;
        my $ident = ident($self);

        if ( $type eq 'todo_dir' ) {
            if ($path) {
                $path_of{$ident}{$type} = $path;
            }
            return $path_of{$ident}{$type};
        }

        if ($path) {
            my ( $volume, $directories, $file )
                = File::Spec->splitpath($path);
            $path_of{$ident}{$type} = $file;

            if ($volume) {
                $directories = File::Spec->catdir( $volume, $directories );
            }

            # XXX Should we save complete paths to each file, mebbe only if
            # the dirs are different?
            if ($directories) {
                $path_of{$ident}{todo_dir} = $directories;
            }
        }

        if ( $type =~ /(todo|done|report)_file/xms ) {
            if ( my ( $pre, $post )
                = $path_of{$ident}{$type} =~ /^(.*)$1(.*)\.txt$/ixms )
            {
                foreach my $f qw( todo done report ) {
                    if ( !defined $path_of{$ident}{ $f . '_file' } ) {
                        $path_of{$ident}{ $f . '_file' }
                            = $pre . $f . $post . '.txt';
                    }
                }
            }
        }

        if ( defined $path_of{$ident}{todo_dir} ) {
            return File::Spec->catfile( $path_of{$ident}{todo_dir},
                $path_of{$ident}{$type} );
        }

        return;
    }

    sub file {
        my ( $self, $file ) = @_;
        my $ident = ident($self);

        if ( defined $file && exists $path_of{$ident}{$file} ) {
            $file = $self->_path_to($file);
        }
        else {
            $file = $self->_path_to( 'todo_file', $file );
        }

        return $file;
    }

    sub load {
        my ( $self, $file ) = @_;
        my $ident = ident($self);

        $loaded_of{$ident} = undef;

        $file = $self->file($file);

        if ( $list_of{$ident} = $self->listfile($file) ) {
            $self->known_tags;
            $loaded_of{$ident} = $file;
            return 1;
        }

        return;
    }

    sub listfile {
        my ( $self, $file ) = @_;

        $file = $self->file($file);

        if ( !defined $file ) {
            carp q{file can't be found};
            return;
        }

        if ( !-e $file ) {
            carp "file [$file] does not exist";
            return;
        }

        my @list;
        open my $fh, '<', $file or croak "Couldn't open [$file]: $!";
        while (<$fh>) {
            s/\r?\n$//xms;
            push @list, Text::Todo::Entry->new($_);
        }
        close $fh or croak "Couldn't close [$file]: $!";

        return wantarray ? @list : \@list;
    }

    sub save {
        my ( $self, $file ) = @_;
        my $ident = ident($self);

        $file = $self->file($file);
        if ( !defined $file ) {
            croak q{todo file can't be found};
        }

        open my $fh, '>', $file or croak "Couldn't open [$file]: $!";
        foreach my $e ( @{ $list_of{$ident} } ) {
            print {$fh} $e->text . "\n"
                or croak "Couldn't print to [$file]: $!";
        }
        close $fh or croak "Couldn't close [$file]: $!";

        $loaded_of{$ident} = $file;

        return 1;
    }

    sub list {
        my ($self) = @_;
        my $ident = ident($self);

        return if !$list_of{$ident};
        return wantarray ? @{ $list_of{$ident} } : $list_of{$ident};
    }

    sub listpri {
        my ( $self, $pri ) = @_;

        my @list;
        if ($pri) {
            $pri = uc $pri;
            if ( $pri !~ /^[A-Z]$/xms ) {
                croak 'PRIORITY must a single letter from A to Z.';
            }
            @list = grep { defined $_->priority && $_->priority eq $pri }
                $self->list;
        }
        else {
            @list = grep { $_->priority } $self->list;
        }

        return wantarray ? @list : \@list;
    }

    sub add {
        my ( $self, $entry ) = @_;
        my $ident = ident($self);

        if ( !ref $entry ) {
            $entry = Text::Todo::Entry->new(
                {   text => $entry,
                    tags => $known_tags_of{$ident},
                }
            );
        }
        elsif ( ref $entry ne 'Text::Todo::Entry' ) {
            croak(
                'entry is a ' . ref($entry) . ' not a Text::Todo::Entry!' );
        }

        push @{ $list_of{$ident} }, $entry;

        $self->known_tags;

        return $entry;
    }

    sub del {
        my ( $self, $src ) = @_;
        my $ident = ident($self);

        my $id = $self->_find_entry_id($src);

        my @list = $self->list;
        my $entry = splice @list, $id, 1;
        $list_of{$ident} = \@list;

        return $entry;
    }

    sub move {
        my ( $self, $entry, $dst ) = @_;
        my $ident = ident($self);

        my $src  = $self->_find_entry_id($entry);
        my @list = $self->list;

        splice @list, $dst, 0, splice @list, $src, 1;

        $list_of{$ident} = \@list;

        return 1;
    }

    sub listproj {
        my ($self) = @_;
        return $self->listtag('project');
    }

    sub listcon {
        my ($self) = @_;
        return $self->listtag('context');
    }

    sub listtag {
        my ( $self, $tag ) = @_;
        my $ident = ident($self);

        my $accessor = $tag . 's';

        my %available;
        foreach my $e ( $self->list ) {
            foreach my $p ( $e->$accessor ) {
                $available{$p} = 1;
            }
        }

        my @tags = sort keys %available;

        return wantarray ? @tags : \@tags;
    }

    sub learn_tag {
        my ( $self, $tag, $sigal ) = @_;

        $known_tags_of{ ident $self}{$tag} = $sigal;
        $self->known_tags;

        return 1;
    }

    sub known_tags {
        my ($self) = @_;
        my $ident = ident($self);

        my @list = $self->list;
        my %tags = %{ $known_tags_of{$ident} };

        foreach my $e (@list) {
            my $kt = $e->known_tags;
            foreach my $t ( keys %{$kt} ) {
                if ( !exists $tags{$t} ) {
                    $tags{$t} = $kt->{$t};
                }
            }
        }

        foreach my $e (@list) {
            my $kt = $e->known_tags;
            foreach my $t ( keys %tags ) {
                if ( !exists $kt->{$t} || $tags{$t} ne $kt->{$t} ) {
                    $e->learn_tag( $t, $tags{$t} );
                }
            }
        }

        $known_tags_of{$ident} = \%tags;

        return $known_tags_of{$ident};
    }

    sub archive {
        my ($self) = @_;
        my $ident = ident($self);

        if ( !defined $loaded_of{$ident}
            || $loaded_of{$ident} ne $self->file('todo_file') )
        {
            carp 'todo_file not loaded';
            return;
        }

        my $changed = 0;
    ENTRY: foreach my $e ( $self->list ) {
            if ( $e->done ) {
                if ( $self->addto( 'done_file', $e ) && $self->del($e) ) {
                    $changed++;
                }
                else {
                    carp q{Couldn't archive entry [} . $e->text . ']';
                    last ENTRY;
                }
            }
            elsif ( $e->text eq q{} ) {
                if ( $self->del($e) ) {
                    $changed++;
                }
                else {
                    carp q{Couldn't delete blank entry};
                    last ENTRY;
                }
            }
        }

        if ($changed) {
            $self->save;
        }

        return $changed;
    }

    sub addto {
        my ( $self, $file, $entry ) = @_;
        my $ident = ident($self);

        $file = $self->file($file);
        if ( !defined $file ) {
            croak q{file can't be found};
        }

        if ( ref $entry ) {
            if ( ref $entry eq 'Text::Todo::Entry' ) {
                $entry = $entry->text;
            }
            else {
                carp 'Unknown ref [' . ref($entry) . ']';
                return;
            }
        }

        open my $fh, '>>', $file or croak "Couldn't open [$file]: $!";
        print {$fh} $entry, "\n"
            or croak "Couldn't print to [$file]: $!";
        close $fh or croak "Couldn't close [$file]: $!";

        if ( defined $loaded_of{$ident} && $file eq $loaded_of{$ident} ) {
            return $self->load($file);
        }

        return 1;
    }

    sub _find_entry_id {
        my ( $self, $entry ) = @_;
        my $ident = ident($self);

        if ( ref $entry ) {
            if ( ref $entry ne 'Text::Todo::Entry' ) {
                croak(    'entry is a '
                        . ref($entry)
                        . ' not a Text::Todo::Entry!' );
            }

            my @list = $self->list;
            foreach my $id ( 0 .. $#list ) {
                if ( $list[$id] eq $entry ) {
                    return $id;
                }
            }
        }
        elsif ( $entry =~ /^\d+$/xms ) {
            return $entry;
        }

        croak "Invalid entry [$entry]!";
    }

    sub DESTROY {
        my ($self) = @_;
        my $ident = ident $self;

        foreach my $attr_ref (@attr_refs) {
            delete $attr_ref->{$ident};
        }

        return;
    }
}

1;    # Magic true value required at end of module
__END__