File Coverage

lib/Book/Bilingual/File.pm
Criterion Covered Total %
statement 63 63 100.0
branch 5 8 62.5
condition n/a
subroutine 13 13 100.0
pod 1 1 100.0
total 82 85 96.4


line stmt bran cond sub pod time code
1             package Book::Bilingual::File;
2             # ABSTRACT: Construct a Bilingual book from file
3 2     2   61971 use Mojo::Base -base;
  2         171847  
  2         13  
4 2     2   668 use Book::Bilingual;
  2         4  
  2         13  
5 2     2   714 use Book::Bilingual::Dline;
  2         4  
  2         13  
6 2     2   690 use Book::Bilingual::Dlineset;
  2         5  
  2         13  
7 2     2   729 use Book::Bilingual::Chapter;
  2         5  
  2         12  
8 2     2   1598 use Path::Tiny qw/path/;
  2         20300  
  2         140  
9 2     2   19 use Carp;
  2         22  
  2         1771  
10              
11             has 'book' => sub { Book::Bilingual->new}; # Book::Bilingual
12             has 'file'; # Path to file
13             has 'chapters'; # Arrayref of chapter text
14              
15             sub new { ## ($path :Path)
16 20 50   20 1 3259 croak 'Need args ($path)' unless @_ > 1;
17 20         51 my $self = $_[0]->SUPER::new({ file => path($_[1]) });
18 20         699 $self->_init();
19             }
20              
21             sub _init {
22 20     20   34 my ($self) = @_;
23             #say ref $self->book;
24              
25 20         42 my $text = $self->file->slurp_utf8;
26 20         6183 $self->chapters( _extract_chapters($text));
27              
28 20         160 foreach my $chapter (@{$self->chapters}) {
  20         38  
29              
30             # Generate Dlinesets from extracted chapter text
31             my @Dsets = map {
32 180         1116 Book::Bilingual::Dlineset->new->set(_extract_dlines($_));
33 40         99 } @{_extract_dlineset($chapter)};
  40         66  
34              
35 40         364 my $book_chapter = Book::Bilingual::Chapter->new;
36 40         347 $book_chapter->number(shift @Dsets);
37 40         237 $book_chapter->title(shift @Dsets);
38 40         229 $book_chapter->body([@Dsets]);
39 40         211 $self->book->push($book_chapter);
40             };
41              
42 20         123 return $self;
43             }
44             sub _extract_chapters { ## ($file_text) :> [$chapter_text]
45 20     20   46 my ($text) = @_;
46              
47 20         1283 my @chapters = split /^----$/m, $text;
48 20 50       67 shift @chapters if scalar @chapters; # Ignore TOC and other front matter
49              
50 20         99 return [@chapters];
51             }
52             =head2 _extract_dlineset
53              
54             Returns arrayref of DSET_TEXT.
55              
56             Sample of DSET_TEXT:
57              
58             Chapter One
59             #chapter-number <-- class definition
60              
61             บทที่หนึ่ง /
62             บทที่ /One
63             /Chapter One
64             .. <-- last line
65              
66              
67             =cut
68             sub _extract_dlineset { ## ($chapter_text) :> [DSET_TEXT]
69 43     43   77 my ($chapter) = @_;
70              
71             my @dsets = grep {
72 43         2459 $_ !~ /^#/ # Ignore comments
  816         1348  
73             } split /^__ /m, $chapter;
74              
75 43 50       216 shift @dsets if scalar @dsets; # Ignore chapter front matter
76              
77 43         128 return [@dsets];
78             }
79             =head2 _extract_dlines
80              
81             A set with class definition
82              
83             Chapter One
84             #chapter-number <-- class definition
85              
86             บทที่หนึ่ง /
87             บทที่ /One
88             /Chapter One
89             .. <-- last line
90              
91             A set without the class definition
92              
93             "Can we go to Polseath as usual?"
94              
95             "เราไปชายหาดตามปกติได้ไหม" /
96             /"Can /เราไปชายหาดตามปกติ?"
97             /"Can /เราไป /beach as usual?"
98             /"Can /เรา /go to the beach as usual?"
99             /"Can we go to the beach as usual?"
100             .. <-- last line
101              
102             =cut
103             sub _extract_dlines { ## ($dset_text) :> [Dline]
104 182     182   1357 my ($dset) = @_;
105 182         1156 my @lines = split "\n", $dset;
106              
107 182         227 shift @lines; # Ignore first line
108 182         282 my $class = _extract_class(shift @lines); # Extract dline class
109 182         247 pop @lines; # Ignore last line
110              
111             @lines = grep {
112 182         257 $_ !~ /^\s*$/; # Ignore empty lines
  1148         2228  
113             } @lines;
114              
115             @lines = map {
116 182         246 $_ =~ s/^ //; # Trim prefix
  1026         8689  
117 1026         2759 Book::Bilingual::Dline->new({ class=>$class, str=>$_ });
118             } @lines;
119              
120 182         1853 return [@lines];
121             }
122             sub _extract_class {
123 185     185   1610 my ($line) = @_;
124              
125 185         1004 $line =~ s/^\s+|\s+$//g; # Trim front and back
126 185 100       365 return '' unless $line;
127              
128 124         315 $line =~ s/#//g; # Remove # markers
129 124         451 return join ' ',(split /\s+/, $line); # Split and recombine words
130             }
131              
132             1;