File Coverage

lib/Devel/Trepan/CmdProcessor/Command/Set_Subcmd/Substitute_Subcmd/Path.pm
Criterion Covered Total %
statement 33 44 75.0
branch 0 4 0.0
condition n/a
subroutine 11 12 91.6
pod n/a
total 44 60 73.3


line stmt bran cond sub pod time code
1             # -*- coding: utf-8 -*-
2             # Copyright (C) 2013-2014 Rocky Bernstein <rocky@cpan.org>
3 12     12   84 use warnings; no warnings 'redefine'; no warnings 'once';
  12     12   38  
  12     12   522  
  12         71  
  12         31  
  12         386  
  12         73  
  12         37  
  12         334  
4 12     12   68 use rlib '../../../../../..';
  12         32  
  12         81  
5              
6             package Devel::Trepan::CmdProcessor::Command::Set::Substitute::Path;
7 12     12   5423 use Devel::Trepan::DB::LineCache;
  12         34  
  12         2601  
8              
9 12     12   92 use Devel::Trepan::CmdProcessor::Command::Subcmd::Subsubcmd;
  12         30  
  12         318  
10 12     12   66 use strict;
  12         32  
  12         301  
11 12     12   67 use vars qw(@ISA @SUBCMD_VARS);
  12         34  
  12         745  
12             @ISA = qw(Devel::Trepan::CmdProcessor::Command::Subsubcmd);
13              
14             # Values inherited from parent
15              
16 12     12   80 use vars @Devel::Trepan::CmdProcessor::Command::Subsubcmd::SUBCMD_VARS;
  12         29  
  12         1916  
17             our $CMD = 'set display eval';
18             my @DISPLAY_TYPES = @Devel::Trepan::CmdProcessor::DISPLAY_TYPES;
19             my $param = join('|', @DISPLAY_TYPES);
20             =pod
21              
22             =head2 Synopsis:
23              
24             =cut
25             our $HELP = <<"HELP";
26             =pod
27              
28             B<set substitute path> [I<from-path>] I<to-path>
29              
30             Add a substitution rule replacing I<from-path> into I<to-path> in
31             source file names. If a substitution rule was previously set for
32             I<from-path>, the old rule is replaced by the new one. If I<from_path>
33             is not given use the current filename.
34              
35             =cut
36             HELP
37              
38             our $MIN_ABBREV = length('pa');
39 12     12   89 use constant MIN_ARGS => 1;
  12         32  
  12         938  
40 12     12   111 use constant MAX_ARGS => 2;
  12         33  
  12         2484  
41             our $SHORT_HELP = 'Use PATH in place of a filename';
42              
43             sub run($$)
44             {
45 0     0     my ($self, $args) = @_;
46 0           my ($from_path, $to_path);
47 0           my $proc = $self->{proc};
48 0 0         if (scalar(@$args) == 5) {
49 0           $from_path = $args->[3];
50 0           $to_path = $args->[4];
51             } else {
52 0           $from_path = $proc->{frame}{file};
53 0           $to_path = $args->[3];
54             }
55             # FIXME: Check from_path name to see if it is loaded
56 0 0         if (-f $to_path) {
57 0           remap_file($from_path, $to_path);
58             } else {
59 0           $proc->errmsg("File ${to_path} doesn't exist");
60             }
61             }
62              
63             unless(caller) {
64             # requre File::Basename;
65             # Demo it.
66             # my $name = basename(__FILE__, '.pm')
67             }
68              
69             1;