Does anybody know how can one set PDF tags using PDF::API2 perl module?
Is it related to the following subroutine:
#attributes = $pdf->infoMetaAttributes('CustomField1');
print "Supported Attributes: #attributes\n";
Any reference how to do this with this Perl module?
Thanks!
If you're using PDF::API2 (I think that's what you meant to type), the info method allows you to obtain and modify the PDF tags. The infoMetaAttributes is used to obtain or modify the list of possible tags themselves, not to provide values for one or more of them.
So, to set the author to "Fred":
$pdf->info ('Author' => 'Fred');
To find the current author:
my $author = $pdf->info ('Author');
To show 'em all:
my %tags = $pdf->info;
for my $tag (keys %tags) {
print $tag, " has value ", $tags{$tag}
}
Related
I have a simple page hit tracking script that allows for the output to display friendly names instead of urls by using a hash.
UPDATE: I used php to generate the hash below, but used the wrong dynamic page name of item.html. When changed to the correct name, the script returns the desired results. Sorry for wasting anyone's time.
my %LocalAddressTitlePairs = (
'https://www.mywebsite.com/index.html' => 'HOME',
'https://www.mywebsite.com/art_gallery.html' => 'GALLERY',
'https://www.mywebsite.com/cart/item.html?itemID=83&cat=26' => 'Island Life',
'https://www.mywebsite.com/cart/item.html?itemID=11&cat=22' => 'Castaways',
'https://www.mywebsite.com/cart/item.html?itemID=13&cat=29' => 'Pelicans',
and so on..
);
The code for returning the page hits:
sub url_format {
local $_ = $_[0] || '';
if ((m!$PREF{'My_Web_Address'}!i) and (m!^https://(.*)!i) ) {
if ($UseLocalAddressTitlePairs == 1) {
foreach my $Address (keys %LocalAddressTitlePairs) {
return "<a title=\"$Address\" href=\"$_\">$LocalAddressTitlePairs{$Address}</A>" if (m!$_$! eq m!$Address$!);
}
}
my $stub =$1;
return $stub;
}
}
Displaying the log hits will show
HOME with the correct link, GALLERY with the correct url link, but https://www.mywebsite.com/cart/item.html?itemID=83&cat=26
will display a random name instead of what it should be, Island Life for this page.. it has the correct link,-- a different name displays every time the page is loaded.
And, the output for all pages with query strings will display the exact same name. I know the links are correct by clicking thru site pages and checking the log script for my own page visits.
I tried -
while (my($mykey, $Value) = each %LocalAddressTitlePairs) {
return "<a title=\"$mykey\" href=\"$_\">$Value</a>" if(m!$_$! eq m!$mykey$!);
but again, the link is correct but the mykey/Value associated is random too. Way too new to perl to figure this out but I'm doing a lot of online research.
m!$Address$! does not work as expected, because the expression contains special characters such as ?
You need to add escape sequences \Q and \E
m!\Q$Address\E$!
it’s even better to add a check at the beginning of the line, otherwise
my $url = "https://www.mywebsite.com/?foo=bar"
my $bad_url = "https://bad.com?u=https://www.mywebsite.com/?foo=bar"
$bad_url =~ m!\Q$url\E$! ? 1 : 0 # 1, pass
$bad_url =~ m!^\Q$url\E$! ? 1 : 0 # 0, fail
I need help regarding handling of Perl variables. Here I am getting input as a hash. I now need to send this hash variable to another subroutine. How can pass data as an argument to another subroutine? The code below shows how I am approaching this:
if ($csData->{'CUSTOMER_INVOICE_DETAILS'})
{
$c->log->debug("API Response:". Dumper $csData->{'CUSTOMER_INVOICE_DETAILS'});
my $Charges = [];
my #customerCharges = $csData->{'CUSTOMER_INVOICE_DETAILS'};
foreach(#customerCharges)
{
my ($customername,$customeramount) = split /:/;
my $charge_hash = ({
customername => $customername,
customeramount => $customeramount
});
push(#$Charges, $charge_hash);
}
my #ReturnCharges = $self->API->get_customer_charges($Charges, $Customer->customerid, $params->{'invoiceid'});
The other subroutine where this data is being received is as follows:
sub get_customer_charges
{
my $self = shift;
my ($charge, $CustomerId, $INID) = #_;
my $http_request = {
action => 'GetTariff',
customerid => $CustomerId,
csid => $INID,
};
my $markups = $self->APIRequest($http_request);
###Charge Level ID Inserting As 10
my #ChargeLevels;
my #BaseLevelID;
foreach my $ch (#$charge)
{
my ($customername,$customeramount) = split(':', $ch->{'customername'}, $ch->{'customername'});
my $chargelevel = join(':', $ch->{'customername'}, $ch->{'customeramount'}, '10');
push(#BaseLevelID, $chargelevel);
}
push(#ChargeLevels, #BaseLevelID);
return #ChargeLevels;
}
When I print to the server log for CUSTOMER_INVOICE_DETAILS variable I am getting the following values:
API Response:$VAR1 = {
'Product' => '34.04',
'basetax' => '2.38',
'vattax' => '4.36'
};
After sending data to second subroutine the data coming in server log for second subroutine variable is as following:
Charges in API:$VAR1 = 'HASH(0xb75d6d8)::10';
Can anyone help how could I send the hash data from one subroutine to another?
Given your comments and that your source is:
API Response:$VAR1 = {
'Product' => '34.04',
'basetax' => '2.38',
'vattax' => '4.36'
};
And you're looking for:
API Response:$VAR1 = { 34.04:2.38:4.36:10 };
(and somehow you're getting:
Charges in API:$VAR1 = 'HASH(0xb75d6d8)::10';
This suggests this may be as simple as using the values system call. values extracts an array of all the values in the hash. Something like this (guessing a bit on which part of your code needs it).
my #list_of_values = values ( %{$csData->{'CUSTOMER_INVOICE_DETAILS'}} );
You say you want to "convert" a hash to an array, but your issue seems more complex and subtle so simple conversion is not likely what will solve your problem. Something in your subroutine is returning a hash reference when the rest of your code does not expect it to do so. If the data-structure you are passing contains the correct information but not in the form you expect, then you can either change the code to produce it in the expected form (e.g. to return an ARRAY) or change your subroutine so that it is able to handle the data that it is passed correctly.
As for "converting a hash" per se, if your data structure doesn't contain complex nested references and all you want to do is "convert" your hash to an array or list, then you can simply assign the hash to an array. Perhaps I'm not understanding your question but if this kind of simple "flattening" is all you want then you could try:
my $customer_purchase = {
'Product' => '34.04',
'basetax' => '2.38',
'vattax' => '4.36'
};
my #flat_customer_purchase = %{ $customer_purchase };
say "#flat_customer_purchase" ;
Output:
basetax 2.38 Product 34.04 vattax 4.36
You can then supply the hash data as the "array" to the second subroutine. e.g. treat #flat_customer_purchase as a list:
use List::AllUtils ':all';
say join " ", pairkeys #flat_customer_purchase
# basetax Product vattax
say join " ", pairvalues #flat_customer_purchase
# 2.38 34.04 4.36
etc.
NB: this assumes that for some reason you must pass an array. The example of running the pairvalues routine simply replicates #Sobrique's suggestion to use values directly on the hash you are passing but in my answer this grabs the values pairs from the array instead of the hash.
My sense is that there is more to the question. If API Response is a more complicated hash/object or, if for some other reason this basic perl doesn't work, then you will have to supply more information. You need to find out where your unexpected hash reference is coming from before you can decide how to handle it. You might find this SO discussion helpful:
Are Perl subroutines call-by-reference or call-by-value?
I am trying to piece together other scripts i have seen to be able to loop through a list of users on the channel.
Here is what i have come up with
my $channel = #_;
foreach my $nick ($channel->nicks()) {
$server->command("msg $chatchannel $nick->{nick}");
}
But all i get from that is
Can't call method "nicks" without a package or object reference at
/root/.irssi/scripts/test.pl line 64.
which is referring to
$channel->nicks()
Am i going about this the wrong way? or should this be working? I have seen many other scripts using $channel->nicks() so i know it must work?
Edit
I should also mention that this is already define further up in the code
my ($server, $msg, $target, $channel, $chatnet) = #_;
But when i try it with that $channel variable i get
Can't locate object method "nicks" via package
"mattigins#mattigins.tmi.twitch.tv" (perhaps you forgot to load
"mattigins#mattigins.tmi.twitch.tv"?) at /root/.irssi/scripts/test.pl
line 64.
Since the left hand side (LHS) of my $channel = #_; is a scalar it imposes scalar context on the #_ array. This means that the length of the array gets assigned to $channel. You want to assign with my ($channel) = #_; so that the LHS is in list context and that the first element in the #_ array gets assigned to your scalar.
Ref:
What is the difference between the scalar and list contexts in Perl?
Scalar and List context in Perl
I figured out how to do it.
$chan = $server->channel_find('#channel');
foreach my $nick ($chan->nicks()) {
$nickname = $nick->{nick};
}
The NextRelease plugin for Dist::Zilla looks for {{$NEXT}} in the Changes file to put the release datetime information. However, I can't get this to be generated using my profile.ini. Here's what I have:
[GenerateFile / Generate-Changes ]
filename = Changes
is_template = 1
content = Revision history for {{$dist->name}}
content =
;todo: how can we get this to print correctly with a template?
content = {{$NEXT}}
content = initial release
{{$dist->name}} is correctly replaced with my distribution name, but {{$NEXT}} is, as-is, replaced with nothing (since it's not escaped and there is no $NEXT variable in). I've tried different combinations of slashes to escape the braces, but it either results in nothing or an error during generation with dzil new. How can I properly escape this string so that after dzil processes it with Text::Template it outputs {{$NEXT}}?
In the content, {{$NEXT}} is being interpreted as a template block and, as you say, wants to fill itself in as the contents of the missing $NEXT.
Instead, try:
content = {{'{{$NEXT}}'}}
Example program:
use 5.14.0;
use Text::Template 'fill_in_string';
my $result = fill_in_string(
q<{{'{{$NEXT}}'}}>,
DELIMITERS => [ '{{', '}}' ],
BROKEN => sub { die },
);
say $result;
Given a CODE ref, is it possible to:
Access the parse tree of that CODE ref
Create a new CODE ref by specifying the parse tree of the CODE ref which can contain elements of the parse tree returned in 1
Normally we create subroutines in perl by specifying source code which is then parsed and converted into a parse tree.
I would like to write a perl function which can create a subroutine by specifying its parse tree, and that parse tree could be derived from another parse tree of some other subroutine.
Possible?
I don't know the full answer to your question, but I know that Data::Dumper can deparse a code reference. Looking at its documentation, I see that it uses B::Deparse to do the heavy lifting (the B:: modules are the ones that interact with the compiler). Unfortunately it seems that this only results in a textual representation of the coderef.
Instead I searched for Op on metacpan and got many more interesting possibilities. Since I am now far out of my depth in the deepest Perl magic, I will leave it to you to look over those results. Perhaps something will be useful.
This has nothing to do with opcodes, but it does enclose the same two variables in three different closures. The variables are enclosed within subroutines reminiscent of class get/set routines, and those closed vars are then shared by other closures via their access routine.
This is a response to the comment: I'm sure it will be necessary to access the underlying nodes in the parse tree so that I can create new closures which are closed over the same variables.
use strict;
use warnings;
use v5.14;
# create closed vars
my $v1 = access_closure(6);
my $v2 = access_closure(42);
# play with them
say "v1 ", &$v1;
say "v2 ", &$v2;
say "v1 ", &$v1(5);
say "v2 ", &$v2(43);
say "v1 ", &$v1;
say "v2 ", &$v2;
# create silly closures that use them
my $test1 = test_closure(2);
my $test2 = test_closure(17);
my $test3 = test_closure(50);
# play with those
&$test1;
&$test2;
&$test3;
# create the get/set routine for a closed var
sub access_closure {
my $val = shift;
return sub {
$val = shift if #_;
return $val;
}
}
# create a silly closure that encloses a control var and uses the two other vars
sub test_closure {
my $val = shift;
return sub {
say "\nval is $val";
printf "v1 is %2d, v2 is %2d\n",
&$v1, &$v2;
if (&$v1 < $val) {
say "Increment v1";
&$v1(&$v1+1);
}
if (&$v2 > $val) {
say "Decrement v2";
&$v2(&$v2-1);
}
printf "v1 is %2d, v2 is %2d\n",
&$v1, &$v2;
}
}