Setting a OpenOffice::OODoc to Landscape (Perl) - perl

I am trying to create an Open Office document using PERL and OpenOffice::OODoc, and I wish for the resulting document to be in the landscape orientation.
I tried going through the OpenOffice::OODoc::Styles, and the best I got is: switchPageOrientation(page); but I don't know what page is.
So I put together the following code:
#!/usr/bin/perl -w
use strict;
use Data::Dumper;
use OpenOffice::OODoc;
my $docFile = "../resources/landscape.odt";
my $doc = odfDocument( file => $docFile,
create => 'text' );
my $pageLayout = $doc->updatePageLayout(
"LandscapeStyle",
properties => {
'fo:margin-bottom' => '0.7874in',
'fo:page-width' => '11in',
'style:footnote-max-height' => '0in',
'style:shadow' => 'none',
'fo:margin-left' => '0.7874in',
'fo:margin-right' => '0.7874in',
'fo:page-height' => '8.5in',
'style:num-format' => '1',
'style:print-orientation' => 'landscape',
'style:writing-mode' => 'lr-tb',
'fo:margin-top' => '0.7874in'
}
);
$doc->switchPageOrientation($pageLayout);
$doc->appendParagraph( text => "Testing",
style => $pageLayout );
$doc->save;
print "\"$docFile\" is saved.\n";
print "Done.";
exit 0;
The Output is:
Odd number of elements in hash assignment at C:/Strawberry/perl/site/lib/OpenOffice/OODoc/Styles.pm line 1301.
Use of uninitialized value in list assignment at C:/Strawberry/perl/site/lib/OpenOffice/OODoc/Styles.pm line 1301.
"../resources/landscape.odt" is saved.
Done.`
The document is created but not in landscape, rather within the regular portrait orientation.
Does anyone know what page is, and how I can get it to change my document?
Any ideas?

Related

Perl Tkx entry validation not working

I am having an issue getting my text validation to work properly. Basically I have 2 entry boxes, one to enter the name of a branch in CVS and the other to enter a directory name. I want my program to validate the text in each box whenever it is changed.
To do this, the documentation online says to use the "key" option to validate the entry whenever a keystroke changes the entry box's contents. The problem is, when I use the "key" option and then run the program, when I type into the entry boxes no text appears.
My code is shown below:
use strict;
use warnings;
use Tkx;
# Initialize BRANCH and DIRECTORY
my ($BRANCH, $DIRECTORY) = ();
# DEFINE DISPLAY OBJECTS ###########################################################################
# Define main window
my $main_window = Tkx::widget->new('.');
# Define content frame
my $content_frame = $main_window->new_ttk__frame(-padding => '5 5 5 5');
# Define labels
my $branch_label = $content_frame->new_ttk__label(-text => 'Branch' );
my $directory_label = $content_frame->new_ttk__label(-text => 'Directory');
# Define entry boxes
my $branch_entry = $content_frame->new_ttk__entry(-width => 20, -textvariable => \$BRANCH , -validate => 'key', -validatecommand => \&check_state);
my $directory_entry = $content_frame->new_ttk__entry(-width => 20, -textvariable => \$DIRECTORY, -validate => 'key', -validatecommand => \&check_state);
# Define buttons
my $generate_list_button = $content_frame->new_ttk__button(-text => 'Generate', -state => 'disabled', -command => \&generate_list);
# POSITION DISPLAY OBJECTS #########################################################################
# Position content frame
$content_frame->g_grid(-column => 0, -row => 0);
# Position labels
$branch_label ->g_grid(-column => 0, -row => 0);
$directory_label->g_grid(-column => 0, -row => 1);
# Position entry boxes
$branch_entry ->g_grid(-column => 1, -row => 0);
$directory_entry->g_grid(-column => 1, -row => 1);
# Position buttons
$generate_list_button->g_grid(-column => 0, -row => 2, -columnspan => 2);
# Add padding
for my $child (Tkx::SplitList($content_frame->g_winfo_children)) {
Tkx::grid_configure($child, -padx => 5, -pady => 5);
}
# Check the state of the program
sub check_state {
# Check conditions are met to enable generate_list
if ($BRANCH && $DIRECTORY) {
if (-d $DIRECTORY) {
$generate_list_button->state('!disabled');
} else {
$generate_list_button->state('disabled');
}
} else {
$generate_list_button->state('disabled');
}
return 0;
}
Tkx::MainLoop();
If I change "key" to something else (like focusout) it appears to work correctly. But I would really like it to validate after every keystroke instead of just when the focus is taken out of the entry box. Why doesn't this work?
Your check_state subroutine always returns 0 which means "validation failed" and prevents
the text from being entered. Since you aren't really validating the text -- just using the validation mechanism to trigger state updates to related widgets -- you should return 1 (unconditionally) instead. See validatecommand in the (Tcl) Tk documentation for more details.
The subroutines returning 0 turned out to be only half the problem. Once I fixed that the entry validation was not acting properly. What was happening was every time it tried to validate the entry it would actually be validating the previous entry.
ex:
If you typed in "/somedirectory" it would try to validate on every keystroke, after the last keystroke of "y" it would get the value of $DIRECTORY and validate against it. The problem was that at this point $DIRECTORY would be equal to "/somedirector"
To solve this issue I had to do a little digging so I wanted to post my findings in case someone else ran into this same issue.
The solution was to use Tkx::Ev() to get the "current" value of the entry as it was being entered.
(Tkx::Ev(%P) gets the newly entered value so the validation will work properly)
# Define the entry box
my $directory_entry = $content_frame->new_ttk__entry(
-width => 20,
-textvariable => \$DIRECTORY,
-validate => 'key',
-validatecommand => [\&check_dir, Tkx::Ev('%P')],
);
# Validate the entry box
sub check_dir {
# Unpack input arguments
my ($P) = #_;
if (-d $P) {
# Do something here
} else {
# Do something else here
}
return 1;
}

Perl/Curses event handling and I/O

So, I just started trying to use the perl curses module for a project I'm working on. The documentation seems to be extremely lacking, what little I can find on cpan seems to be half-finished and assumes previous curses library experience, which I don't have. I have two issues I am trying to solve, my code so far:
#!/usr/bin/perl
use strict;
use Curses::UI;
use Term::ReadKey;
my ($cols, $rows, $wp, $hp) = GetTerminalSize();
my $cui = new Curses::UI( -color_support => 1);
sub eDialog {
my $return = $cui->dialog(
-message => "Are you sure?",
-title => "Really quit?",
-buttons => ['yes', 'no']
);
exit(0) if $return;
}
sub entryUpdate {
my $mainentry = shift;
if($mainEntry->get() =~ m/.*\n$/)
{
print STDERR $mainEntry->get();
}
}
$cui->set_binding( \&eDialog , "\cQ");
my $mainWin = $cui->add(
'viewWin', 'Window',
-border => 1,
-height => ($rows - 3),
-bfg => 'green'
);
my $mainView = $mainWin->add(
"viewWid", "TextViewer",
-wrapping => 1
);
my $entryWin = $cui->add(
'entryWin', 'Window',
-border => 1,
-y => ($rows - 3),
-height => 1,
-bfg => 1
);
my $mainEntry = $entryWin->add(
"entryWid", "TextEntry",
-onchange => \&entryUpdate()
);
$mainEntry->focus();
$cui->mainloop();
I managed to get the UI set up how I want it, but actually making it work is proving problematic.
1). I want to be able to, when text is typed into the $mainEntry widget, detect when enter/return is pressed, and execute a subroutine to do stuff with the text typed into the widget, then clear it out. (I tried accomplishing this with the entryUpdate subroutine, but that isn't working at all, no matter how I've tried to do it.)
2). I want to be able to periodically (Say, every 1 second or 500ms), execute another subroutine, and have the string it returns added to the $mainView widget.
Getting either or both of these to work has proven to be a huge issue thus far, I just dont know enough about how curses works and I haven't been able to find the information I need anywhere. Any help would be much appreciated.
1) You can simply bind the return key to a subrouting using set_binding:
use Curses qw(KEY_ENTER);
$mainEntry->set_binding(sub {
$mainView->text($mainView->text . $mainEntry->get . "\n");
$mainView->draw;
$mainEntry->text("");
}, KEY_ENTER);
2) It seems that there are timer methods (found them by grepping the Curses-UI source code), but they are not documented, which is probably an issue. Here's how it's used:
$cui->set_timer('timer_name', sub {
$mainView->text($mainView->text . scalar(localtime)."\n");
$mainView->draw;
}, 1);

What is wrong with my declaration of a hash inside a hash in Perl?

I am struggling with the following declaration of a hash in Perl:
my %xmlStructure = {
hostname => $dbHost,
username => $dbUsername,
password => $dbPassword,
dev_table => $dbTable,
octopus => {
alert_dir => $alert_dir,
broadcast_id => $broadcast_id,
system_id => $system_id,
subkey => $subkey
}
};
I've been googling, but I haven't been able to come up with a solution, and every modification I make ends up in another warning or in results that I do not want.
Perl complaints with the following text:
Reference found where even-sized list expected at ./configurator.pl line X.
I am doing it that way, since I want to use the module:
XML::Simple
In order to generate a XML file with the following structure:
<settings>
<username></username>
<password></password>
<database></database>
<hostname></hostname>
<dev_table></dev_table>
<octopus>
<alert_dir></alert_dir>
<broadcast_id></broadcast_id>
<subkey></subkey>
</octopus>
</settings>
so sometthing like:
my $data = $xmlFile->XMLout(%xmlStructure);
warn Dumper($data);
would display the latter xml sample structure.
Update:
I forgot to mention that I also tried using parenthesis instead of curly braces for the hash reference, and eventhough it seems to work, the XML file is not written properly:
I end up with the following structure:
<settings>
<dev_table>5L3IQWmNOw==</dev_table>
<hostname>gQMgO3/hvMjc</hostname>
<octopus>
<alert_dir>l</alert_dir>
<broadcast_id>l</broadcast_id>
<subkey>l</subkey>
<system_id>l</system_id>
</octopus>
<password>dZJomteHXg==</password>
<username>sjfPIQ==</username>
</settings>
Which is not exactly wrong, but I'm not sure if I'm going to have problems latter on as the XML file grows bigger. The credentials are encrypted using RC4 algorith, but I am encoding in base 64 to avoid any misbehavior with special characters.
Thanks
{} are used for hash references. To declare a hash use normal parentheses ():
my %xmlStructure = (
hostname => $dbHost,
username => $dbUsername,
password => $dbPassword,
dev_table => $dbTable,
octopus => {
alert_dir => $alert_dir,
broadcast_id => $broadcast_id,
system_id => $system_id,
subkey => $subkey
}
);
See also perldoc perldsc - Perl Data Structures Cookbook.
For your second issue, you should keep in mind that XML::Simple is indeed too simple for most applications. If you need a specific layout, you're better off with a different way of producing the XML, say, using HTML::Template. For example (I quoted variable names for illustrative purposes):
#!/usr/bin/env perl
use strict; use warnings;
use HTML::Template;
my $tmpl = HTML::Template->new(filehandle => \*DATA);
$tmpl->param(
hostname => '$dbHost',
username => '$dbUsername',
password => '$dbPassword',
dev_table => '$dbTable',
octopus => [
{
alert_dir => '$alert_dir',
broadcast_id => '$broadcast_id',
system_id => '$system_id',
subkey => '$subkey',
}
]
);
print $tmpl->output;
__DATA__
<settings>
<username><TMPL_VAR username></username>
<password><TMPL_VAR password></password>
<database><TMPL_VAR database></database>
<hostname><TMPL_VAR hostname></hostname>
<dev_table><TMPL_VAR dev_table></dev_table>
<octopus><TMPL_LOOP octopus>
<alert_dir><TMPL_VAR alert_dir></alert_dir>
<broadcast_id><TMPL_VAR broadcast_id></broadcast_id>
<subkey><TMPL_VAR subkey></subkey>
<system_id><TMPL_VAR system_id></system_id>
</TMPL_LOOP></octopus>
</settings>
Output:
<settings>
<username>$dbUsername</username>
<password>$dbPassword</password>
<database></database>
<hostname>$dbHost</hostname>
<dev_table>$dbTable</dev_table>
<octopus>
<alert_dir>$alert_dir</alert_dir>
<broadcast_id>$broadcast_id</broadcast_id>
<subkey>$subkey</subkey>
<system_id>$system_id</system_id>
</octopus>
</settings>
You're using the curly braces { ... } to construct a reference to an anonymous hash. You should either assign that to a scalar, or change the { ... } to standard parentheses ( ... ).

block reading in perl

I need to read one block from file and then need to match the particular patterns and get the values for the matched pattern.
> Call report:$VAR1 = {
> 'service_status' => 'DIAL-IN-SEQUENTIAL',
> 'called_id' => '761',
> 'id' => '41298',
> 'redirect_number' => undef,
> 'profile_id' => '137',
> 'not_answered_action' => '0',
> 'call_landed_day' => '1',
> 'call_end_status' => 'CALLER_HANGSUP',
> 'announce_caller_type' => '0',
> 'user_id' => '143',
> 'follow_me_group' => '135',
> 'call_end_time' => '29/11/2010 09:39:57',
> 'findme_id' => '135',
> 'fmsonenumber' => '43902761',
> 'profile_cause' => 'IMMEDIATE_OVERRIDE',
> 'fms_id' => '85dd3b2a-fb6e-11df-a0b0-a1f3d600a5a6',
> 'caller_type' => 'UNKNOWN',
> 'fms_type' => 'FOLLOWME',
> 'profile_desc' => 'office',
> 'caller_id' => '43902761',
> 'call_landed_time' => '29/11/2010 09:39:55'
> };
From the above block I need to read the block between two { } braces.After that I want to match the particular pattern like service_status and then after matching the service_status pattern should retrieve the value of the service_status as DIAL-IN-SEQUENTIAL.Likewise I need to match the patterns in some of the lines and get the values for that patterns. How can we achieve this?. If anyone know the way to solve this pls give me the solution.
Thanks in advance.
You can process the file so that it became a valid perl module that contains a definition of an array of hashes. Write a filter (or do it with emacs/vim or your favorite editor) to substitute the "Call report:$VAR1 = {" to a statement that pushes the hash into an array, something like "push #all_hashes, {".
Then you can use the module and iterate through the variables as normal perl hashes.
Well, given the constraints my solution is rather ugly, but you can get it as a regexp exercise ( but you can avoid it ):
#!/usr/bin/env perl
use v5.12;
use strict;
open my $fh, '<', 'block.txt';
while ( <$fh> ) {
if ( /^[^}^{]++$/ .. /^[^}]++$/ ) {
if ( /(?<='service_status' => )'([^']+)'/ ) { say $1 };
}
}
Just note how I used the flip-flop operator in the first conditional, and the positive lookbehind in the second conditional.
The first conditional returns true when it finds a line without open or closed curly brace; it keeps returning true until it finds a line with a closed curly brace, when it returns false.
With this kind of a filter you get only lines between those with braces.

Settings in pdf::table perl

I'm trying to create a table in PDF format using PDF::Table in perl.
However, it seem to not read my header/cols/rows settings.
Here's my code for the table:
use PDF::API2;
use PDF::Table;
my $pdftable = new PDF::Table;
my $pdf = PDF::API2->new();
my $page = $pdf->page;
#data
my $some_data =[
["1","1","1","1","1","1","1"],
["2","2","2","2","2","2","2"],
["2","2","2","2","2","2","2"],
["2","2","2","2","2","2","2"],
["2","2","2","2","2","2","2"],# x 100 time to have pages
];
#build the table layout
$pdftable->table(
$pdf,
$page,
$some_data,
x => 5,
w => 600,
start_y => 750,
next_y => 750,
start_h => 700,
next_h => 700,
# some optional params
font_size => 8,
border => 0,
background_color_odd => "white",
background_color_even => "lightblue",
header_props => $hdr_props, # see section HEADER ROW PROPERTIES
);
$hdr_props =
{
# This param could be a pdf core font or user specified TTF.
# See PDF::API2 FONT METHODS for more information
font => $pdf->corefont("Times", -encoding => "utf8"),
font_size => 10,
font_color => '#006666',
bg_color => 'yellow',
repeat => 1, # 1/0 eq On/Off if the header row should be repeated to every new page
};
print "Content-Type: application/pdf;\n\n";
binmode(STDOUT);
print $pdf->stringify;
It should make the first row as header by default but the output shows no header properties being set on the first row. And there is no header shown for all pages.
Any help will be appreciated.
I did not run your code.
You are referencing $hdr_props before the variable is filled. Perl does not work that way, you need to order definitions properly.
Add use strict; use warnings FATAL => 'all'; to the top of your programs and Perl will alert you about mistakes like this.
theres no warnings at all, and i followed daxim to put the $hdr_props to top first but it still would not read in the header settings.
The documentation says that header_props needs to be a hash reference, so:
header_props => \$hdr_props, # see section HEADER ROW PROPERTIES
I ran into a similar problem. However, daxim is right, you should also order your code as he suggested.