Tag Archives: Perl Scripts

CSV generation in Perl Script

We can create csv files using perl script. It should be as follows.

my $table=$q->param('table');
my $field_name=defined($q->param('column'))?$q->param('column'):"*";
my $file_name="Report".time();
my $sql_rep = 'SELECT '.$field_name.' FROM '.$table;
$file = "$file_name.csv";
my $getkey = $dbh->prepare($sql_rep);
$getkey->execute;
my (@names, @values);
my $xi=0;
my $xii=0;
my @datas;
while( my @row = $getkey->fetchrow_array ) {
    $xii=0;
    foreach my $data (@row) {
        push @{$datas[$xi]}, $data;
        $xii++;
    }
    $xi++;
}
$getkey->finish;
open my $OUT, '>', "report_generator/".$file or die $!;
for(my $yi=0;$yi<$xi;$yi++) {
    @values=();
    for(my $yii=0;$yii<$xii;$yii++) {
        $datas[$yi][$yii] =~ s/"/""/g;
        push @values, qq{"$datas[$yi][$yii]"};
    }
    print {$OUT} (join ",", @values) . "\n";
}
close $OUT;

 

How to create multidimensional arrays in Perl?

To make an array of arrays, or more accurately an array of arrayrefs, try something like this:

my @array = ();
foreach my $i ( 0 .. 10 ) {
  foreach my $j ( 0 .. 10 ) {
    push @{ $array[$i] }, $j;
  }
}

It pushes the value onto a dereferenced arrayref for you. You should be able to access an entry like this:

print $array[3][2];

Zooming image with jquery

Check the following links to see how it work

To download it please click the below links

Progress bars for file uploads and avoiding temp files

CGI.pm gives you low-level access to file upload management through a file upload hook. You can use this feature to completely turn off the temp file storage of file uploads, or potentially write your own file upload progress meter.

This is much like the UPLOAD_HOOK facility available in Apache::Request, with the exception that the first argument to the callback is an Apache::Upload object, here it’s the remote filename.

$q = CGI->new(\&hook [,$data [,$use_tempfile]]);
sub hook {
my ($filename, $buffer, $bytes_read, $data) = @_;
print “Read $bytes_read bytes of $filename\n”;
}

The $data field is optional; it lets you pass configuration information (e.g. a database handle) to your hook callback.

The $use_tempfile field is a flag that lets you turn on and off CGI.pm‘s use of a temporary disk-based file during file upload. If you set this to a FALSE value (default true) then $q->param(‘uploaded_file’) will no longer work, and the only way to get at the uploaded data is via the hook you provide.

If using the function-oriented interface, call the CGI::upload_hook() method before calling param() or any other CGI functions:

CGI::upload_hook(\&hook [,$data [,$use_tempfile]]);

This method is not exported by default. You will have to import it explicitly if you wish to use it without the CGI:: prefix.

Captcha creation in perl

use CGI;
use vars qw( $q $dbh);
use CGI::Carp qw(fatalsToBrowser);
use Digest::SHA qw(sha512_base64);
use GD::SecurityImage backend => 'Magick';
use Digest::MD5;
#-------------------------------Database Connection-----------------------------
$q = new CGI;
$CGI::HEADERS_ONCE = 1;
my $dbh = &getDatabaseConnection();
my $dbhi= &getDatabaseConnectioni();
#-------------------------------------------------------------------------------
print $q->header("text/html");
my $msssg='';
sub createSecretString{
    my $id = "";
    my @CharList = ("a".."z",0..9,"A".."Z");
    my $x;
    for($x=0;$x<14;$x++){
        $id .= $CharList[int(rand(62))];
    }
    my $sessionid=Digest::MD5->md5_hex($$.time().$id);
    return $sessionid;
}
sub createCaptchaString{
    my $id = "";
    my @CharList = ("a".."z",0..9,"A".."Z");
    my $x;
    for($x=0;$x<=6;$x++){
        $id .= $CharList[int(rand(62))];
    }
    return $id;
}

sub printbodyx{
    my $rand_string = &createCaptchaString;
    my $image = GD::SecurityImage->new(
        width => 300,
        height => 100,
        ptsize => 25,
        lines => 100,
        thickness => 4,
        rndmax => 4,
        scramble => 2,
        send_ctobg => 1,
        bgcolor => '#ffffff',
        font => 'ARIALBD.TTF',
    );
    $image->random($rand_string);
    $image->create( qw/ ttf blank #000000 #7D011D / );
    $image->particle(500, 1);
    my($image_data, $mime_type, $random_number) = $image->out;
    my $secret_string = &createSecretString();
    $dbh->do(qq{
        INSERT INTO
            image_validation
                (secret_number,secret_key,time_added)
        VALUES
            (?,?,NOW())
    },undef,$random_number,$secret_string);
    my ($image_id) = $dbh->selectrow_array("SELECT LAST_INSERT_ID() FROM image_validation");
    open(WRT,">/captcha/$image_id.png");
    binmode(WRT);
    print WRT $image_data;
    close(WRT);
    if(defined($q->param('submit'))) {
        my $secret_number = $q->param('secret_number');
        my $secret_string = $q->param('secret_string');
        my($image_id,$db_number)=$dbh->selectrow_array(qq{
            SELECT
                image_id,secret_number
            FROM
                image_validation
            WHERE
                secret_key = ?
        },undef,$secret_string);
        if(!$db_number || ($db_number ne $secret_number)) {
            $msssg=&printError("The code entered does not match. Please try again.");
        } else {
            $msssg= qq{OK};
        }
    }
    print qq{
        <table>
            <tr>
                <td style="padding-left: 25px; width: 414px; background-color: rgb(255, 249, 250);">Capcha</td>
                <td style="padding-left: 25px; width: 15px; background-color: rgb(255, 249, 250); white-space: nowrap;">
                    <span style="font-size:20px;"><strong>:</strong></span>
                </td>
                <td style="width: 414px; background-color: rgb(255, 249, 250);">
                    <img alt="CAPTCHA" src="/captcha/$image_id.png" id="captcha_img" style="border:1px solid #7D011D;width:250px;height:90px;" />
                    &nbsp;<img alt="refresh" style="width:15px;height:15px;cursor: pointer;" name="refresh" id="refresh" src="/images/refresh.png" onclick="captch_change()">
                </td>
            </tr>
            <tr>
                <td style="padding-left: 25px; width: 414px; background-color: rgb(255, 249, 250);">Enter code&nbsp;<font color="#FF0000">*</font></td>
                <td style="padding-left: 25px; width: 15px; background-color: rgb(255, 249, 250); white-space: nowrap;">
                    <span style="font-size:20px;"><strong>:</strong></span>
                </td>
                <td style="width: 414px; background-color: rgb(255, 249, 250);">
                    <input id="secret_number" maxlength="100" name="secret_number" style="width:300px;" type="text" />
                    <input name="secret_string" id="secret_string" type="hidden" value="$secret_string" />
                    <br/>
                    <span style="color:#ff0000;font-size:9pt;font-weight:bold;" id="warning"> </span>
                </td>
            </tr>
            <tr>
                <td colspan="3" style="background-color: rgb(255, 249, 250); width: 414px; text-align: center;">
                    <input id="submitx" name="submitx" style="border:2px outset #799D35;" type="button" onclick="validate()" value="Submit" />
                    <input id="Reset" name="Reset" style="border:2px outset #799D35;" type="reset" value="Reset" />
                </td>
            </tr>
        </table>
    };
}

sub printError{
    my($head,$message)=@_;
    $err_capcha = qq{<b><div style="color:#FF0000" align="center">$head</div></b>$message};
    return $err_capcha;
}