File Coverage

blib/lib/BusyBird/Config.pm
Criterion Covered Total %
statement 58 58 100.0
branch 12 16 75.0
condition n/a
subroutine 15 15 100.0
pod 3 3 100.0
total 88 92 95.6


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__