view release on metacpan or  search on metacpan

eg/moodu2  view on Meta::CPAN

}

sub cmd_show ($self) {
   my $contents = $self->resolve->slurp_utf8;
   $contents =~ s{\n\z}{}mxs;
   say "----\n$contents\n----";
   return 0;
} ## end sub show ($self)

sub cmd_waiting ($self) {
   $self->move_task;
}


########################################################################
# Support methods

sub add_file ($self, $hint, $contents) {
   my $attempts         = 0;
   my $file             = path($hint);
   my $allowed_attempts = $self->config('attempts');
   while ('necessary') {
      eval {
         my $fh =
           $file->filehandle({exclusive => 1}, '>', ':encoding(UTF-8)');
         print {$fh} $contents;
         close $fh;
      } && return $file;
      ++$attempts;
      last if $allowed_attempts && $attempts >= $allowed_attempts;
      $file = $hint->sibling($hint->basename . "-$attempts");
   } ## end while ('necessary')
   $self->fatal("cannot save file '$hint' or variants");
} ## end sub add_file

sub basedir ($self) {
   return path($self->config('basedir'));
}

sub edit_file ($self, $path) {
   my $editor = $self->config('editor');
   my $outcome = system {$editor} $editor, $path->stringify;
   return $outcome == 0;
}

sub fatal ($self, @message) {
   die join(' ', @message) . "\n";
}

sub get_title ($self, $path) {
   my ($title) = $path->lines({count => 1});
   ($title // '') =~ s{\A\s+|\s+\z}{}grmxs;
}

sub list_category ($self, $category) {
   my $dir = $self->basedir->child($category);
   return reverse sort { $a cmp $b } $dir->children;
}

sub move_task ($self) {
   my $category = (caller(1))[3] =~ s{\A cmd_}{}rmxs;
   my $child  = $self->resolve;
   my $parent = $child->parent;
   if ($parent->basename eq $category) {
      $self->notice("task is already $category");
      return 0;
   }
   my $dest = $parent->sibling($category)->child($child->basename);
   $self->add_file($dest, $child->slurp_utf8);
   $child->remove;
   return 0;
} ## end sub move_task

sub notice ($self, @message) {
   warn join(' ', @message) . "\n";
}

sub resolve ($self) {
   my ($oid, @rest) = $self->residual_args;
   $self->fatal("no identifier provided") unless defined $oid;
   $self->fatal("too many identifiers provided") if @rest;
   my $id = $oid;

   my %name_for = (o => 'ongoing', d => 'done', w => 'waiting');
   my $first = substr $id, 0, 1, '';
   my $type = $name_for{$first}
     // $self->fatal("invalid identifier '$oid'");

   my $child;
   if ($id =~ s{\A -}{}mxs) {    # exact id
      $child = $self->basedir->child($type, $id);
      $self->fatal("unknown identifier '$oid'") unless -r $child;
   }
   else {
      $self->fatal("invalid identifier '$oid'")
        unless $id =~ m{\A [1-9]\d* \z}mxs;
      my @children = $self->list_category($type);
      $self->fatal("invalid identifier '$oid' "
           . "(too high, max $first@{[scalar @children]})")
        if $id > @children;
      $child = $children[$id - 1];
   } ## end else [ if ($id =~ s{\A -}{}mxs)]

   return $child;
} ## end sub resolve ($self)

1;