String replace &amp with & in Perl - perl

I have a script(Perl) which is taking a string from database through a variable and writing to a xml file. if the string contain "&" then while opening xml file it is giving parser error want to replace "&" with &amp through Perl script.
This is what I have tried
foreach my $ActiveLinkInfo ( #ActiveLinkInfos ) {
my ( $SubCID, $Subf, $Subt, $Subclosed, $SubCName ) = (
$ActiveLinkInfo->{'SubCID'},
$ActiveLinkInfo->{'Subf'},
$ActiveLinkInfo->{'Subt'},
$ActiveLinkInfo->{'Subclosed'},
$ActiveLinkInfo->{'SubCName'}
);
##$ActiveLinkInfo
if ( $Subf eq "HEADING" ) {
push( #menu, { "Name" => "$SubCName", "Dir" => "HEADING" } );
}
else {
my $res = GetChildren( "$path$SubCID\\", $SubCID, $VID );
$SubCName =~ s/ - .*//;
push( #menu, { "Name" => "$SubCName", "Dir" => "$SubCID/default.aspx" } );
}
}

If you're trying to convert text to HTML, use HTML::Entities.

You should take a look at the HTML::Escape module, which only translates in one direction -- from text to entities -- but does it very quickly

Related

Perl: Need a dynamic substitution in the variable string, and not during parsing

my #banks = #banksDup= ("abs", "qer", "qaz");
my $serverFailedabs;
my $serverFailedqer;
my $serverFailedqaz;
### Some processing of $serverFailedabs, $serverFailedqer and $serverFailedqaz happens here ###
foreach my $bank (#banks) {
if("$serverFailed${bank}" ne "") ## Line 85
{
print "$bank server setup failed;
#banksDup = grep !/${bank}/, #banksDup;
}
}
Error:
Global symbol "$serverFailed" requires explicit package name at perl1.pl line 85
Here, "$serverFailed${bank}" is being considered as $serverFailed in the parsing stage, and giving error. How can I avoid this issue?
I want that "$serverFailed${bank}" is executed during execution so that "$serverFailed${bank}" gets correct value
Use a hash.
my #banks = ( "abs", "qer", "qaz" );
my #banksDup = #banks;
my %serverFailed = (
abs => '',
qer => '',
qaz => '',
);
for my $bank ( #banks ) {
if ( $serverFailed{$bank} ne "" ) {
print "$bank server setup failed\n";
#banksDup = grep $_ ne $bank, #banksDup;
}
}

How to add multiple custom fields to a wp_query in a shortcode?

In a shortcode I can limit wp_query results by custom field values.
Example:
[my-shortcode meta_key=my-custom-field meta_value=100,200 meta_compare='IN']
And obviously it's possible to use multiple custom fields in a wp_query like WP_Query#Custom_Field_Parameters
But how can I use multiple custom fields in my shortcode? At the moment I do pass all the shortcode parameters with $atts.
On of a few different solutions might be to use a JSON encoded format for the meta values. Note that this isn't exactly user-friendly, but certainly would accomplish what you want.
You would of course need to generate the json encoded values first and ensure they are in the proper format. One way of doing that is just using PHP's built in functions:
// Set up your array of values, then json_encode them with PHP
$values = array(
array('key' => 'my_key',
'value' => 'my_value',
'operator' => 'IN'
),
array('key' => 'other_key',
'value' => 'other_value',
)
);
echo json_encode($values);
// outputs: [{"key":"my_key","value":"my_value","operator":"IN"},{"key":"other_key","value":"other_value"}]
Example usage in the shortcode:
[my-shortcode meta='[{"key":"my_key","value":"my_value","operator":"IN"},{"key":"other_key","value":"other_value"}]']
Which then you would parse out in your shortcode function, something like so:
function my_shortcode($atts ) {
$meta = $atts['meta'];
// decode it "quietly" so no errors thrown
$meta = #json_decode( $meta );
// check if $meta set in case it wasn't set or json encoded proper
if ( $meta && is_array( $meta ) ) {
foreach($meta AS $m) {
$key = $m->key;
$value = $m->value;
$op = ( ! empty($m->operator) ) ? $m->operator : '';
// put key, value, op into your meta query here....
}
}
}
Alternate Method
Another method would be to cause your shortcode to accept an arbitrary number of them, with matching numerical indexes, like so:
[my-shortcode meta-key1="my_key" meta-value1="my_value" meta-op1="IN
meta-key2="other_key" meta-value2="other_value"]
Then, in your shortcode function, "watch" for these values and glue them up yourself:
function my_shortcode( $atts ) {
foreach( $atts AS $name => $value ) {
if ( stripos($name, 'meta-key') === 0 ) {
$id = str_ireplace('meta-key', '', $name);
$key = $value;
$value = (isset($atts['meta-value' . $id])) ? $atts['meta-value' . $id] : '';
$op = (isset($atts['meta-op' . $id])) ? $atts['meta-op' . $id] : '';
// use $key, $value, and $op as needed in your meta query
}
}
}

Anti Sql injection Library C# Asp.NET

Can anyone suggest such library for Asp.NET 1.1 ?
Thanks.
There are many to choose from, but in all honesty, your best tool is education. Knowing how to prevent it yourself. The tools built into the normal Framework class library are perfectly adequate if used properly.
Simply using parameterized queries and/or stored procedures for every database call is your best prevention.
However, that said, we do use the Microsoft.Practices.EnterpriseLibrary.Data classes provided with the Microsoft Patterns and Practices library. The ones we use are a bit outdated, but still do the job nicely. They provide some injection protection and also simplify data access. But they are not the only, nor necessarily best tool for the job.
More up-to-date information about the current Patterns and Practices library can be found here.
Link to Anti-Injection SQL
<?PHP
FUNCTION anti_injection( $user, $pass ) {
// We'll first get rid of any special characters using a simple regex statement.
// After that, we'll get rid of any SQL command words using a string replacment.
$banlist = ARRAY (
"insert", "select", "update", "delete", "distinct", "having", "truncate", "replace",
"handler", "like", " as ", "or ", "procedure", "limit", "order by", "group by", "asc", "desc"
);
// ---------------------------------------------
IF ( EREGI ( "[a-zA-Z0-9]+", $user ) ) {
$user = TRIM ( STR_REPLACE ( $banlist, '', STRTOLOWER ( $user ) ) );
} ELSE {
$user = NULL;
}
// ---------------------------------------------
// Now to make sure the given password is an alphanumerical string
// devoid of any special characters. strtolower() is being used
// because unfortunately, str_ireplace() only works with PHP5.
IF ( EREGI ( "[a-zA-Z0-9]+", $pass ) ) {
$pass = TRIM ( STR_REPLACE ( $banlist, '', STRTOLOWER ( $pass ) ) );
} ELSE {
$pass = NULL;
}
// ---------------------------------------------
// Now to make an array so we can dump these variables into the SQL query.
// If either user or pass is NULL (because of inclusion of illegal characters),
// the whole script will stop dead in its tracks.
$array = ARRAY ( 'user' => $user, 'pass' => $pass );
// ---------------------------------------------
IF ( IN_ARRAY ( NULL, $array ) ) {
DIE ( 'Invalid use of login and/or password. Please use a normal method.' );
} ELSE {
RETURN $array;
}
}
[1]: http://psoug.org/snippet/PHP-Anti-SQL-Injection-Function_18.htm
[1]: http://psoug.org/snippet/PHP-Anti-SQL-Injection-Function_18.htm

Which Perl module should I use to generate a validating CRUD webform?

Has anyone successfully used something like DBIx::Class::WebForm or CatalystX-CRUD to automagically build a self-validating webform from a database table?
I'm imagining a module that reads a database table schema, reads the constraints for each column, and generates some abstract representation of a webform, with fields for error messages, etc. I'm using Catalyst and Plack with a big existing codebase.
I don't want to code up an HTML webform, nor any validation logic. I'm aiming to write as little code as possible, in the style of Ruby on Rails. Which Perl module is best for this?
UPDATE: I've solved the webform side with HTML::FormFu, but it's still clunky mapping the form inputs onto the database, e.g. date_start and date_end both relate to the 'created' column, and comment should match using 'LIKE %foo%', etc. Where's the 'DBICFu'?
UPDATE: This is for a web application, the webform should not look like a database table. I'm not looking for a database management tool.
You can use use HTML::FormHandler::Moose and HTML::FormHandler::Model::DBIC and get some nice forms.
As a simple example:
The form definition:
package MyStats::Form::Datetime ;
use HTML::FormHandler::Moose ;
extends 'HTML::FormHandler::Model::DBIC' ;
use Date::Calc qw(Today_and_Now) ;
has_field 'datetimeid' => ( label => 'ID' ) ;
has_field 'datetime' => ( type => 'Text',
apply => [ { transform => \&transform_dt } ] ,
deflation => \&deflation_dt ,
required => 1 ) ;
has_field 'submit' => ( type => 'Submit' ,
value => 'Speichern' ) ;
# These are the fields of the table datetime
sub transform_dt {
my ( $dt ) = #_ ;
my #d = ( $dt =~ m/(\d{1,2})\.(\d{1,2})\.(\d{4})\s+(\d{1,2}):(\d{1,2})/ ) ;
return sprintf( '%04d-%02d-%02d %02d:%02d:00' , #d[2,1,0,3,4] ) ;
}
sub deflation_dt {
my ( $dt ) = #_ ;
my #d = ( $dt =~ m/(\d{4})-(\d{2})-(\d{2})\s+(\d{1,2}):(\d{1,2})/ ) ;
if( ! #d ) {
#d = Today_and_Now() ;
}
return sprintf( '%02d.%02d.%04d %02d:%02d:00' , #d[2,1,0,3,4] ) ;
}
1 ;
And the usage in a controller:
package MyStats::Controller::Datetime ;
use Moose ;
use namespace::autoclean ;
BEGIN { extends 'Catalyst::Controller' ; }
use MyStats::Form::Datetime ;
has 'form' => ( isa => 'MyStats::Form::Datetime' ,
is => 'rw' ,
lazy => 1 ,
default => \&new_datetime_form ) ;
sub new_datetime_form {
MyStats::Form::Datetime->new( css_class => 'datetimeform' ,
name => 'datetimeform' ) ;
}
...
sub add :Local :Args(0) {
my ( $self , $ctx ) = #_ ;
my $data = $ctx->model( 'MyStatsDB::Datetime' )->new_result( {} ) ;
$ctx->stash( template => 'datetime/add.tt2' ,
form => $self->form ) ;
$ctx->bread_crumb( { name => 'Datum/Zeit eingeben' ,
location => '/datetime/add' } ) ;
$ctx->req->param( 'datetimeid' , undef ) if $ctx->req->param( 'datetimeid' ) ;
return unless $self->form->process( item => $data ,
params => $ctx->req->params ) ;
$ctx->flash( message => 'Neuer Datensatz ' . $data->datetimeid .
' angelegt.' ,
id_add => $data->datetimeid ) ;
$ctx->res->redirect( $ctx->uri_for( '/datetime' ) ) ;
}
...
__PACKAGE__->meta->make_immutable ;
1 ;
Works good.
I've used HTML::FormHandler to generate forms for me in this fashion. It needs some tweaking, but it does 90% of the work for you. Separately DBIx::Class offers a similar tool.
There are a number of crud options on the Catalyst wiki.
It sounds like AutoCrud would fit your needs.

How to post non-latin1 data to non-UTF8 site using perl?

I want to post russian text on a CP1251 site using LWP::UserAgent and get following results:
# $text="Русский текст"; obtained from command line
FIELD_NAME => $text # result: Г?в г'В?г'В?г'В?г?вєг?вёг?в? Г'В'Г?вчг?вєг'В?г'В'
$text=Encode::decode_utf8($text);
FIELD_NAME => $text # result: Р с?с?с?рєрёр? С'Рчрєс?с'
FIELD_NAME => Encode::encode("cp1251", $text) # result: Г?гіг+г+гЄгёгЏ ГІгҐгЄг+гІ
FIELD_NAME => URI::Escape::uri_escape_utf8($text) # result: D0%a0%d1%83%d1%81%d1%81%d0%ba%d0%b8%d0%b9%20%d1%82%d0%b5%d0%ba%d1%81%d1%82
How can I do this? Content-Type must be x-www-form-urlencoded. You can find similar form here, but there you can just escape any non-latin character using &#...; form, trying to escape it in FIELD_NAME results in 10561091108910891 10901077108210891 (every &, # and ; stripped out of the string) or 1056;усский текст (punctuation characters at the beginning of the string are stripped out) depending on what the FIELD_NAME actually is.
UPDATE: Anybody knows how to convert the following code so that it will use LWP::UserAgent::post function?
my $url=shift;
my $fields=shift;
my $request=HTTP::Request->new(POST => absURL($url));
$request->content_type('application/x-www-form-urlencoded');
$request->content_encoding("UTF-8");
$ua->prepare_request($request);
my $content="";
for my $k (keys %$fields) {
$content.="&" if($content ne "");
my $c=$fields->{$k};
eval {$c=Encode::decode_utf8($c)};
$c=Encode::encode("cp1251", $c, Encode::FB_HTMLCREF);
$content.="$k=".URI::Escape::uri_escape($c);
}
$request->content($content);
my $response=$ua->simple_request($request);
This code actually solves the problem, but I do not want to add the third request wrapper function (alongside with get and post).
One way around it appears to be (far from the best, I think) to use recode system command if you have it avialable. From http://const.deribin.com/files/SignChanger.pl.txt
my $boardEncoding="cp1251"; # encoding used by the board
$vals{'Post'} = `fortune $forunePath | recode utf8..$boardEncoding`;
$res = $ua->post($formURL,\%vals);
Another approach seems to be in http://mail2lj.nichego.net/lj.txt
my $formdata = $1 ;
my $hr = ljcomment_string2form($formdata) ;
my $req = new HTTP::Request('POST' => $ljcomment_action)
or die "new HTTP::Request(): $!\n" ;
$hr->{usertype} = 'user' ;
$hr->{encoding} = $mh->mime_attr('content-type.charset') ||
"cp1251" ;
$hr->{subject} = decode_mimewords($mh->get('Subject'));
$hr->{body} = $me->bodyhandle->as_string() ;
$req->content_type('application/x-www-form-urlencoded');
$req->content(href2string($hr)) ;
my $ljres = submit_request($req, "comment") ;
if ($ljres->{'success'} eq "OK") {
print STDERR "journal updated successfully\n" ;
} else {
print STDERR "error updating journal: $ljres->{errmsg}\n" ;
send_bounce($ljres->{errmsg}, $me, $mh->mime_attr("content-type.charset")) ;
}
Use WWW::Mechanize, it takes care of encoding (both character encoding and form encoding) automatically and does the right thing if a form element's accept-charset attribute is set appropriately. If it's missing, the form defaults to UTF-8 and thus needs correction. You seem to be in this situation. By the way, your example site's encoding is KOI8-R, not Windows-1251. Working example:
use utf8;
use WWW::Mechanize qw();
my $message = 'Русский текст';
my $mech = WWW::Mechanize->new(
cookie_jar => {},
agent => 'Mozilla/5.0 (X11; U; Linux x86_64; en-US) AppleWebKit/533.9 SUSE/6.0.401.0-2.1 (KHTML, like Gecko)',
);
$mech->get('http://zhurnal.lib.ru/cgi-bin/comment?COMMENT=/z/zyx/index_4-1');
$mech->current_form->accept_charset(scalar $mech->response->content_type_charset);
$mech->submit_form(with_fields => { TEXT => $message });
HTTP dump (essential parts only):
POST /cgi-bin/comment HTTP/1.1
Content-Length: 115
Content-Type: application/x-www-form-urlencoded
FILE=%2Fz%2Fzyx%2Findex_4-1&MSGID=&OPERATION=store_new&NAME=&EMAIL=&URL=&TEXT=%F2%D5%D3%D3%CB%C9%CA+%D4%C5%CB%D3%D
These functions solve the issue (first for posting application/x-www-form-urlencoded data and second for multipart/form-data):
#{{{2 postue
sub postue($$;$) {
my $url=shift;
my $fields=shift;
my $referer=shift;
if(defined $referer and $referer eq "" and defined $fields->{"DIR"}) {
$referer=absURL($url."?DIR=".$fields->{"DIR"}); }
else {
$referer=absURL($referer); }
my $request=HTTP::Request->new(POST => absURL($url));
$request->content_type('application/x-www-form-urlencoded');
$request->content_encoding("UTF-8");
$ua->prepare_request($request);
my $content="";
for my $k (keys %$fields) {
$content.="&" if($content ne "");
my $c=$fields->{$k};
if(not ref $c) {
$c=Encode::decode_utf8($c) unless Encode::is_utf8($c);
$c=Encode::encode("cp1251", $c, Encode::FB_HTMLCREF);
$c=URI::Escape::uri_escape($c);
}
elsif(ref $c eq "URI::URL") {
$c=$c->canonical();
$c=URI::Escape::uri_escape($c);
}
$content.="$k=$c";
}
$request->content($content);
$request->referer($referer) if(defined $referer);
my $i=0;
print STDERR "Doing POST request to url $url".
(($::o_verbose>2)?(" with fields:\n".
::YAML::dump($fields)):("\n"))
if($::o_verbose>1);
REQUEST:
my $response=$ua->simple_request($request);
$i++;
my $code=$response->code;
if($i<=$o_maxtries and 500<=$code and $code<600) {
print STDERR "Failed to request $url with code $code... retrying\n"
if($::o_verbose>2);
sleep $o_retryafter;
goto REQUEST;
}
return $response;
}
#{{{2 postfd
sub postfd($$;$) {
my $url=absURL(shift);
my $content=shift;
my $referer=shift;
$referer=absURL($referer) if(defined $referer);
my $i=0;
print STDERR "Doing POST request (form-data) to url $url".
(($::o_verbose>2)?(" with fields:\n".
::YAML::dump($content)):("\n"))
if($::o_verbose>1);
my $newcontent=[];
while(my ($f, $c)=splice #$content, 0, 2) {
if(not ref $c) {
$c=Encode::decode_utf8($c) unless Encode::is_utf8($c);
$c=Encode::encode("cp1251", $c, Encode::FB_HTMLCREF);
}
push #$newcontent, $f, $c;
}
POST:
my $response=$ua->post($url, $newcontent,
Content_type => "form-data",
((defined $referer)?(referer => $referer):()));
$i++;
my $code=$response->code;
if($i<=$o_maxtries and 500<=$code and $code<600) {
print STDERR "Failed to download $url with code $code... retrying\n"
if($::o_verbose>2);
sleep $o_retryafter;
goto POST;
}
return $response;
}