1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
## ----------------------------------------------------------------------------
# cil is a Command line Issue List
# Copyright (C) 2008 Andrew Chilton
#
# This file is part of 'cil'.
#
# cil is free software: you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation, either version 3 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# this program. If not, see <http://www.gnu.org/licenses/>.
#
## ----------------------------------------------------------------------------
package CIL::Utils;
use strict;
use warnings;
use Carp;
use File::Slurp;
use File::Temp qw(tempfile);
use Email::Find;
use POSIX qw(getpgrp tcgetpgrp);
use Fcntl qw(:DEFAULT :flock);
## ----------------------------------------------------------------------------
# setup some globals
my $editor = $ENV{EDITOR} || 'vi';
## ----------------------------------------------------------------------------
sub parse_cil_file {
my ($class, $filename, $last_field) = @_;
my @lines = read_file($filename);
return {} unless @lines;
return $class->parse_from_lines( $last_field, @lines );
}
sub parse_from_fh {
my ($class, $fh, $last_field) = @_;
my @lines = <$fh>;
return unless @lines;
return $class->parse_from_lines( $last_field, @lines );
}
sub parse_from_lines {
my ($class, $last_field, @lines) = @_;
return unless @lines;
chomp @lines;
my $data = {};
# read all the initial fields
while ( my $line = shift @lines ) {
my ($key, $value) = split(/\s*:\s*/, $line, 2);
if ( defined $data->{$key} ) {
unless ( ref $data->{$key} eq 'ARRAY' ) {
$data->{$key} = [ $data->{$key} ];
};
push @{$data->{$key}}, $value;
}
else {
$data->{$key} = $value;
}
}
# now read everything that's left into the $last_field field (if there is one)
$data->{$last_field} = join("\n", @lines)
if defined $last_field;
return $data;
}
sub format_data_as_output {
my ($class, $data, @fields) = @_;
# we format the last field differently, so pop it off now
my $last_field = pop @fields;
my @lines;
foreach my $field ( @fields ) {
next if $field eq $last_field;
if ( ref $data->{$field} eq 'ARRAY' ) {
# don't output this field if there is nothing in it
next unless @{$data->{$field}};
foreach ( sort @{$data->{$field}} ) {
push @lines, "$field: $_\n";
}
}
else {
push @lines, "$field: $data->{$field}\n";
}
}
# finally, output the last field on it's own
push @lines, "\n";
push @lines, $data->{$last_field}, "\n";
return \@lines;
}
sub write_cil_file {
my ($class, $filename, $data, @fields) = @_;
# get the output format
my $lines = $class->format_data_as_output($data, @fields);
# ... and save
write_file($filename, $lines);
}
# this method based on Term::CallEditor(v0.11)'s solicit method
# original: Copyright 2004 by Jeremy Mates
# copied under the terms of the GPL
sub solicit {
my ($class, $message) = @_;
$message = join('', @$message) if ref $message eq 'ARRAY';
# when calling this, assume we're already interactive
File::Temp->safe_level(File::Temp::HIGH);
my ( $fh, $filename ) = tempfile( UNLINK => 1 );
# since File::Temp returns both, check both
unless ( $fh and $filename ) {
croak "couldn't create temporary file";
}
select( ( select($fh), $|++ )[0] );
print $fh $message;
# need to unlock for external editor
flock $fh, LOCK_UN;
# run the editor
my $status = system($editor, $filename);
# check its return value
if ( $status != 0 ) {
croak $status != -1
? "external editor ($editor) failed: $?"
: "could not launch ($editor) program: $!";
}
unless ( seek $fh, 0, 0 ) {
croak "could not seek on temp file: errno=$!";
}
return $fh;
}
# this method based on Recipe 15.2
sub ensure_interactive {
my $tty;
open($tty, "/dev/tty")
or croak "program not running interactively (can't open /dev/tty): $!";
my $tpgrp = tcgetpgrp( fileno($tty) );
my $pgrp = getpgrp();
close $tty;
unless ( $tpgrp == $pgrp ) {
croak "can't get exclusive control of tty: tpgrp=$tpgrp, pgrp=$pgrp";
}
# if we are here, then we have ensured what we wanted
return;
}
sub extract_email_address {
my ($class, $text) = @_;
my $email_address;
my $num_found = find_emails(
$text,
sub {
my ($mail_address, $text_email) = @_;
$email_address = $text_email;
}
);
return $email_address;
}
## ----------------------------------------------------------------------------
1;
## ----------------------------------------------------------------------------
|
