How can I add/overwrite the title and author metadata of a PDF using CAM::PDF?
I'm the author of CAM::PDF. The library doesn't support this sort of edit, but you can do it by digging into the internals like this:
#!perl -w
use strict;
use CAM::PDF;
my $infile = shift || die 'syntax...';
my $outfile = shift || die 'syntax...';
my $pdf = CAM::PDF->new($infile) || die;
my $info = $pdf->getValue($pdf->{trailer}->{Info});
if ($info) {
#use Data::Dumper; print Dumper($info);
my $title = $info->{Title};
if ($title) {
$title->{value} = 'Foo';
# for a proper implementation, we should mark the holder of $info as dirty...
# But cleanoutput ignores dirty flags anyway and writes the whole doc
$pdf->cleanoutput($outfile);
}
}
Related
Currently I am using the following code to allow a user to upload an image via a html form. It creates a copy of the image which I then read in to ImageMagick. But of course it would be way better to simply read the data from the form straight into the ImageMagick object. But I have not been able to achieve that.
use Image::Magick;
use MIME::Base64;
$arg = new CGI;
$fetch_photo = param('fileuploadphoto');
($data, $base64) = split /,/, $fetch_photo;
($type) = $data =~ m!data:image/(\w+);base64!;
$decoded = MIME::Base64::decode_base64($base64);
$filename = 'test.jpg';
open(my $file, '>', "$filename") or die "Error cannot open file: $file";
binmode $file;
print $file $decoded;
close($file);
$image = Image::Magick->new;
$image->Read($filename);
Thanks to Håkon Hægland for the answer. This works perfectly.
use Image::Magick;
use MIME::Base64;
$fetch_photo = param('fileuploadphoto');
($data, $base64) = split /,/, $fetch_photo;
$decoded = MIME::Base64::decode_base64($base64);
$image = Image::Magick->new;
$image->Read(blob => $decoded);
I have a CSV file like this:
id,item,itemtype,date,service,level,message,action,user
"344","-1","IRM","2008-08-22 13:01:57","login","1","Failed login: \'irm\', database \'irmD\'",NULL,NULL
"346","-1","IRM","2008-08-27 10:58:59","login","1","Ошибка входа:\'\', база данных \'irmD\'",NULL,NULL
It's Okay with the second line, but Text::CSV just skips the third one. The third line consists Cyrillic characters, but the file is encoded in UTF-8 and Perl shouldn't have any problems with that.
And the code:
#!/usr/bin/perl
use warnings;
use strict;
use Text::CSV;
use utf8;
my $file = 'Test.csv'; my $csv = Text::CSV->new();
open (CSV, "<", $file) or die $!;
while (<CSV>) {
if ($csv->parse($_)) {
if ($. == 1) {
next;
}
my #columns = $csv->fields();
my $id=$columns[0];
print $id." ";
}
}
print "\n";
close CSV;
Any help or hint will be appreciated.
Did you read the documentation of Text::CSV?
If your
data contains newlines embedded in fields, or characters above 0x7e
(tilde), or binary data, you must set "binary => 1"
Also, use utf8 tells Perl you're going to use UTF-8 in the source code, not in the data. Remove it.
Using <> to read in CSV is also mentioned in the documentation:
while (<>) { # WRONG!
Here is a working version:
#!/usr/bin/perl
use warnings;
use strict;
use Text::CSV;
my $file = 'Test.csv';
my $csv = 'Text::CSV'->new({ binary => 1 }) or die 'Text::CSV'->error_diag;
open my $CSV, '<', $file or die $!;
while (my $line = $csv->getline($CSV)) {
next if 1 == $.;
my #columns = #$line;
my $id = $columns[0];
print $id . " ";
}
print "\n";
close $CSV;
I think your problem will be, that whilst you've useed UTF8, that's only really for perl's uses.
From:
http://perldoc.perl.org/utf8.html
utf8 - Perl pragma to enable/disable UTF-8 (or UTF-EBCDIC) in source code
Looking at Text::CSV
You probably want:
$csv = Text::CSV::Encoded->new ({ encoding => "utf8" });
You will also - probably - need to specify that you're opening a UTF-8 file. You can either do this as part of the open or with binmode
open ( my $filehandle, "<:encoding(UTF-8)", "Test.csv" );
Im using LWP to download an executable file type and with the response in memory, i am able to hash the file. However how can i save this file on my system? I think i'm on the wrong track with what i'm trying below. The download is successful as i am able to generate the hash correctly (I've double checked it by downloading the actual file and comparing the hashes).
use strict;
use warnings;
use LWP::Useragent;
use Digest::MD5 qw( md5_hex );
use Digest::MD5::File qw( file_md5_hex );
use File::Fetch;
my $url = 'http://www.karenware.com/progs/pthasher-setup.exe';
my $filename = $url;
$filename =~ m/.*\/(.*)$/;
$filename = $1;
my $dir ='/download/two';
print "$filename\n";
my $ua = LWP::UserAgent->new();
my $response = $ua->get($url);
die $response->status_line if !$response->is_success;
my $file = $response->decoded_content( charset => 'none' );
my $md5_hex = md5_hex($file);
print "$md5_hex\n";
my $save = "Downloaded/$filename";
unless(open SAVE, '>>'.$save) {
die "\nCannot create save file '$save'\n";
}
print SAVE $file;
close SAVE;
If you are wondering why do i not instead download everything then parse the folder for each file and hash, its because im downloading all these files in a loop. And during each loop, i upload the relevant source URL (where this file was found) , along with the file name and hash into a database at one go.
Try getstore() from LWP::Simple
use strict;
use warnings;
use LWP::Simple qw(getstore);
use LWP::UserAgent;
use Digest::MD5 qw( md5_hex );
use Digest::MD5::File qw( file_md5_hex );
use File::Fetch;
my $url = 'http://www.karenware.com/progs/pthasher-setup.exe';
my $filename = $url;
$filename =~ m/.*\/(.*)$/;
$filename = $1;
my $dir ='/download/two';
print "$filename\n";
my $ua = LWP::UserAgent->new();
my $response = $ua->get($url);
die $response->status_line if !$response->is_success;
my $file = $response->decoded_content( charset => 'none' );
my $md5_hex = md5_hex($file);
print "$md5_hex\n";
my $save = "Downloaded/$filename";
getstore($url,$save);
getstore is an excellent solution, however for anyone else reading this response in a slightly different setup, it may not solve the issue.
First of all, you could quite possibly just be suffering from a binary/text issue.
I'd change
my $save = "Downloaded/$filename";
unless(open SAVE, '>>'.$save) {
die "\nCannot create save file '$save'\n";
}
print SAVE $file;
close SAVE;
to
my $save = "Downloaded/$filename";
open my $fh, '>>', $save or die "\nCannot create save file '$save' because $!\n";
# on platforms where this matters
# (like Windows) this is needed for
# 'binary' files:
binmode $fh;
print $fh $file;
close $fh;
The reason I like this better is that if you have set or acquired some settings on your browser object ($ua), they are ignored in LWP::Simple's getstore, as it uses its own browser.
Also, it uses the three parameter version of open which should be safer.
Another solution would be to use the callback method and store the file while you are downloading it, if for example you are dealing with a large file. The hashing algorithm would have to be changed so it is probably not relevant here but here's a sample:
my $req = HTTP::Request->new(GET => $uri);
open(my $fh, '>', $filename) or die "Could not write to '$filename': $!";
binmode $fh;
$res = $ua->request($req, sub {
my ($data, $response, $protocol) = #_;
print $fh $data;
});
close $fh;
And if the size is unimportant (and the hashing is done some other way) you could just ask your browser to store it directly:
my $req = HTTP::Request->new(GET => $uri);
$res = $ua->request($req, $filename);
Well.. I'm stuck again. I've read up quite a few topic with similar problems but not finding a solution for mine. I have a ; delimited csv file and the strings at the 8th column ($elements[7]) is as following: "aaaa;bb;cccc;ddddd;eeee;fffff;gg;". What i'm trying is to split the string based on ; and capture the outputs to variables. Then use those variables in the main csv file in their own column.
So now the file is like:
3d;2f;7j;8k;4s;2b;5g;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";4g;1a;5g;2g;7h;3d;2f;7j
3c;9k;5l;4g;1a;5g;3d;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";4g;1a;5g;2g;7h;3d;2f;7j
4g;1a;5g;2g;7h;3d;8k;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";3d;2f;7j;8k;4s;2b;4g;1a
And i want it like:
3d;2f;7j;8k;4s;2b;5g;4g;1a;5g;2g;7h;3d;2f;7j;aaaa;bb;cccc;ddddd;eeee;fffff;gg
3c;9k;5l;4g;1a;5g;3d;4g;1a;5g;2g;7h;3d;2f;7j;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
4g;1a;5g;2g;7h;3d;8k;3d;2f;7j;8k;4s;2b;4g;1a;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
This is my code i've been trying it with. I know.. it's terrible! But i'm hoping someone can help me?
use strict;
use warnings;
my $inputfile = shift || die "Give files\n";
my $outputfile = shift || die "Give output\n";
open my $INFILE, '<', $inputfile or die "In use / Not found :$!\n";
open my $OUTFILE, '>', $outputfile or die "In use :$!\n";
while (<$INFILE>) {
s/"//g;
my #elements = split /;/, $_;
my ($varA, $varB, $varC, $varD, $varE, $varF, $varG, $varH) split (';', $elements[10]);
$elements[16] = $varA;
$elements[17] = $varB;
$elements[18] = $varC;
$elements[19] = $varD;
$elements[20] = $varE;
$elements[21] = $varF;
$elements[22] = $varG;
$elements[23] = $varH;
my $output_line = join(";", #elements);
print $OUTFILE $output_line;
}
close $INFILE;
close $OUTFILE;
exit 0;
I'm confused about the my statement as well, it shouldn't be possible right? I mean the $vars are in a closed part so it shouldn't be possible to write them to $elements?
EDIT
This is how i adjusted the code with TLP's suggestions:
use strict;
use warnings;
use Text::CSV;
my $inputfile = shift || die "Give files\n";
my $outputfile = shift || die "Give output\n";
open my $INFILE, '<', $inputfile or die "In use / Not found :$!\n";
open my $OUTFILE, '>', $outputfile or die "In use :$!\n";
my $csv = Text::CSV->new({ # create a csv object
sep_char => ";", # delimiter
eol => "\n", # adds newline to print
});
while (my $row = $csv->getline($INFILE)) { # $row is an array ref
my $line = splice(#$row, 10, 1); # remove 8th line
$csv->parse($line); # parse the line
push #$row, $csv->fields(); # push newly parsed fields onto main array
$csv->print($OUTFILE, $row);
}
close $INFILE;
close $OUTFILE;
exit 0;
You should use a CSV module, e.g. Text::CSV to parse your data. Here's a brief example on how it can be done. You can replace the file handles I used below with your own.
use strict;
use warnings;
use Text::CSV;
my $csv = Text::CSV->new({ # create a csv object
sep_char => ";", # delimiter
eol => "\n", # adds newline to print
});
while (my $row = $csv->getline(*DATA)) { # $row is an array ref
my $line = splice(#$row, 7, 1); # remove 8th line
$csv->parse($line); # parse the line
push #$row, $csv->fields(); # push newly parsed fields onto main array
$csv->print(*STDOUT, $row);
}
__DATA__
3d;2f;7j;8k;4s;2b;5g;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";4g;1a;5g;2g;7h;3d;2f;7j
3c;9k;5l;4g;1a;5g;3d;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";4g;1a;5g;2g;7h;3d;2f;7j
4g;1a;5g;2g;7h;3d;8k;"aaaa;bb;cccc;ddddd;eeee;fffff;gg;";3d;2f;7j;8k;4s;2b;4g;1a
Output:
3d;2f;7j;8k;4s;2b;5g;4g;1a;5g;2g;7h;3d;2f;7j;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
3c;9k;5l;4g;1a;5g;3d;4g;1a;5g;2g;7h;3d;2f;7j;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
4g;1a;5g;2g;7h;3d;8k;3d;2f;7j;8k;4s;2b;4g;1a;aaaa;bb;cccc;ddddd;eeee;fffff;gg;
I want a Perl module that reads from the special file handle, <STDIN>, and passes this to a subroutine. You will understand what I mean when you see my code.
Here is how it was before:
#!/usr/bin/perl
use strict; use warnings;
use lib '/usr/local/custom_pm'
package Read_FH
sub read_file {
my ($filein) = #_;
open FILEIN, $filein or die "could not open $filein for read\n";
# reads each line of the file text one by one
while(<FILEIN>){
# do something
}
close FILEIN;
Right now the subroutine takes a file name (stored in $filein) as an argument, opens the file with a file handle, and reads each line of the file one by one using the fine handle.
Instead, I want get the file name from <STDIN>, store it inside a variable, then pass this variable into a subroutine as an argument.
From the main program:
$file = <STDIN>;
$variable = read_file($file);
The subroutine for the module is below:
#!/usr/bin/perl
use strict; use warnings;
use lib '/usr/local/custom_pm'
package Read_FH
# subroutine that parses the file
sub read_file {
my ($file)= #_;
# !!! Should I open $file here with a file handle? !!!!
# read each line of the file
while($file){
# do something
}
Does anyone know how I can do this? I appreciate any suggestions.
It is a good idea in general to use lexical filehandlers. That is a lexical variable containing the file handler instead of a bareword.
You can pass it around like any other variables. If you use read_file from File::Slurp you do not need a seperate file handler, it slurps the content into a variable.
As it is also good practice to close opened file handles as soon as possible this should be the preferred way if you realy only need to get the complete file content.
With File::Slurp:
use strict;
use warnings;
use autodie;
use File::Slurp;
sub my_slurp {
my ($fname) = #_;
my $content = read_file($fname);
print $content; # or do something else with $content
return 1;
}
my $filename = <STDIN>;
my_slurp($filename);
exit 0;
Without extra modules:
use strict;
use warnings;
use autodie;
sub my_handle {
my ($handle) = #_;
my $content = '';
## slurp mode
{
local $/;
$content = <$handle>
}
## or line wise
#while (my $line = <$handle>){
# $content .= $line;
#}
print $content; # or do something else with $content
return 1;
}
my $filename = <STDIN>;
open my $fh, '<', $filename;
my_handle($fh); # pass the handle around
close $fh;
exit 0;
I agree with #mugen kenichi, his solution is a better way to do it than building your own. It's often a good idea to use stuff the community has tested. Anyway, here are the changes you can make to your own program to make it do what you want.
#/usr/bin/perl
use strict; use warnings;
package Read_FH;
sub read_file {
my $filein = <STDIN>;
chomp $filein; # Remove the newline at the end
open my $fh, '<', $filein or die "could not open $filein for read\n";
# reads each line of the file text one by one
my $content = '';
while (<$fh>) {
# do something
$content .= $_;
}
close $fh;
return $content;
}
# This part only for illustration
package main;
print Read_FH::read_file();
If I run it, it looks like this:
simbabque#geektour:~/scratch$ cat test
this is a
testfile
with blank lines.
simbabque#geektour:~/scratch$ perl test.pl
test
this is a
testfile
with blank lines.