line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#============================================================================= |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Copyright (c) 2010 Ars Aperta, Itaapy, Pierlis, Talend. |
4
|
|
|
|
|
|
|
# Copyright (c) 2014 Jean-Marie Gouarné. |
5
|
|
|
|
|
|
|
# Author: Jean-Marie Gouarné |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
#============================================================================= |
8
|
2
|
|
|
2
|
|
26
|
use 5.010_001; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
66
|
|
9
|
2
|
|
|
2
|
|
9
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
62
|
|
10
|
2
|
|
|
2
|
|
1994
|
use experimental 'smartmatch'; |
|
2
|
|
|
|
|
1799
|
|
|
2
|
|
|
|
|
11
|
|
11
|
|
|
|
|
|
|
#============================================================================= |
12
|
|
|
|
|
|
|
# Common lpOD/Perl parameters and utility functions |
13
|
|
|
|
|
|
|
#============================================================================= |
14
|
|
|
|
|
|
|
package ODF::lpOD::Common; |
15
|
|
|
|
|
|
|
our $VERSION = '1.013'; |
16
|
2
|
|
|
2
|
|
150
|
use constant PACKAGE_DATE => '2014-04-30T08:32:52'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
98
|
|
17
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
18
|
2
|
|
|
2
|
|
10
|
use Scalar::Util; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
121
|
|
19
|
2
|
|
|
2
|
|
1953
|
use Encode; |
|
2
|
|
|
|
|
29693
|
|
|
2
|
|
|
|
|
203
|
|
20
|
2
|
|
|
2
|
|
18
|
use base 'Exporter'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
522
|
|
21
|
|
|
|
|
|
|
our @EXPORT = qw |
22
|
|
|
|
|
|
|
( |
23
|
|
|
|
|
|
|
lpod_common lpod |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
odf_get_document odf_new_document odf_create_document |
26
|
|
|
|
|
|
|
odf_new_document_from_template odf_new_document_from_type |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
odf_get_container odf_new_container |
29
|
|
|
|
|
|
|
odf_new_container_from_template odf_new_container_from_type |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
odf_get_xmlpart |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
odf_create_element odf_create_paragraph odf_create_heading |
34
|
|
|
|
|
|
|
odf_create_section odf_create_draw_page |
35
|
|
|
|
|
|
|
odf_create_shape |
36
|
|
|
|
|
|
|
odf_create_area odf_create_rectangle odf_create_ellipse |
37
|
|
|
|
|
|
|
odf_create_vector odf_create_line odf_create_connector |
38
|
|
|
|
|
|
|
odf_create_frame odf_create_text_frame odf_create_image_frame |
39
|
|
|
|
|
|
|
odf_create_image |
40
|
|
|
|
|
|
|
odf_create_list |
41
|
|
|
|
|
|
|
odf_create_table odf_create_column odf_create_row odf_create_cell |
42
|
|
|
|
|
|
|
odf_create_column_group odf_create_row_group |
43
|
|
|
|
|
|
|
odf_create_field odf_create_simple_variable odf_create_user_variable |
44
|
|
|
|
|
|
|
odf_create_note odf_create_annotation |
45
|
|
|
|
|
|
|
odf_create_style odf_create_font_declaration |
46
|
|
|
|
|
|
|
odf_create_toc |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
odf_document odf_container |
49
|
|
|
|
|
|
|
odf_xmlpart odf_content odf_styles odf_meta odf_settings odf_manifest |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
odf_element odf_text_node |
52
|
|
|
|
|
|
|
odf_text_element odf_text_hyperlink |
53
|
|
|
|
|
|
|
odf_bibliography_mark odf_note odf_annotation odf_changed_region |
54
|
|
|
|
|
|
|
odf_paragraph odf_heading odf_draw_page odf_image odf_shape odf_frame |
55
|
|
|
|
|
|
|
odf_area odf_rectangle odf_ellipse odf_vector odf_line odf_connector |
56
|
|
|
|
|
|
|
odf_field odf_variable odf_simple_variable odf_user_variable |
57
|
|
|
|
|
|
|
odf_text_field odf_classify_text_field |
58
|
|
|
|
|
|
|
odf_list odf_table odf_column odf_row odf_cell |
59
|
|
|
|
|
|
|
odf_matrix odf_column_group odf_row_group odf_table_element |
60
|
|
|
|
|
|
|
odf_structured_container |
61
|
|
|
|
|
|
|
odf_section odf_toc odf_named_range |
62
|
|
|
|
|
|
|
odf_file_entry |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
odf_style |
65
|
|
|
|
|
|
|
odf_text_style odf_paragraph_style |
66
|
|
|
|
|
|
|
odf_list_style odf_list_level_style odf_outline_style |
67
|
|
|
|
|
|
|
odf_table_style odf_column_style odf_row_style odf_cell_style |
68
|
|
|
|
|
|
|
odf_data_style |
69
|
|
|
|
|
|
|
odf_master_page odf_page_end_style odf_drawing_page_style |
70
|
|
|
|
|
|
|
odf_page_layout odf_presentation_page_layout |
71
|
|
|
|
|
|
|
odf_graphic_style odf_gradient |
72
|
|
|
|
|
|
|
odf_font_declaration |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
TRUE FALSE PRETTY |
75
|
|
|
|
|
|
|
is_true is_false defined_false |
76
|
|
|
|
|
|
|
is_odf_datatype odf_boolean process_options |
77
|
|
|
|
|
|
|
alpha_to_num translate_coordinates translate_range |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
xelt xtwig |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
META CONTENT STYLES SETTINGS MANIFEST MIMETYPE |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
text_segment TEXT_SEGMENT |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
input_conversion output_conversion search_string count_substrings |
86
|
|
|
|
|
|
|
color_code color_name load_color_map unload_color_map |
87
|
|
|
|
|
|
|
is_numeric iso_date numeric_date check_odf_value odf_value |
88
|
|
|
|
|
|
|
file_parse file_type load_file image_size input_2d_value |
89
|
|
|
|
|
|
|
alert not_implemented |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
XML_PRETTY_PRINT PRETTY_PRINT EMPTY_TAGS |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
FIRST_CHILD LAST_CHILD NEXT_SIBLING PREV_SIBLING WITHIN PARENT |
94
|
|
|
|
|
|
|
); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
#=== package name aliases ==================================================== |
97
|
|
|
|
|
|
|
#--- ODF package & parts ----------------------------------------------------- |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
use constant |
100
|
|
|
|
|
|
|
{ |
101
|
2
|
|
|
|
|
622
|
odf_document => 'ODF::lpOD::Document', |
102
|
|
|
|
|
|
|
odf_container => 'ODF::lpOD::Container', |
103
|
|
|
|
|
|
|
odf_xmlpart => 'ODF::lpOD::XMLPart', |
104
|
|
|
|
|
|
|
odf_content => 'ODF::lpOD::Content', |
105
|
|
|
|
|
|
|
odf_styles => 'ODF::lpOD::Styles', |
106
|
|
|
|
|
|
|
odf_meta => 'ODF::lpOD::Meta', |
107
|
|
|
|
|
|
|
odf_settings => 'ODF::lpOD::Settings', |
108
|
|
|
|
|
|
|
odf_manifest => 'ODF::lpOD::Manifest' |
109
|
2
|
|
|
2
|
|
14
|
}; |
|
2
|
|
|
|
|
4
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
#--- ODF element ------------------------------------------------------------- |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
use constant |
114
|
|
|
|
|
|
|
{ |
115
|
2
|
|
|
|
|
1079
|
odf_element => 'ODF::lpOD::Element', |
116
|
|
|
|
|
|
|
odf_text_node => 'ODF::lpOD::TextNode', |
117
|
|
|
|
|
|
|
odf_text_element => 'ODF::lpOD::TextElement', |
118
|
|
|
|
|
|
|
odf_text_hyperlink => 'ODF::lpOD::TextHyperlink', |
119
|
|
|
|
|
|
|
odf_paragraph => 'ODF::lpOD::Paragraph', |
120
|
|
|
|
|
|
|
odf_heading => 'ODF::lpOD::Heading', |
121
|
|
|
|
|
|
|
odf_list => 'ODF::lpOD::List', |
122
|
|
|
|
|
|
|
odf_field => 'ODF::lpOD::Field', |
123
|
|
|
|
|
|
|
odf_variable => 'ODF::lpOD::Variable', |
124
|
|
|
|
|
|
|
odf_simple_variable => 'ODF::lpOD::SimpleVariable', |
125
|
|
|
|
|
|
|
odf_user_variable => 'ODF::lpOD::UserVariable', |
126
|
|
|
|
|
|
|
odf_text_field => 'ODF::lpOD::TextField', |
127
|
|
|
|
|
|
|
odf_table => 'ODF::lpOD::Table', |
128
|
|
|
|
|
|
|
odf_table_element => 'ODF::lpOD::TableElement', |
129
|
|
|
|
|
|
|
odf_matrix => 'ODF::lpOD::Matrix', |
130
|
|
|
|
|
|
|
odf_column_group => 'ODF::lpOD::ColumnGroup', |
131
|
|
|
|
|
|
|
odf_row_group => 'ODF::lpOD::RowGroup', |
132
|
|
|
|
|
|
|
odf_column => 'ODF::lpOD::Column', |
133
|
|
|
|
|
|
|
odf_row => 'ODF::lpOD::Row', |
134
|
|
|
|
|
|
|
odf_cell => 'ODF::lpOD::Cell', |
135
|
|
|
|
|
|
|
odf_draw_page => 'ODF::lpOD::DrawPage', |
136
|
|
|
|
|
|
|
odf_shape => 'ODF::lpOD::Shape', |
137
|
|
|
|
|
|
|
odf_area => 'ODF::lpOD::Area', |
138
|
|
|
|
|
|
|
odf_rectangle => 'ODF::lpOD::Rectangle', |
139
|
|
|
|
|
|
|
odf_ellipse => 'ODF::lpOD::Ellipse', |
140
|
|
|
|
|
|
|
odf_vector => 'ODF::lpOD::Vector', |
141
|
|
|
|
|
|
|
odf_line => 'ODF::lpOD::Line', |
142
|
|
|
|
|
|
|
odf_connector => 'ODF::lpOD::Connector', |
143
|
|
|
|
|
|
|
odf_frame => 'ODF::lpOD::Frame', |
144
|
|
|
|
|
|
|
odf_image => 'ODF::lpOD::Image', |
145
|
|
|
|
|
|
|
odf_section => 'ODF::lpOD::Section', |
146
|
|
|
|
|
|
|
odf_bibliography_mark => 'ODF::lpOD::BibliographyMark', |
147
|
|
|
|
|
|
|
odf_note => 'ODF::lpOD::Note', |
148
|
|
|
|
|
|
|
odf_annotation => 'ODF::lpOD::Annotation', |
149
|
|
|
|
|
|
|
odf_changed_region => 'ODF::lpOD::ChangedRegion', |
150
|
|
|
|
|
|
|
odf_font_declaration => 'ODF::lpOD::FontDeclaration', |
151
|
|
|
|
|
|
|
odf_style => 'ODF::lpOD::Style', |
152
|
|
|
|
|
|
|
odf_text_style => 'ODF::lpOD::TextStyle', |
153
|
|
|
|
|
|
|
odf_paragraph_style => 'ODF::lpOD::ParagraphStyle', |
154
|
|
|
|
|
|
|
odf_list_style => 'ODF::lpOD::ListStyle', |
155
|
|
|
|
|
|
|
odf_list_level_style => 'ODF::lpOD::ListLevelStyle', |
156
|
|
|
|
|
|
|
odf_outline_style => 'ODF::lpOD::OutlineStyle', |
157
|
|
|
|
|
|
|
odf_table_style => 'ODF::lpOD::TableStyle', |
158
|
|
|
|
|
|
|
odf_column_style => 'ODF::lpOD::ColumnStyle', |
159
|
|
|
|
|
|
|
odf_row_style => 'ODF::lpOD::RowStyle', |
160
|
|
|
|
|
|
|
odf_cell_style => 'ODF::lpOD::CellStyle', |
161
|
|
|
|
|
|
|
odf_data_style => 'ODF::lpOD::DataStyle', |
162
|
|
|
|
|
|
|
odf_master_page => 'ODF::lpOD::MasterPage', |
163
|
|
|
|
|
|
|
odf_page_layout => 'ODF::lpOD::PageLayout', |
164
|
|
|
|
|
|
|
odf_presentation_page_layout => 'ODF::lpOD::PresentationPageLayout', |
165
|
|
|
|
|
|
|
odf_graphic_style => 'ODF::lpOD::GraphicStyle', |
166
|
|
|
|
|
|
|
odf_gradient => 'ODF::lpOD::Gradient', |
167
|
|
|
|
|
|
|
odf_page_end_style => 'ODF::lpOD::PageEndStyle', |
168
|
|
|
|
|
|
|
odf_drawing_page_style => 'ODF::lpOD::DrawingPageStyle', |
169
|
|
|
|
|
|
|
odf_file_entry => 'ODF::lpOD::FileEntry', |
170
|
|
|
|
|
|
|
odf_toc => 'ODF::lpOD::TOC', |
171
|
|
|
|
|
|
|
odf_named_range => 'ODF::lpOD::NamedRange', |
172
|
|
|
|
|
|
|
odf_structured_container => 'ODF::lpOD::StructuredContainer' |
173
|
2
|
|
|
2
|
|
13
|
}; |
|
2
|
|
|
|
|
3
|
|
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
#--- basic API shortcuts ----------------------------------------------------- |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
use constant |
178
|
|
|
|
|
|
|
{ |
179
|
2
|
|
|
|
|
182
|
xelt => 'XML::Twig::Elt', |
180
|
|
|
|
|
|
|
xtwig => 'XML::Twig' |
181
|
2
|
|
|
2
|
|
12
|
}; |
|
2
|
|
|
|
|
3
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
#--- lpOD common tools and parameters ---------------------------------------- |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
use constant |
186
|
|
|
|
|
|
|
{ |
187
|
2
|
|
|
|
|
216
|
lpod_common => 'ODF::lpOD::Common', |
188
|
|
|
|
|
|
|
lpod => 'ODF::lpOD::Common' |
189
|
2
|
|
|
2
|
|
11
|
}; |
|
2
|
|
|
|
|
4
|
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
#--- ODF data types ---------------------------------------------------------- |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
our @DATA_TYPES = qw(string float currency percentage date time boolean); |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
#--- default string comparison function -------------------------------------- |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
our $COMPARE = sub { shift cmp shift }; |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
#=== common parameters ======================================================= |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
use constant # common constants |
202
|
|
|
|
|
|
|
{ |
203
|
2
|
|
|
|
|
145
|
TRUE => 1, |
204
|
|
|
|
|
|
|
FALSE => 0, |
205
|
2
|
|
|
2
|
|
11
|
}; |
|
2
|
|
|
|
|
2
|
|
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
use constant # ODF package parts |
208
|
|
|
|
|
|
|
{ |
209
|
2
|
|
|
|
|
177
|
META => 'meta.xml', |
210
|
|
|
|
|
|
|
CONTENT => 'content.xml', |
211
|
|
|
|
|
|
|
STYLES => 'styles.xml', |
212
|
|
|
|
|
|
|
SETTINGS => 'settings.xml', |
213
|
|
|
|
|
|
|
MANIFEST => 'META-INF/manifest.xml', |
214
|
|
|
|
|
|
|
MIMETYPE => 'mimetype' |
215
|
2
|
|
|
2
|
|
9
|
}; |
|
2
|
|
|
|
|
4
|
|
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
use constant |
218
|
|
|
|
|
|
|
{ |
219
|
2
|
|
|
|
|
105
|
TEXT_SEGMENT => '#PCDATA', |
220
|
|
|
|
|
|
|
text_segment => '#PCDATA' |
221
|
2
|
|
|
2
|
|
8
|
}; |
|
2
|
|
|
|
|
4
|
|
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
use constant # XML::Twig specific |
224
|
|
|
|
|
|
|
{ |
225
|
2
|
|
|
|
|
129
|
EMPTY_TAGS => 'normal' |
226
|
2
|
|
|
2
|
|
18
|
}; |
|
2
|
|
|
|
|
3
|
|
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
use constant # element insert positions |
229
|
|
|
|
|
|
|
{ |
230
|
2
|
|
|
|
|
1815
|
FIRST_CHILD => 'FIRST_CHILD', |
231
|
|
|
|
|
|
|
LAST_CHILD => 'LAST_CHILD', |
232
|
|
|
|
|
|
|
NEXT_SIBLING => 'NEXT_SIBLING', |
233
|
|
|
|
|
|
|
PREV_SIBLING => 'PREV_SIBLING', |
234
|
|
|
|
|
|
|
WITHIN => 'WITHIN', |
235
|
|
|
|
|
|
|
PARENT => 'PARENT' |
236
|
2
|
|
|
2
|
|
14
|
}; |
|
2
|
|
|
|
|
4
|
|
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
our %ODF_TEMPLATE = |
239
|
|
|
|
|
|
|
( |
240
|
|
|
|
|
|
|
'text' => 'text.odt', |
241
|
|
|
|
|
|
|
'spreadsheet' => 'spreadsheet.ods', |
242
|
|
|
|
|
|
|
'presentation' => 'presentation.odp', |
243
|
|
|
|
|
|
|
'drawing' => 'drawing.odg' |
244
|
|
|
|
|
|
|
); |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
our $LINE_BREAK = "\n"; |
247
|
|
|
|
|
|
|
our $TAB_STOP = "\t"; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
our $INSTALLATION_PATH = undef; # lpOD library installation path |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
our $LPOD_MARK = '#lpod:mark'; # lpOD session bookmark tag |
252
|
|
|
|
|
|
|
our $LPOD_ID = '#lpod:id'; # lpOD XML ID attribute |
253
|
|
|
|
|
|
|
our $LPOD_PART = '#lpod:part'; # lpOD link from element to xmlpart |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
#=== common function aliases ================================================= |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
BEGIN { |
258
|
2
|
|
|
2
|
|
7
|
*odf_get_document = *ODF::lpOD::Document::get_from_uri; |
259
|
2
|
|
|
|
|
3
|
*odf_new_document_from_template |
260
|
|
|
|
|
|
|
= *ODF::lpOD::Document::create_from_template; |
261
|
2
|
|
|
|
|
4
|
*odf_new_document_from_type |
262
|
|
|
|
|
|
|
= *ODF::lpOD::Document::_create; |
263
|
2
|
|
|
|
|
4
|
*odf_new_document = *ODF::lpOD::Document::_create; |
264
|
2
|
|
|
|
|
4
|
*odf_create_document = *ODF::lpOD::Document::_create; |
265
|
2
|
|
|
|
|
4
|
*odf_get_container = *ODF::lpOD::Container::get_from_uri; |
266
|
2
|
|
|
|
|
2
|
*odf_new_container_from_template |
267
|
|
|
|
|
|
|
= *ODF::lpOD::Container::create_from_template; |
268
|
2
|
|
|
|
|
4
|
*odf_new_container = *ODF::lpOD::Container::create; |
269
|
2
|
|
|
|
|
4
|
*odf_new_container_from_type |
270
|
|
|
|
|
|
|
= *ODF::lpOD::Container::create; |
271
|
2
|
|
|
|
|
3
|
*odf_get_xmlpart = *ODF::lpOD::XMLPart::get; |
272
|
|
|
|
|
|
|
|
273
|
2
|
|
|
|
|
2
|
*odf_create_element = *ODF::lpOD::Element::_create; |
274
|
2
|
|
|
|
|
10
|
*odf_create_paragraph = *ODF::lpOD::Paragraph::_create; |
275
|
2
|
|
|
|
|
3
|
*odf_create_heading = *ODF::lpOD::Heading::_create; |
276
|
2
|
|
|
|
|
3
|
*odf_create_field = *ODF::lpOD::Field::_create; |
277
|
2
|
|
|
|
|
3
|
*odf_create_simple_variable |
278
|
|
|
|
|
|
|
= *ODF::lpOD::SimpleVariable::_create; |
279
|
2
|
|
|
|
|
5
|
*odf_create_user_variable |
280
|
|
|
|
|
|
|
= *ODF::lpOD::UserVariable::_create; |
281
|
2
|
|
|
|
|
3
|
*odf_create_table = *ODF::lpOD::Table::_create; |
282
|
2
|
|
|
|
|
3
|
*odf_create_row_group = *ODF::lpOD::RowGroup::_create; |
283
|
2
|
|
|
|
|
3
|
*odf_create_column_group |
284
|
|
|
|
|
|
|
= *ODF::lpOD::ColumnGroup::_create; |
285
|
2
|
|
|
|
|
4
|
*odf_create_column = *ODF::lpOD::Column::_create; |
286
|
2
|
|
|
|
|
12
|
*odf_create_row = *ODF::lpOD::Row::_create; |
287
|
2
|
|
|
|
|
3
|
*odf_create_cell = *ODF::lpOD::Cell::_create; |
288
|
2
|
|
|
|
|
4
|
*odf_create_section = *ODF::lpOD::Section::_create; |
289
|
2
|
|
|
|
|
4
|
*odf_create_list = *ODF::lpOD::List::_create; |
290
|
2
|
|
|
|
|
2
|
*odf_create_draw_page = *ODF::lpOD::DrawPage::_create; |
291
|
2
|
|
|
|
|
4
|
*odf_create_shape = *ODF::lpOD::Shape::_create; |
292
|
2
|
|
|
|
|
3
|
*odf_create_area = *ODF::lpOD::Area::_create; |
293
|
2
|
|
|
|
|
3
|
*odf_create_rectangle = *ODF::lpOD::Rectangle::_create; |
294
|
2
|
|
|
|
|
3
|
*odf_create_ellipse = *ODF::lpOD::Ellipse::_create; |
295
|
2
|
|
|
|
|
4
|
*odf_create_vector = *ODF::lpOD::Vector::_create; |
296
|
2
|
|
|
|
|
3
|
*odf_create_line = *ODF::lpOD::Line::_create; |
297
|
2
|
|
|
|
|
3
|
*odf_create_connector = *ODF::lpOD::Connector::_create; |
298
|
2
|
|
|
|
|
3
|
*odf_create_frame = *ODF::lpOD::Frame::_create; |
299
|
2
|
|
|
|
|
20
|
*odf_create_image = *ODF::lpOD::Image::_create; |
300
|
2
|
|
|
|
|
4
|
*odf_create_text_frame = *ODF::lpOD::Frame::_create_text; |
301
|
2
|
|
|
|
|
3
|
*odf_create_image_frame = *ODF::lpOD::Frame::_create_image; |
302
|
2
|
|
|
|
|
3
|
*odf_create_note = *ODF::lpOD::Note::_create; |
303
|
2
|
|
|
|
|
2
|
*odf_create_annotation = *ODF::lpOD::Annotation::_create; |
304
|
2
|
|
|
|
|
4
|
*odf_create_font_declaration |
305
|
|
|
|
|
|
|
= *ODF::lpOD::FontDeclaration::_create; |
306
|
2
|
|
|
|
|
2
|
*odf_create_style = *ODF::lpOD::Style::_create; |
307
|
2
|
|
|
|
|
4
|
*odf_classify_text_field |
308
|
|
|
|
|
|
|
= *ODF::lpOD::TextField::classify; |
309
|
2
|
|
|
|
|
3
|
*odf_create_toc = *ODF::lpOD::TOC::_create; |
310
|
|
|
|
|
|
|
|
311
|
2
|
|
|
|
|
10
|
*is_numeric = *Scalar::Util::looks_like_number; |
312
|
2
|
|
|
|
|
10
|
*odf_value = *check_odf_value; |
313
|
|
|
|
|
|
|
|
314
|
2
|
|
|
|
|
12245
|
*PRETTY_PRINT = *XML_PRETTY_PRINT; |
315
|
|
|
|
|
|
|
#initializations |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
#=== exported utilities ====================================================== |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
our $DEBUG = FALSE; |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub alert |
324
|
|
|
|
|
|
|
{ |
325
|
0
|
0
|
|
0
|
0
|
|
if ($DEBUG) |
326
|
|
|
|
|
|
|
{ |
327
|
0
|
|
|
|
|
|
require Carp; |
328
|
0
|
|
|
|
|
|
return Carp::cluck(@_); |
329
|
|
|
|
|
|
|
} |
330
|
0
|
|
|
|
|
|
warn "$_\n" for @_; |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub info |
334
|
|
|
|
|
|
|
{ |
335
|
|
|
|
|
|
|
return wantarray ? |
336
|
|
|
|
|
|
|
( |
337
|
0
|
0
|
|
0
|
0
|
|
name => "ODF::lpOD", |
338
|
|
|
|
|
|
|
version => $ODF::lpOD::VERSION, |
339
|
|
|
|
|
|
|
date => ODF::lpOD->PACKAGE_DATE, |
340
|
|
|
|
|
|
|
path => lpod->installation_path |
341
|
|
|
|
|
|
|
) |
342
|
|
|
|
|
|
|
: |
343
|
|
|
|
|
|
|
"ODF::lpOD $ODF::lpOD::VERSION" . |
344
|
|
|
|
|
|
|
" " . ODF::lpOD->PACKAGE_DATE . |
345
|
|
|
|
|
|
|
" " . lpod->installation_path; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
0
|
|
|
0
|
0
|
|
sub signature { scalar lpod->info } |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
sub debug |
351
|
|
|
|
|
|
|
{ |
352
|
0
|
|
0
|
0
|
0
|
|
my $param = shift // ""; |
353
|
0
|
0
|
|
|
|
|
$param = shift if $param eq lpod; |
354
|
0
|
|
|
|
|
|
given ($param) |
355
|
|
|
|
|
|
|
{ |
356
|
0
|
|
|
|
|
|
when (undef) {} |
357
|
0
|
|
|
|
|
|
when (TRUE || FALSE) { $DEBUG = $_; } |
|
0
|
|
|
|
|
|
|
358
|
0
|
|
|
|
|
|
default { alert "Wrong argument"; } |
|
0
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
} |
360
|
0
|
|
|
|
|
|
return $DEBUG; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub is_true |
364
|
|
|
|
|
|
|
{ |
365
|
0
|
|
|
0
|
1
|
|
my $arg = shift; |
366
|
0
|
0
|
|
|
|
|
return FALSE unless $arg; |
367
|
0
|
|
|
|
|
|
my $v = lc $arg; |
368
|
0
|
0
|
|
|
|
|
return $v ~~ ["false", "off", "no"] ? FALSE : TRUE; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
sub is_false |
372
|
|
|
|
|
|
|
{ |
373
|
0
|
0
|
|
0
|
1
|
|
return is_true(shift) ? FALSE : TRUE; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub defined_false |
377
|
|
|
|
|
|
|
{ |
378
|
0
|
|
|
0
|
0
|
|
my $arg = shift; |
379
|
0
|
0
|
|
|
|
|
return FALSE unless defined $arg; |
380
|
0
|
0
|
|
|
|
|
return is_false($arg) ? TRUE : FALSE; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
sub odf_boolean |
384
|
|
|
|
|
|
|
{ |
385
|
0
|
|
|
0
|
1
|
|
my $value = shift; |
386
|
0
|
0
|
|
|
|
|
return undef unless defined $value; |
387
|
0
|
0
|
|
|
|
|
return is_true($value) ? 'true' : 'false'; |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub is_odf_datatype |
391
|
|
|
|
|
|
|
{ |
392
|
0
|
0
|
|
0
|
1
|
|
my $type = shift or return undef; |
393
|
0
|
0
|
|
|
|
|
return $type ~~ @DATA_TYPES ? TRUE : FALSE; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub check_odf_value |
397
|
|
|
|
|
|
|
{ |
398
|
0
|
|
|
0
|
0
|
|
my $value = shift; |
399
|
0
|
0
|
|
|
|
|
return undef unless defined $value; |
400
|
0
|
|
|
|
|
|
my $type = shift; |
401
|
0
|
|
|
|
|
|
given ($type) |
402
|
|
|
|
|
|
|
{ |
403
|
|
|
|
|
|
|
when (['float', 'currency', 'percentage']) |
404
|
0
|
|
|
|
|
|
{ |
405
|
0
|
0
|
|
|
|
|
$value = undef unless is_numeric($value); |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
when ('boolean') |
408
|
0
|
|
|
|
|
|
{ |
409
|
0
|
0
|
|
|
|
|
if (is_true($value)) |
410
|
|
|
|
|
|
|
{ |
411
|
0
|
|
|
|
|
|
$value = 'true'; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
else |
414
|
|
|
|
|
|
|
{ |
415
|
0
|
|
|
|
|
|
$value = 'false'; |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
when ('date') |
419
|
0
|
|
|
|
|
|
{ |
420
|
0
|
0
|
|
|
|
|
if (is_numeric($value)) |
421
|
|
|
|
|
|
|
{ |
422
|
0
|
|
|
|
|
|
$value = iso_date($value); |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
else |
425
|
|
|
|
|
|
|
{ |
426
|
0
|
|
|
|
|
|
my $num = numeric_date($value); |
427
|
0
|
0
|
|
|
|
|
$value = defined $num ? |
428
|
|
|
|
|
|
|
iso_date($num) : undef; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} |
432
|
0
|
|
|
|
|
|
return $value; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub process_options |
436
|
|
|
|
|
|
|
{ |
437
|
0
|
|
|
0
|
0
|
|
my %in = (@_); |
438
|
0
|
|
|
|
|
|
my %out = (); |
439
|
0
|
|
|
|
|
|
foreach my $ink (keys %in) |
440
|
|
|
|
|
|
|
{ |
441
|
0
|
|
|
|
|
|
my $outk = $ink; |
442
|
0
|
|
|
|
|
|
$outk =~ s/[ -]/_/g; |
443
|
0
|
|
|
|
|
|
$out{$outk} = $in{$ink}; |
444
|
|
|
|
|
|
|
} |
445
|
0
|
|
|
|
|
|
return %out; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
sub alpha_to_num |
449
|
|
|
|
|
|
|
{ |
450
|
0
|
0
|
|
0
|
0
|
|
my $arg = shift or return 0; |
451
|
0
|
0
|
0
|
|
|
|
$arg = shift if ref($arg) || $arg eq __PACKAGE__; |
452
|
0
|
|
|
|
|
|
my $alpha = uc $arg; |
453
|
0
|
0
|
|
|
|
|
unless ($alpha =~ /^[A-Z]*$/) |
454
|
|
|
|
|
|
|
{ |
455
|
0
|
0
|
|
|
|
|
return $arg if $alpha =~ /^[0-9\-]*$/; |
456
|
0
|
|
|
|
|
|
alert "Wrong alpha value $arg"; |
457
|
0
|
|
|
|
|
|
return undef; |
458
|
|
|
|
|
|
|
} |
459
|
0
|
|
|
|
|
|
my @asplit = split('', $alpha); |
460
|
0
|
|
|
|
|
|
my $num = 0; |
461
|
0
|
|
|
|
|
|
foreach my $p (@asplit) |
462
|
|
|
|
|
|
|
{ |
463
|
0
|
|
|
|
|
|
$num *= 26; |
464
|
0
|
|
|
|
|
|
$num += ((ord($p) - ord('A')) + 1); |
465
|
|
|
|
|
|
|
} |
466
|
0
|
|
|
|
|
|
$num--; |
467
|
0
|
|
|
|
|
|
return $num; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
sub translate_coordinates # adapted from OpenOffice::OODoc (Genicorp) |
471
|
|
|
|
|
|
|
{ |
472
|
0
|
|
0
|
0
|
1
|
|
my $arg = shift // return undef; |
473
|
0
|
|
|
|
|
|
my $ra = ref $arg; |
474
|
0
|
0
|
|
|
|
|
if ($ra) |
|
|
0
|
|
|
|
|
|
475
|
|
|
|
|
|
|
{ |
476
|
0
|
0
|
|
|
|
|
if ($ra eq 'ARRAY') { return @$arg } |
|
0
|
|
|
|
|
|
|
477
|
0
|
|
|
|
|
|
else { shift } |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
elsif ($arg eq __PACKAGE__) |
480
|
|
|
|
|
|
|
{ |
481
|
|
|
|
|
|
|
shift |
482
|
0
|
|
|
|
|
|
} |
483
|
0
|
0
|
|
|
|
|
return ($arg, @_) unless defined $arg; |
484
|
0
|
|
|
|
|
|
my $coord = uc $arg; |
485
|
0
|
0
|
|
|
|
|
return ($arg, @_) unless $coord =~ /[A-Z]/; |
486
|
|
|
|
|
|
|
|
487
|
0
|
|
|
|
|
|
$coord =~ s/\s*//g; |
488
|
0
|
|
|
|
|
|
$coord =~ /(^[A-Z]*)(\d*)/; |
489
|
0
|
|
|
|
|
|
my $c = $1; |
490
|
0
|
|
|
|
|
|
my $r = $2; |
491
|
0
|
0
|
|
|
|
|
return ($arg, @_) unless $c; |
492
|
0
|
|
|
|
|
|
my $colnum = alpha_to_num($c); |
493
|
0
|
0
|
0
|
|
|
|
if (defined $r and $r gt "") |
494
|
|
|
|
|
|
|
{ |
495
|
0
|
|
|
|
|
|
$r--; |
496
|
0
|
|
|
|
|
|
return ($r, $colnum, @_); |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
else |
499
|
|
|
|
|
|
|
{ |
500
|
0
|
|
|
|
|
|
return ($colnum, @_); |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
sub translate_range |
505
|
|
|
|
|
|
|
{ |
506
|
0
|
|
0
|
0
|
1
|
|
my $arg = shift // return undef; |
507
|
0
|
0
|
0
|
|
|
|
$arg = shift if ref($arg) || $arg eq __PACKAGE__; |
508
|
0
|
0
|
0
|
|
|
|
return ($arg, @_) unless (defined $arg && $arg =~ /:/); |
509
|
0
|
|
|
|
|
|
my $range = uc $arg; |
510
|
0
|
|
|
|
|
|
$range =~ s/\s*//g; |
511
|
0
|
|
|
|
|
|
my ($start, $end) = split(':', $range); |
512
|
0
|
|
|
|
|
|
my @r = (); |
513
|
0
|
|
|
|
|
|
push @r, translate_coordinates($_) for ($start, $end); |
514
|
0
|
|
|
|
|
|
return @r; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
#--- external character set conversion utilities ----------------------------- |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
our $INPUT_CHARSET = 'utf8'; |
520
|
|
|
|
|
|
|
our $OUTPUT_CHARSET = 'utf8'; |
521
|
|
|
|
|
|
|
our $INPUT_ENCODER = Encode::find_encoding($INPUT_CHARSET); |
522
|
|
|
|
|
|
|
our $OUTPUT_ENCODER = Encode::find_encoding($OUTPUT_CHARSET); |
523
|
|
|
|
|
|
|
|
524
|
0
|
|
|
0
|
0
|
|
sub get_input_charset { $INPUT_CHARSET } |
525
|
|
|
|
|
|
|
|
526
|
0
|
|
|
0
|
0
|
|
sub get_output_charset { $OUTPUT_CHARSET } |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
sub set_input_charset |
529
|
|
|
|
|
|
|
{ |
530
|
0
|
|
0
|
0
|
0
|
|
my $charset = shift // ""; |
531
|
0
|
0
|
|
|
|
|
$charset = shift if ($charset eq lpod); |
532
|
0
|
|
|
|
|
|
my $enc = Encode::find_encoding($charset); |
533
|
0
|
0
|
|
|
|
|
unless ($enc) |
534
|
|
|
|
|
|
|
{ |
535
|
0
|
|
|
|
|
|
alert("Unsupported $charset input character set"); |
536
|
0
|
|
|
|
|
|
return FALSE; |
537
|
|
|
|
|
|
|
} |
538
|
0
|
|
|
|
|
|
$INPUT_ENCODER = $enc; |
539
|
0
|
|
|
|
|
|
$INPUT_CHARSET = $charset; |
540
|
0
|
|
|
|
|
|
return $INPUT_CHARSET; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
sub set_output_charset |
544
|
|
|
|
|
|
|
{ |
545
|
0
|
|
0
|
0
|
0
|
|
my $charset = shift // ""; |
546
|
0
|
0
|
|
|
|
|
$charset = shift if ($charset eq lpod); |
547
|
0
|
|
|
|
|
|
my $enc = Encode::find_encoding($charset); |
548
|
0
|
0
|
|
|
|
|
unless ($enc) |
549
|
|
|
|
|
|
|
{ |
550
|
0
|
|
|
|
|
|
alert("Unsupported output character set"); |
551
|
0
|
|
|
|
|
|
return FALSE; |
552
|
|
|
|
|
|
|
} |
553
|
0
|
|
|
|
|
|
$OUTPUT_ENCODER = $enc; |
554
|
0
|
|
|
|
|
|
$OUTPUT_CHARSET = $charset; |
555
|
0
|
|
|
|
|
|
return $OUTPUT_CHARSET; |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
sub input_conversion |
559
|
|
|
|
|
|
|
{ |
560
|
0
|
|
|
0
|
0
|
|
my $text = shift; |
561
|
0
|
0
|
|
|
|
|
return $text unless $INPUT_CHARSET; |
562
|
|
|
|
|
|
|
|
563
|
0
|
0
|
|
|
|
|
unless ($INPUT_ENCODER) |
564
|
|
|
|
|
|
|
{ |
565
|
0
|
|
|
|
|
|
alert "Unsupported input character conversion"; |
566
|
0
|
|
|
|
|
|
return $text; |
567
|
|
|
|
|
|
|
} |
568
|
0
|
0
|
|
|
|
|
return (defined $text) ? $INPUT_ENCODER->decode($text) : undef; |
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
sub output_conversion |
572
|
|
|
|
|
|
|
{ |
573
|
0
|
|
|
0
|
0
|
|
my $text = shift; |
574
|
0
|
0
|
|
|
|
|
return $text unless $OUTPUT_CHARSET; |
575
|
|
|
|
|
|
|
|
576
|
0
|
0
|
|
|
|
|
unless ($OUTPUT_ENCODER) |
577
|
|
|
|
|
|
|
{ |
578
|
0
|
|
|
|
|
|
alert "Unsupported output character conversion"; |
579
|
0
|
|
|
|
|
|
return $text; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
0
|
0
|
|
|
|
|
return (defined $text) ? $OUTPUT_ENCODER->encode($text) : undef; |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
#--- ISO-9601 / internal date conversion ------------------------------------- |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
sub iso_date |
588
|
|
|
|
|
|
|
{ |
589
|
0
|
|
0
|
0
|
1
|
|
my $time = shift // time(); |
590
|
0
|
|
|
|
|
|
my @t = localtime($time); |
591
|
0
|
|
|
|
|
|
return sprintf |
592
|
|
|
|
|
|
|
( |
593
|
|
|
|
|
|
|
"%04d-%02d-%02dT%02d:%02d:%02d", |
594
|
|
|
|
|
|
|
$t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0] |
595
|
|
|
|
|
|
|
); |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
sub numeric_date # in progress |
599
|
|
|
|
|
|
|
{ |
600
|
0
|
|
|
0
|
1
|
|
require Time::Local; |
601
|
|
|
|
|
|
|
|
602
|
0
|
0
|
|
|
|
|
my $iso_date = shift or return undef; |
603
|
0
|
0
|
|
|
|
|
$iso_date .= 'T00:00:00'unless ($iso_date =~ /T/); |
604
|
0
|
|
|
|
|
|
$iso_date =~ /(\d*)-(\d*)-(\d*)T(\d*):(\d*):(\d*)/; |
605
|
0
|
|
0
|
|
|
|
my $sec = $6 || 0; my $min = $5 || 0; my $hrs = $4 || 0; |
|
0
|
|
0
|
|
|
|
|
|
0
|
|
0
|
|
|
|
|
606
|
0
|
|
0
|
|
|
|
my $day = $3 || 1; my $mon = $2 || 1; my $year = $1 || 0; |
|
0
|
|
0
|
|
|
|
|
|
0
|
|
0
|
|
|
|
|
607
|
0
|
|
|
|
|
|
return Time::Local::timelocal($sec,$min,$hrs,$day,$mon-1,$year); |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
sub count_substrings |
613
|
|
|
|
|
|
|
{ |
614
|
0
|
|
|
0
|
0
|
|
my $content = shift; |
615
|
0
|
|
|
|
|
|
my $expr = shift; |
616
|
0
|
0
|
|
|
|
|
return undef unless defined $expr; |
617
|
0
|
|
|
|
|
|
my @matches = ($content =~ /$expr/g); |
618
|
0
|
|
|
|
|
|
return scalar @matches; |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
sub search_string |
622
|
|
|
|
|
|
|
{ |
623
|
0
|
|
|
0
|
0
|
|
my $content = shift; |
624
|
0
|
|
|
|
|
|
my $expr = shift; |
625
|
0
|
0
|
|
|
|
|
return undef unless defined $expr; |
626
|
0
|
|
|
|
|
|
my %opt = |
627
|
|
|
|
|
|
|
( |
628
|
|
|
|
|
|
|
replace => undef, |
629
|
|
|
|
|
|
|
offset => undef, |
630
|
|
|
|
|
|
|
range => undef, |
631
|
|
|
|
|
|
|
@_ |
632
|
|
|
|
|
|
|
); |
633
|
0
|
|
|
|
|
|
my $start = $opt{offset}; |
634
|
0
|
|
|
|
|
|
my $ln = length($content); |
635
|
0
|
0
|
0
|
|
|
|
if ((defined $start) and (abs($start) >= $ln)) |
636
|
|
|
|
|
|
|
{ |
637
|
0
|
|
|
|
|
|
alert "[$start $ln] out of range"; |
638
|
0
|
|
|
|
|
|
return undef; |
639
|
|
|
|
|
|
|
} |
640
|
0
|
|
|
|
|
|
my $range = $opt{range}; |
641
|
0
|
0
|
|
|
|
|
if (defined $start) |
642
|
|
|
|
|
|
|
{ |
643
|
0
|
0
|
|
|
|
|
$start = $start + $ln if $start < 0; |
644
|
0
|
0
|
|
|
|
|
$content = defined $range ? |
645
|
|
|
|
|
|
|
substr($content, $start, $range) : |
646
|
|
|
|
|
|
|
substr($content, $start); |
647
|
|
|
|
|
|
|
} |
648
|
0
|
0
|
|
|
|
|
unless (defined $opt{replace}) |
649
|
|
|
|
|
|
|
{ |
650
|
0
|
0
|
|
|
|
|
if ($content =~ /$expr/) |
651
|
|
|
|
|
|
|
{ |
652
|
0
|
|
|
|
|
|
my $start_pos = length($`); |
653
|
0
|
0
|
|
|
|
|
$start_pos += $start if defined $start; |
654
|
0
|
|
|
|
|
|
my $end_pos = $start_pos + length($&); |
655
|
0
|
|
|
|
|
|
my $match = $&; |
656
|
|
|
|
|
|
|
return wantarray ? |
657
|
0
|
0
|
|
|
|
|
($start_pos, $end_pos, $match) : |
658
|
|
|
|
|
|
|
$start_pos; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
else |
661
|
|
|
|
|
|
|
{ |
662
|
0
|
0
|
|
|
|
|
return wantarray ? (undef) : undef; |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
else |
666
|
|
|
|
|
|
|
{ |
667
|
0
|
|
|
|
|
|
my $rep = $opt{replace}; |
668
|
0
|
|
|
|
|
|
my $count = ($content =~ s/$expr/$rep/g); |
669
|
0
|
0
|
|
|
|
|
if (wantarray) |
670
|
|
|
|
|
|
|
{ |
671
|
0
|
|
|
|
|
|
return ($content, $count); |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
else |
674
|
|
|
|
|
|
|
{ |
675
|
0
|
0
|
|
|
|
|
return $count ? $content : undef; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
sub file_type |
683
|
|
|
|
|
|
|
{ |
684
|
0
|
|
|
0
|
1
|
|
require File::Type; |
685
|
0
|
|
|
|
|
|
my $f = shift; |
686
|
0
|
0
|
0
|
|
|
|
return undef unless (-r $f && -f $f); |
687
|
0
|
|
|
|
|
|
return File::Type->new->mime_type($f); |
688
|
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
sub file_parse |
691
|
|
|
|
|
|
|
{ |
692
|
0
|
|
|
0
|
1
|
|
require File::Basename; |
693
|
0
|
|
|
|
|
|
my $source = shift; |
694
|
0
|
0
|
|
|
|
|
if (wantarray) |
695
|
|
|
|
|
|
|
{ |
696
|
0
|
|
|
|
|
|
my ($name,$path,$suffix) = |
697
|
|
|
|
|
|
|
File::Basename::fileparse($source, qr/\.[^.]*/); |
698
|
0
|
0
|
|
|
|
|
if (defined $suffix) |
699
|
|
|
|
|
|
|
{ |
700
|
0
|
|
|
|
|
|
$name .= $suffix; |
701
|
0
|
|
|
|
|
|
$suffix =~ s/^\.//; |
702
|
|
|
|
|
|
|
} |
703
|
0
|
|
|
|
|
|
return ($name, $path, $suffix); |
704
|
|
|
|
|
|
|
} |
705
|
0
|
|
|
|
|
|
return File::Basename::fileparse($source); |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
sub load_file |
709
|
|
|
|
|
|
|
{ |
710
|
0
|
0
|
|
0
|
0
|
|
my $url = shift or return undef; |
711
|
0
|
|
0
|
|
|
|
my $mode = shift // ':utf8'; |
712
|
|
|
|
|
|
|
|
713
|
0
|
0
|
0
|
|
|
|
if (! ref $url and $url =~ /:/ and uc($url) !~ /^[A-Z]:/) |
|
|
|
0
|
|
|
|
|
714
|
|
|
|
|
|
|
{ |
715
|
0
|
|
|
|
|
|
require LWP::Simple; |
716
|
0
|
|
|
|
|
|
$url =~ s{\\}{/}; |
717
|
0
|
|
|
|
|
|
return LWP::Simple::get($url); |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
else |
720
|
|
|
|
|
|
|
{ |
721
|
0
|
0
|
0
|
|
|
|
return undef unless ref $url or -r -f -e $url; |
722
|
0
|
|
|
|
|
|
require File::Slurp; |
723
|
0
|
|
|
|
|
|
return scalar File::Slurp::read_file |
724
|
|
|
|
|
|
|
($url, binmode => $mode); |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
sub image_size |
729
|
|
|
|
|
|
|
{ |
730
|
0
|
0
|
|
0
|
1
|
|
my $url = shift or return undef; |
731
|
0
|
|
|
|
|
|
my %opt = @_; |
732
|
0
|
|
|
|
|
|
my $source; |
733
|
|
|
|
|
|
|
|
734
|
0
|
0
|
|
|
|
|
if (ref $url eq 'SCALAR') |
|
|
0
|
|
|
|
|
|
735
|
|
|
|
|
|
|
{ |
736
|
0
|
|
|
|
|
|
$source = $url; |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
elsif ($opt{document}) |
739
|
|
|
|
|
|
|
{ |
740
|
0
|
|
|
|
|
|
$source = \($opt{document}->get_part($url)); |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
else |
743
|
|
|
|
|
|
|
{ |
744
|
0
|
|
|
|
|
|
$source = \(load_file($url, ':raw')); |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
|
747
|
0
|
0
|
|
|
|
|
if ($source) |
748
|
|
|
|
|
|
|
{ |
749
|
0
|
|
|
|
|
|
require Image::Size; |
750
|
0
|
|
|
|
|
|
my ($w, $h) = Image::Size::imgsize($source); |
751
|
0
|
0
|
|
|
|
|
return undef unless defined $w; |
752
|
0
|
0
|
|
|
|
|
if (wantarray) |
753
|
|
|
|
|
|
|
{ |
754
|
0
|
|
|
|
|
|
return ($w, $h); |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
else |
757
|
|
|
|
|
|
|
{ |
758
|
0
|
|
|
|
|
|
$w .= 'pt'; $h .= 'pt'; |
|
0
|
|
|
|
|
|
|
759
|
0
|
|
|
|
|
|
return [$w, $h]; |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
else |
763
|
|
|
|
|
|
|
{ |
764
|
0
|
|
|
|
|
|
return undef; |
765
|
|
|
|
|
|
|
} |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
sub input_2d_value |
769
|
|
|
|
|
|
|
{ |
770
|
0
|
0
|
|
0
|
0
|
|
my $arg = shift or return undef; |
771
|
0
|
|
0
|
|
|
|
my $u = shift // 'cm'; |
772
|
0
|
|
|
|
|
|
my ($x, $y); |
773
|
0
|
0
|
|
|
|
|
if (ref $arg) |
|
|
0
|
|
|
|
|
|
774
|
|
|
|
|
|
|
{ |
775
|
0
|
|
|
|
|
|
$x = $arg->[0]; $y = $arg->[1]; |
|
0
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
elsif ($arg) |
778
|
|
|
|
|
|
|
{ |
779
|
0
|
0
|
|
|
|
|
if ($arg =~ /,/) |
780
|
|
|
|
|
|
|
{ |
781
|
0
|
|
|
|
|
|
$arg =~ s/\s*//g; |
782
|
0
|
|
|
|
|
|
($x, $y) = split(',', $arg); |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
else |
785
|
|
|
|
|
|
|
{ |
786
|
0
|
|
|
|
|
|
$x = $arg; $y = shift; |
|
0
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
} |
789
|
0
|
|
0
|
|
|
|
$x ||= ('0' . $u); $y ||= ('0' . $u); |
|
0
|
|
0
|
|
|
|
|
790
|
0
|
0
|
|
|
|
|
$x .= $u unless $x =~ /[a-zA-Z]$/; |
791
|
0
|
0
|
|
|
|
|
$y .= $u unless $y =~ /[a-zA-Z]$/; |
792
|
0
|
0
|
|
|
|
|
return wantarray ? ($x, $y) : [$x, $y]; |
793
|
|
|
|
|
|
|
} |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
#--- symbolic color names handling ------------------------------------------- |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
our %COLORCODE = (); |
798
|
|
|
|
|
|
|
our %COLORNAME = (); |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
sub color_code |
801
|
|
|
|
|
|
|
{ |
802
|
0
|
0
|
|
0
|
0
|
|
my $name = shift or return undef; |
803
|
0
|
0
|
0
|
|
|
|
if ($name && ($name =~ /^#/)) { return $name } |
|
0
|
|
|
|
|
|
|
804
|
0
|
|
|
|
|
|
return $COLORCODE{$name}; |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
sub color_name |
808
|
|
|
|
|
|
|
{ |
809
|
0
|
0
|
|
0
|
0
|
|
my $code = shift or return undef; |
810
|
0
|
|
|
|
|
|
return $COLORNAME{lc $code}; |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
sub load_color_map |
814
|
|
|
|
|
|
|
{ |
815
|
0
|
|
0
|
0
|
0
|
|
my $filename = shift || (installation_path() . '/data/rgb.txt'); |
816
|
0
|
0
|
0
|
|
|
|
unless ( -e $filename && -r $filename ) |
817
|
|
|
|
|
|
|
{ |
818
|
0
|
0
|
|
|
|
|
warn "Color map file non existent or unreadable" |
819
|
|
|
|
|
|
|
if $DEBUG; |
820
|
0
|
|
|
|
|
|
return FALSE; |
821
|
|
|
|
|
|
|
} |
822
|
0
|
|
|
|
|
|
my $r = open COLORS, "<", $filename; |
823
|
0
|
0
|
|
|
|
|
unless ($r) |
824
|
|
|
|
|
|
|
{ |
825
|
0
|
|
|
|
|
|
alert "Error opening $filename"; return FALSE; |
|
0
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
} |
827
|
0
|
|
|
|
|
|
while (my $line = ) |
828
|
|
|
|
|
|
|
{ |
829
|
0
|
|
|
|
|
|
$line =~ s/^\s*//; $line =~ s/\s*$//; |
|
0
|
|
|
|
|
|
|
830
|
0
|
0
|
|
|
|
|
next unless $line =~ /^[0-9]/; |
831
|
0
|
|
|
|
|
|
$line =~ /(\d*)\s*(\d*)\s*(\d*)\s*(.*)/; |
832
|
0
|
|
|
|
|
|
my $name = $4; |
833
|
0
|
0
|
|
|
|
|
$COLORCODE{$name} = sprintf("#%02x%02x%02x", $1, $2, $3) |
834
|
|
|
|
|
|
|
if $name; |
835
|
|
|
|
|
|
|
} |
836
|
0
|
|
|
|
|
|
close COLORS; |
837
|
0
|
|
|
|
|
|
%COLORNAME = reverse %COLORCODE; |
838
|
0
|
|
|
|
|
|
return TRUE; |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
sub unload_color_map |
842
|
|
|
|
|
|
|
{ |
843
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
844
|
0
|
|
|
|
|
|
%COLORCODE = (); |
845
|
0
|
|
|
|
|
|
%COLORNAME = (); |
846
|
0
|
|
|
|
|
|
return TRUE; |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
850
|
|
|
|
|
|
|
|
851
|
0
|
|
|
0
|
0
|
|
sub installation_path { $INSTALLATION_PATH } |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
sub template |
854
|
|
|
|
|
|
|
{ |
855
|
0
|
|
0
|
0
|
0
|
|
my $type = shift // ""; |
856
|
0
|
0
|
|
|
|
|
$type = shift if $type eq lpod; |
857
|
|
|
|
|
|
|
|
858
|
0
|
|
|
|
|
|
my $filename = $ODF_TEMPLATE{$type}; |
859
|
0
|
0
|
|
|
|
|
unless ($filename) |
860
|
|
|
|
|
|
|
{ |
861
|
0
|
|
|
|
|
|
alert("Unsupported type"); |
862
|
0
|
|
|
|
|
|
return FALSE; |
863
|
|
|
|
|
|
|
} |
864
|
0
|
|
|
|
|
|
my $fullpath = installation_path() . '/templates/' . $filename; |
865
|
0
|
0
|
|
|
|
|
unless (-r -f -e $fullpath) |
866
|
|
|
|
|
|
|
{ |
867
|
0
|
|
|
|
|
|
alert("Template not available"); |
868
|
0
|
|
|
|
|
|
return FALSE; |
869
|
|
|
|
|
|
|
} |
870
|
0
|
|
|
|
|
|
return $fullpath; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
#--- session ID generator ---------------------------------------------------- |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
our $LPOD_ID_PATTERN = 'lpOD_%09x'; |
876
|
|
|
|
|
|
|
sub new_id |
877
|
|
|
|
|
|
|
{ |
878
|
0
|
|
|
0
|
0
|
|
state $count = 0; |
879
|
0
|
|
|
|
|
|
return sprintf($LPOD_ID_PATTERN, ++$count); |
880
|
|
|
|
|
|
|
} |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
#--- pretty XML output option ------------------------------------------------ |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
our $XML_PRETTY_PRINT_MODE = 'indented'; |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
sub XML_PRETTY_PRINT |
887
|
|
|
|
|
|
|
{ |
888
|
0
|
|
0
|
0
|
0
|
|
my $pp = shift // ""; |
889
|
0
|
0
|
|
|
|
|
$pp = shift if ($pp eq lpod); |
890
|
0
|
0
|
|
|
|
|
$XML_PRETTY_PRINT_MODE = $pp if $pp; |
891
|
0
|
|
|
|
|
|
return $XML_PRETTY_PRINT_MODE; |
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
sub not_implemented |
897
|
|
|
|
|
|
|
{ |
898
|
0
|
|
|
0
|
0
|
|
alert("NOT IMPLEMENTED"); |
899
|
0
|
|
|
|
|
|
return FALSE; |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
#============================================================================= |
903
|
|
|
|
|
|
|
1; |