line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package BusyBird::Config; |
2
|
11
|
|
|
11
|
|
170
|
use v5.8.0; |
|
11
|
|
|
|
|
32
|
|
|
11
|
|
|
|
|
424
|
|
3
|
11
|
|
|
11
|
|
51
|
use strict; |
|
11
|
|
|
|
|
19
|
|
|
11
|
|
|
|
|
306
|
|
4
|
11
|
|
|
11
|
|
47
|
use warnings; |
|
11
|
|
|
|
|
12
|
|
|
11
|
|
|
|
|
268
|
|
5
|
11
|
|
|
11
|
|
47
|
use Carp; |
|
11
|
|
|
|
|
23
|
|
|
11
|
|
|
|
|
657
|
|
6
|
11
|
|
|
11
|
|
60
|
use BusyBird::Log qw(bblog); |
|
11
|
|
|
|
|
19
|
|
|
11
|
|
|
|
|
495
|
|
7
|
11
|
|
|
11
|
|
54
|
use BusyBird::SafeData qw(safed); |
|
11
|
|
|
|
|
19
|
|
|
11
|
|
|
|
|
490
|
|
8
|
11
|
|
|
11
|
|
53
|
use BusyBird::Util qw(config_file_path); |
|
11
|
|
|
|
|
12
|
|
|
11
|
|
|
|
|
549
|
|
9
|
11
|
|
|
11
|
|
4119
|
use URI::Escape qw(uri_escape); |
|
11
|
|
|
|
|
16623
|
|
|
11
|
|
|
|
|
820
|
|
10
|
11
|
|
|
11
|
|
5106
|
use Encode (); |
|
11
|
|
|
|
|
82865
|
|
|
11
|
|
|
|
|
295
|
|
11
|
11
|
|
|
11
|
|
6067
|
use Tie::IxHash; |
|
11
|
|
|
|
|
25199
|
|
|
11
|
|
|
|
|
387
|
|
12
|
11
|
|
|
11
|
|
5652
|
use BusyBird::StatusStorage::SQLite; |
|
11
|
|
|
|
|
39
|
|
|
11
|
|
|
|
|
509
|
|
13
|
11
|
|
|
11
|
|
7829
|
use File::ShareDir (); |
|
11
|
|
|
|
|
71411
|
|
|
11
|
|
|
|
|
14941
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my %_DEFAULTS = (); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
$_DEFAULTS{timeline} = { |
18
|
|
|
|
|
|
|
time_zone => sub { "local" }, |
19
|
|
|
|
|
|
|
time_format => sub { '%x (%a) %X %Z' }, |
20
|
|
|
|
|
|
|
time_locale => sub { $ENV{LC_TIME} or "C" }, |
21
|
|
|
|
|
|
|
post_button_url => sub { "https://twitter.com/intent/tweet" }, |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
status_permalink_builder => sub { return sub { |
24
|
|
|
|
|
|
|
my ($status) = @_; |
25
|
|
|
|
|
|
|
my $ss = safed($status); |
26
|
|
|
|
|
|
|
my $permalink_in_status = $ss->val(qw(busybird status_permalink)); |
27
|
|
|
|
|
|
|
return $permalink_in_status if defined $permalink_in_status; |
28
|
|
|
|
|
|
|
my $id = $ss->val(qw(busybird original id)) |
29
|
|
|
|
|
|
|
|| $ss->val(qw(busybird original id_str)) |
30
|
|
|
|
|
|
|
|| $ss->val("id") |
31
|
|
|
|
|
|
|
|| $ss->val("id_str"); |
32
|
|
|
|
|
|
|
my $username = $ss->val(qw(user screen_name)); |
33
|
|
|
|
|
|
|
if(defined($id) && defined($username) && $id =~ /^\d+$/) { |
34
|
|
|
|
|
|
|
return qq{https://twitter.com/$username/status/$id}; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
return undef; |
37
|
|
|
|
|
|
|
} }, |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
urls_entity_url_builder => sub { sub { my ($text, $entity) = @_; return $entity->{url} }}, |
40
|
|
|
|
|
|
|
urls_entity_text_builder => sub { sub { my ($text, $entity) = @_; return $entity->{display_url} }}, |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
media_entity_url_builder => sub { sub { my ($text, $entity) = @_; return $entity->{url} } }, |
43
|
|
|
|
|
|
|
media_entity_text_builder => sub { sub { my ($text, $entity) = @_; return $entity->{display_url} }}, |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
user_mentions_entity_url_builder => sub { sub { |
46
|
|
|
|
|
|
|
my ($text, $entity, $status) = @_; |
47
|
|
|
|
|
|
|
my $screen_name = $entity->{screen_name}; |
48
|
|
|
|
|
|
|
$screen_name = "" if not defined $screen_name; |
49
|
|
|
|
|
|
|
return qq{https://twitter.com/$screen_name}; |
50
|
|
|
|
|
|
|
}}, |
51
|
|
|
|
|
|
|
user_mentions_entity_text_builder => sub { sub { my $text = shift; return $text }}, |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
hashtags_entity_url_builder => sub { sub { |
54
|
|
|
|
|
|
|
my ($text, $entity, $status) = @_; |
55
|
|
|
|
|
|
|
my $query_hashtag = uri_escape('#' . Encode::encode('utf8', $entity->{text})); |
56
|
|
|
|
|
|
|
return qq{https://twitter.com/search?q=$query_hashtag&src=hash}; |
57
|
|
|
|
|
|
|
}}, |
58
|
|
|
|
|
|
|
hashtags_entity_text_builder => sub { sub { my $text = shift; return $text }}, |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
timeline_web_notifications => sub { 'simple' }, |
61
|
|
|
|
|
|
|
hidden => sub { 0 }, |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
attached_image_urls_builder => sub { |
64
|
|
|
|
|
|
|
return sub { |
65
|
|
|
|
|
|
|
my ($status) = @_; |
66
|
|
|
|
|
|
|
tie my %url_set, "Tie::IxHash"; |
67
|
|
|
|
|
|
|
my $ss = safed($status); |
68
|
|
|
|
|
|
|
my @entities = map { $ss->array($_, "media") } qw(entities extended_entities); |
69
|
|
|
|
|
|
|
foreach my $entity (@entities) { |
70
|
|
|
|
|
|
|
my $sentity = safed($entity); |
71
|
|
|
|
|
|
|
my $url = $sentity->val("media_url"); |
72
|
|
|
|
|
|
|
my $type = $sentity->val("type"); |
73
|
|
|
|
|
|
|
if(defined($url) && (!defined($type) || lc($type) eq "photo")) { |
74
|
|
|
|
|
|
|
$url_set{$url} = 1 if defined $url; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
return keys %url_set; |
78
|
|
|
|
|
|
|
}; |
79
|
|
|
|
|
|
|
}, |
80
|
|
|
|
|
|
|
attached_image_max_height => sub { 360 }, |
81
|
|
|
|
|
|
|
attached_image_show_default => sub { "hidden" }, |
82
|
|
|
|
|
|
|
acked_statuses_load_count => sub { 20 }, |
83
|
|
|
|
|
|
|
default_level_threshold => sub { 0 }, |
84
|
|
|
|
|
|
|
}; |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
$_DEFAULTS{global} = { |
87
|
|
|
|
|
|
|
%{$_DEFAULTS{timeline}}, |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
default_status_storage => sub { |
90
|
|
|
|
|
|
|
BusyBird::StatusStorage::SQLite->new(path => config_file_path("statuses.sqlite3")); |
91
|
|
|
|
|
|
|
}, |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sharedir_path => sub { File::ShareDir::dist_dir("BusyBird") }, |
94
|
|
|
|
|
|
|
timeline_list_pager_entry_max => sub { 7 }, |
95
|
|
|
|
|
|
|
timeline_list_per_page => sub { 30 }, |
96
|
|
|
|
|
|
|
}; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub new { |
99
|
292
|
|
|
292
|
1
|
3736
|
my ($class, %args) = @_; |
100
|
292
|
|
|
|
|
646
|
my $type = $args{type}; |
101
|
292
|
50
|
|
|
|
893
|
croak "type parameter is mandatory" if not defined $type; |
102
|
292
|
|
|
|
|
688
|
my $default_generators = $_DEFAULTS{$type}; |
103
|
292
|
50
|
|
|
|
761
|
croak "Unknown config type: $type" if not defined $default_generators; |
104
|
292
|
50
|
|
|
|
847
|
croak "with_default parameter is mandatory" if not defined $args{with_default}; |
105
|
292
|
|
|
|
|
1407
|
my $self = bless { |
106
|
|
|
|
|
|
|
default_generators => $default_generators, |
107
|
|
|
|
|
|
|
with_default => $args{with_default}, |
108
|
|
|
|
|
|
|
config => {}, |
109
|
|
|
|
|
|
|
}, $class; |
110
|
292
|
|
|
|
|
28324
|
return $self; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub get_config { |
114
|
904
|
|
|
904
|
1
|
1199
|
my ($self, $key) = @_; |
115
|
904
|
50
|
|
|
|
1684
|
croak "key parameter is mandatory" if not defined $key; |
116
|
904
|
100
|
|
|
|
3925
|
return $self->{config}{$key} if exists $self->{config}{$key}; |
117
|
439
|
100
|
|
|
|
1454
|
return undef if !$self->{with_default}; |
118
|
|
|
|
|
|
|
|
119
|
122
|
|
|
|
|
349
|
my $gen = $self->{default_generators}{$key}; |
120
|
122
|
100
|
|
|
|
284
|
return undef if not defined $gen; |
121
|
120
|
|
|
|
|
278
|
my $value = $gen->(); |
122
|
120
|
|
|
|
|
6061
|
$self->set_config($key, $value); |
123
|
120
|
|
|
|
|
432
|
return $value; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub set_config { |
127
|
208
|
|
|
208
|
1
|
600
|
my ($self, %configs) = @_; |
128
|
208
|
|
|
|
|
605
|
foreach my $key (keys %configs) { |
129
|
216
|
100
|
|
|
|
682
|
if(!exists($self->{default_generators}{$key})) { |
130
|
9
|
|
|
|
|
39
|
bblog("warn", "Unknown config parameter: $key"); |
131
|
|
|
|
|
|
|
} |
132
|
216
|
|
|
|
|
1029
|
$self->{config}{$key} = $configs{$key}; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
1; |
137
|
|
|
|
|
|
|
__END__ |