File Coverage

blib/lib/File/Unsaved.pm
Criterion Covered Total %
statement 36 48 75.0
branch 17 36 47.2
condition 3 10 30.0
subroutine 4 4 100.0
pod 1 1 100.0
total 61 99 61.6


line stmt bran cond sub pod time code
1             package File::Unsaved;
2              
3             our $DATE = '2015-09-03'; # DATE
4             our $VERSION = '0.05'; # VERSION
5              
6 1     1   54397 use 5.010001;
  1         5  
7 1     1   6 use strict;
  1         3  
  1         41  
8 1     1   7 use warnings;
  1         3  
  1         762  
9              
10             require Exporter;
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(check_unsaved_file);
13              
14             our %SPEC;
15              
16             $SPEC{check_unsaved_file} = {
17             v => 1.1,
18             summary => 'Check whether file has unsaved modification in an editor',
19             description => <<'_',
20              
21             This function tries, using some heuristics, to find out if a file is being
22             opened and has unsaved modification in an editor. Currently the supported
23             editors are: Emacs, joe, vim.
24              
25             The heuristics are as folow:
26              
27             * Emacs, joe, mc: check whether `.#` symlink exists. Emacs targets the
28             symlink to `@.:` while joe and mc to
29             `@.`. Caveat: Unix only.
30              
31             * vim: check whether `..swp` file exists, not older than file, and its
32             0x03ef-th byte has the value of `U` (which vim uses to mark the file as
33             unsaved). Caveat: vim can be instructed to put swap file somewhere else or not
34             create swap file at all, so in those cases unsaved data will not be detected.
35              
36             _
37             args => {
38             path => {
39             schema => 'str*',
40             req => 1,
41             pos => 0,
42             },
43             check_pid => {
44             summary => 'Whether to check that PID is actually an editor',
45             schema => 'bool*',
46             default => 1,
47             description => <<'_',
48              
49             A temporary file might be stale, so checking the existence of temporary file is
50             not enough. If the temporary file provides pointer to a PID, and this setting is
51             set to true, will actually check that the PID exists.
52              
53             _
54             },
55             check_proc_name => {
56             summary => 'Whether to check that process name is actually the '.
57             'corresponding editor',
58             schema => 'bool*',
59             default => 1,
60             description => <<'_',
61              
62             Is activated only `check_pid` is also 1 and if `Proc::Find` (and thus
63             `Proc::ProcessTable`) is available.
64              
65             Might produce a false negative if you happen to rename the editor or use a
66             differently-named fork/derivative of said editor, although this should be rare.
67              
68             _
69             },
70             },
71             result_naked => 1,
72             result => {
73             schema => ['any*', of=>['bool*', 'hash*']],
74             description => <<'_',
75              
76             Return false if no unsaved data is detected, or else a hash structure. Hash will
77             contain these keys: `editor` (kind of editor, possible values: `emacs`,
78             `joe/mc`, `joe`, `mc`, `vim`) and might contain these keys: `pid` (PID of
79             editor), `user`, `host`, `timestamp`.
80              
81              
82             _
83             },
84             };
85             sub check_unsaved_file{
86 6     6 1 2669 require File::Spec;
87              
88 6         18 my %args = @_;
89 6   100     28 my $check_pid = $args{check_pid} // 1;
90 6   50     23 my $check_proc_name = $args{check_proc_name} // 1;
91 6         8 my $path = $args{path};
92              
93 6 100       126 (-f $path) or die "File does not exist or not a regular file";
94              
95 5         82 my ($vol, $dir, $file) = File::Spec->splitpath($path);
96              
97             # emacs & joe/mc
98             CHECK1:
99             {
100 5         9 my $spath = File::Spec->catpath($vol, $dir, ".#$file");
  5         37  
101 5 100       87 last unless -l $spath;
102 2         23 my $target = readlink $spath;
103 2 100       17 if ($target =~ /\A(.+)\@(.+)\.(\d+):(\d+)\z/) {
    50          
104 1         9 my $res = {editor=>'emacs',
105             user=>$1, host=>$2, pid=>$3, timestamp=>$4};
106 1 50       4 if ($check_pid) {
107 0 0       0 last CHECK1 unless kill(0, $res->{pid});
108 0 0 0     0 if ($check_proc_name && eval {require Proc::Find; 1}) {
  0         0  
  0         0  
109             last CHECK1 unless Proc::Find::proc_exists(
110 0 0       0 pid => $res->{pid}, name => qr/\b(emacs)\b/,
111             );
112             }
113             }
114 1         12 return $res;
115             } elsif ($target =~ /\A(.+)\@(.+)\.(\d+)\z/) {
116 1         8 my $res = {editor=>'joe/mc',
117             user=>$1, host=>$2, pid=>$3};
118 1 50       3 if ($check_pid) {
119 0 0       0 last CHECK1 unless kill(0, $res->{pid});
120 0 0 0     0 if ($check_proc_name && eval {require Proc::Find; 1}) {
  0         0  
  0         0  
121             my $findres = Proc::Find::proc_find(
122 0         0 pid => $res->{pid}, name => qr/\b(joe|mc)\b/);
123 0 0       0 last CHECK1 unless $findres;
124 0         0 $res->{editor} = $findres->{name};
125             }
126             }
127 1         11 return $res;
128             }
129             }
130              
131             # vim
132             CHECK_VIM:
133             {
134 3         5 my $spath = File::Spec->catpath($vol, $dir, ".$file.swp");
  3         21  
135 3 100       47 last unless -f $spath;
136 2 50       51 last if (-M $spath) > (-M $path); # swap file is older
137 2 50       56 open my($fh), "<", $spath or last;
138 2 50       12 sysseek $fh, 0x03ef, 0 or last;
139 2 100       28 sysread $fh, my($data), 1 or last;
140 1 50       40 $data eq 'U' or last;
141 1         15 return {editor => 'vim'};
142             }
143              
144 2         12 undef;
145             }
146              
147             1;
148             # ABSTRACT: Check whether file has unsaved modification in an editor
149              
150             __END__