Ignore certain matches in preg_replace - preg-replace

Please find php string below :
$string = 'hi this is testing [ok i can remove it] and
then [ok i can remove it too] and then I want to spare [caption .... ]';
I want to remvoe [ok i can remove it] and [ok i can remove it too] but I want to retain [caption .... ] in the string using preg_replace.
Current I am using following which is removing all with [ ]
$return = preg_replace( array('~\[.*]~'), '', $b );
kindly guide.

For this kind of job, I'd use preg_replace_callback like this:
$string = 'hi this is testing [ok i can remove it] and then [ok i can remove it too] and then I want to spare [caption .... ]';
$return = preg_replace_callback(
'~\[[^\]]*\]~',
function($m) {
if (preg_match('/\bcaption\b/', $m[0]))
return $m[0];
else
return '';
},
$string);
echo $return,"\n";
Output:
hi this is testing and then and then I want to spare [caption .... ]

Related

inserting new line with OpenOffice::OODoc

I am having quite the issue creating a new line with this module and feel like I am just missing something.
my perl code looks like this:
use OpenOffice::OODoc;
my $name = "foo <br> bar";
$name=~s/<br>/\n/g;
my $outdir = "template.odt";
my $doc = ooDocument(file => $outdir);
my #pars = $doc->getParagraphList();
for my $p (#pars)
{
$doc->substituteText($p,'{TODAY}',$date);
$doc->substituteText($p,'{NAME}',$name);
...
Problem is when I open it in word or open office I have no newlines. Although if it open it in a text edit I have my new lines.. Any ideas of how to fix this?
Ok I figured it out, hopefully this will save someone hours of searching for the same thing. I added:
use Encode qw(encode);
ooLocalEncoding('utf8');
my $linebreak = encode('utf-8', "\x{2028}");
$doc->substituteText($p,'<br>', $linebreak);
So my final code looks like this:
use OpenOffice::OODoc;
use Encode qw(encode);
ooLocalEncoding('utf8');
my $linebreak = encode('utf-8', "\x{2028}");
my $outdir = "template.odt";
my $name = "foo <br> bar";
my $outdir = "template.odt";
my $doc = ooDocument(file => $outdir);
my #pars = $doc->getParagraphList();
for my $p (#pars)
{
$doc->substituteText($p,'{TODAY}',$date);
$doc->substituteText($p,'{NAME}',$name);
$doc->substituteText($p,'<br>', $linebreak);
...
Maybe not the best way to do things but it worked!
You could try and insert and empty para after the current one:
If the 'text' option is empty, calling this method is the equivalent
of adding a line feed.
This sequence (in a text document) inserts a linefeed immediately after paragraph 4. Replace 4 with current position.
$doc->insertElement
(
'//text:p', 4, 'text:p',
position => 'after',
text => '',
);

URI::Fetch failing when par-packed

I have a program which brings in a page for a book using HTML::TagParser and the book's barcode, grabs a certain span, repeats it for a different page, and then adds it to a TK::MListbox until chosen to export it. This works perfectly fine in Eclipse. However, once made an .exe with par-packer, the program fails to work. The error when using barcode 31412007436751 is this:
Tk::Error: URI::Fetch failed: https://i-share.carli.illinois.edu/uis/cgi-bin/shelflister.cgi?search=s1&bcs=31412007436751&bce=&stpt=1&mode=1 at script/ShelfLister_Lister.pl line 32.
Carp::croak at C:/strawberry/perl/lib/Carp.pm line 100
HTML::TagParser::fetch at HTML/TagParser.pm line 261
HTML::TagParser::new at HTML/TagParser.pm line 239
main::addBook at script/ShelfLister_Lister.pl line 32
<Key-Return>
(command bound to event)
The related program code is this:
#!/user/bin/perl
use strict;
use warnings;
use Tk;
use Tk::MListbox;
use LWP::Simple;
use URI::Fetch;
use Encode::Byte;
use HTTP::Response;
use HTML::TagParser;
use Spreadsheet::WriteExcel;
my ($callNumber, $title, $html, $numItems);
my $savetypes = [['Excel Files', '.xls'], ['Comma-Separated Files', '.csv'], ['Text Files', '.txt']];
my $mw = new MainWindow;
$mw->title("Barcode Lister");
$mw->Label(-text=>'Choose Books')->grid(-row=>1, -column=>1, -columnspan=>2, -pady=>10);
my $barcode = $mw->Entry(-width=>50)->grid(-row=>2, -column=>1, -pady=>5, -padx=>[5, 10]);
my $add = $mw->Button(-text=>'Add Record', -command=>\&addBook, -width=>15)->grid(-row=>2, -column=>2, -pady=>5);
my $listFrame = $mw->Frame(-bd=>2, -relief=>"sunken")->grid(-row=>3, -column=>1, -padx=>[5, 10], -pady=>5);
my $list = $listFrame->Scrolled(qw(MListbox -background white -scrollbars oe))->pack(-expand=>1, -fill=>"both");
$list->columnInsert('end', -text=>"Call number", -width=>23);
$list->columnInsert('end', -text=>"Title", -width=>25);
my $delete = $mw->Button(-text=>'Delete Record', -command=>\&removeBook, -width=>15)->grid(-row=>3, -column=>2, -pady=>5);
my $export = $mw->Button(-text=>'Export List', -command=>\&exportList, -width=>15)->grid(-row=>4, -column=>1, -columnspan=>2, -pady=>5);
$barcode->bind('<Return>'=>\&addBook);
$barcode->focus;
MainLoop;
sub addBook{
$html = HTML::TagParser->new('https://i-share.carli.illinois.edu/uis/cgi-bin/shelflister.cgi?search=s1&bcs=' . $barcode->get() . '&bce=&stpt=1&mode=1');
$title = $html->getElementsByClassName('listLine');
if (ref $title){
$html = HTML::TagParser->new('https://i-share.carli.illinois.edu/uis/cgi-bin/shelflister.cgi?search=s1&bcs=' . $barcode->get() . '&bce=&stpt=1&mode=2');
$list->insert("end", [$title->innerText(), $html->getElementsByClassName('listLine')->innerText()]);
$barcode->delete(0, 'end');
}
else{
$mw->messageBox(-title=>'Error', -message=>"Barcode not found.", -type=>'Ok', -icon=>'error', -default=>'ok');
}
}
Anyone have any ideas on how I could get this to work as an .exe?
Probably URI::Fetch->errstr would give more information on the failure. Either try to patch HTML::TagParser (see https://rt.cpan.org/Ticket/Display.html?id=86698) or maybe it's possible to wrap your HTML::TagParser-related code lines into an eval { } and call the errstr function yourself on errors.

perl can't use string as an array ref

I have 4 apps. let's call them: App1, App2, App3 and App4.
for each of these apps I have an array: for example:
my #App1_links = (...some data...);
my #App2_links = (...some data...);
my #App3_links = (...some data...);
my #App4_links = (...some data...);
Now I have a loop in my code that goes thru these 4 apps and I intend to do something like this:
my $link_name = $app_name . "_links";
where $app_name will be App1, App2 etc...
and then use it as : #$link_name
Now this code does what I intend to do when I don't use: use strict but not otherwise
The error is: Can't use string ("App1_links") as an ARRAY ref while "strict refs" in use at code.pm line 123.
How can I achieve this functionality using use strict.
Please help.
You are using $link_name as a symbolic reference which is not allowed under use strict 'refs'.
Try using a hash instead, e.g.
my %map = (
App1 => \#App1_links,
...
);
my $link_name = $map{$app_name};
As I say elsewhere, when you find yourself adding an integer suffix to variable names, think "I should have used an array".
my #AppLinks = (
\#App1_links,
\#App2_links,
\#App3_links,
# ...
);
for my $app ( #AppLinks ) {
for my $link ( #$app ) {
# loop over links for each app
}
}
or
for my $i ( 0 .. $#AppLinks ) {
printf "App%d_links\n", $i + 1;
for my $link ( #{ $AppLinks[$i] } ) {
# loop over links for each app
}
}

Perl - How to get the email address from the FROM part of header?

I am trying to set up this script for my local bands newsletter.
Currently, someone sends an email with a request to be added, we manually add it to newsletter mailer I set up.
(Which works great thanks to help I found here!)
The intent now is to have my script below log into the email account I set up for the list on our server, grab the info to add the email automatically.
I know there are a bunch of apps that do this but, I want to learn myself.
I already have the "add to list" working when there is an email address returned from the header(from) below BUT, sometimes the header(from) is a name and not the email address (eg "persons name" is returned from persons name<email#address> but, not the <email#address>.)
Now, I am not set in stone on the below method but, it works famously... to a point.
I read all the docs on these modules and there was nothing I could find to get the darn email in there all the time.
Can someone help me here? Verbose examples are greatly appreciated since I am struggling learning Perl.
#!/usr/bin/perl -w
##########
use CGI;
use Net::IMAP::Simple;
use Email::Simple;
use IO::Socket::SSL; #optional i think if no ssl is needed
use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
######################################################
# fill in your details here
my $username = '#########';
my $password = '#############';
my $mailhost = '##############';
#######################################################
print CGI::header();
# Connect
my $imap = Net::IMAP::Simple->new($mailhost, port=> 143, use_ssl => 0, ) || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
# Log in
if ( !$imap->login( $username, $password ) ) {
print STDERR "Login failed: " . $imap->errstr . "\n";
exit(64);
}
# Look in the INBOX
my $nm = $imap->select('INBOX');
# How many messages are there?
my ($unseen, $recent, $num_messages) = $imap->status();
print "unseen: $unseen, <br />recent: $recent, <br />total: $num_messages<br />\n\n";
## Iterate through unseen messages
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
if ( $imap->seen($i) ) {
my $es = Email::Simple->new( join '', #{ $imap->top($i) } );
printf( "[%03d] %s\n\t%s\n", $i, $es->header('From'), $es->header('Subject'));
print "<br />";
next;
}## in the long version these are pushed into different arrays for experimenting purposes
else {
my $es = Email::Simple->new( join '', #{ $imap->top($i) } );
printf( "[%03d] %s\n\t%s\n", $i, $es->header('From'), $es->header('Subject'));
print "<br />";
}
}
# Disconnect
$imap->quit;
exit;
use Email::Address;
my #addresses = Email::Address->parse('persons name <email#address>');
print $addresses[0]->address;
The parse method returns an array, so the above way works for me.
I'm making this a separate answer because even though this information is hidden in the comments of the accepted answer, it took me all day to figure that out.
First you need to get the From header using something like Email::Simple. THEN you need to extract the address portion with Email::Address.
use Email::Simple;
use Email::Address;
my $email = Email::Simple->new($input);
my $from = $email->header('From');
my #addrs = Email::Address->parse($from);
my $from_address = $addrs[0]->address; # finally, the naked From address.
Those 4 steps in that order.
The final step is made confusing by the fact that Email::Address uses some voodoo where if you print the parts that Email::Address->parse returns, they will look like simple strings, but they are actually objects. For example if you print the result of Email::Address->parse like so,
my #addrs = Email::Address->parse($from);
foreach my $addr (#addrs) { say $addr; }
You will get the complete address as output:
"Some Name" <address#example.com>
This was highly confusing when working on this. Granted, I caused the confusion by printing the results in the first place, but I do that out of habit when debugging.

SugarCRM: Create NOTE with Attachment without SOAP?

I've got this custom button on Lead Editview that when clicked on generates (via AJAX) an invoice number and a PDF bearing the same number.
In the next step, the routine uses SOAP to loopback to Sugar and creates a Note (along with the PDF as attachment).
My question is can I avoid this SOAP call and use some other internal mechanism / classes to do the same? Something along the lines of
$invoice = new Note();
$invoice->create(....);
...
Is this possible? I couldn't find any documentation anywhere... all roads seem to point to SOAP.
If your Ajax call is performing a db update/save operation, then you could look into using a after_save logic hook.
EDIT: for eg: you could try out this code, have a look at the code in <sugar_root>/modules/Notes/Note.php
$note = new Note();
$note->modified_user_id = $current_user->id;
$note->created_by = $current_user->id;
$note->name = 'New';
$note->parent_type = "Accounts";
$note->parent_id = $bean->parent_id;
$note->description = $bean->description;
$note->save();
As far as attachment goes, it's a bit tricky. Sugar expects the attachment to be a upload_file object. Have a look at the code in <sugar_root>/modules/Notes/controller.php the function action_save() and <sugar_root>/include/upload_file.php
HACK: this is not the correct way but it works. With a slight modification to the code above and cunning use of the move function , you could make the attachment work. Sugar stores the attachments in cache/upload folder with the ID of the note created.
$note->filename = "Yourfilename.txt" //your file name goes here
$note->file_mime_type = "text/plain" // your file's mime type goes here
$new_note_id = $note->save();
move(your_file_location, cache/upload/$new_note_id)
//don't add a extension to cache/upload/$new_note_id
HTH
P.S: untested code
Do this on controller.php
foreach ( $_FILES as $file ) {
for ( $i = 0 ; $i < count( $file[ 'name' ] ) ; $i++ ) {
$fileData = file_get_contents( $file[ 'tmp_name' ][ $i ] );
$fileTmpLocation = $file[ 'tmp_name' ][ $i ];
$fileMimeType = mime_content_type( $file[$i] );
$fileInfo = array( 'name' => $file[ 'name' ][ $i ], 'data' => $fileData, 'tmpLocation' =>$fileTmpLocation, 'mimeType' => $fileMimeType );
array_push( $files, $fileInfo );
}
}
$this->guardarNotas($this->bean->id,$files);
}
And this is the function to save Notes with attachment:
private function guardarNotas($case_id,$files){
foreach($files as $file){
$noteBean = BeanFactory::newBean('Notes');
$noteBean->name = $file['name'];
$noteBean->parent_type = "Cases";
$noteBean->parent_id = $case_id;
$noteBean->filename = $file["name"];
$noteBean->file_mime_type = $file["mimeType"];
$noteBean->save();
move_uploaded_file($file["tmpLocation"], "upload/".$noteBean->id);
}
}