Showing posts with label Perl. Show all posts
Showing posts with label Perl. Show all posts

Wednesday, August 12, 2015

Sample perl script to query JIRA

Using the Perl module http://search.cpan.org/~gnustavo/JIRA-REST-0.010/lib/JIRA/REST.pm

#!/usr/bin/perl -w
use strict;
use JIRA::REST;
use Data::Dumper;

my $jira = JIRA::REST->new('https://my.jira.net/jira', 'username', 'password');

# Get issue
my $issue = $jira->GET("/issue/TST-704");
#print Dumper($issue);

print "priority=$issue->{'fields'}->{'priority'}->{'name'}\n";
print "assignee=$issue->{'fields'}->{'assignee'}->{'name'}\n";
print "key=$issue->{'key'}\n";

# Iterate using utility methods
$jira->set_search_iterator({
        jql        => 'project = "TST" and issuetype in (Bug, scope) and fixVersion in (1.1r4, 1.1R4) and status in ( Closed, Resolved )',
        maxResults => -1,
        fields     => [ qw/summary status assignee/ ],
});

print "=================================================\n";
print "ISSUE-ID:STATUS:SUMMARY\n";
print "=================================================\n";
while (my $issue = $jira->next_issue) {
        #print "Found issue $issue->{key}\n";
        print "$issue->{key}: $issue->{fields}->{status}->{name}: $issue->{fields}->{summary}\n";
}

Wednesday, September 26, 2012

Solution to Project Euler Problem 10 - Find the sum of all the primes below two million

http://projecteuler.net/problem=10

Problem
The sum of the primes below 10 is 2 + 3 + 5 + 7 = 17.
Find the sum of all the primes below two million.

Answer:   457143142877

Solution:

#!/usr/bin/perl -w
use strict;
use Math::Complex;
my (@primes,$ulimit,$stop);
$ulimit=2000000;
$stop=10001;
generate_prime();

sub generate_prime {
        my ($i,$j,$prime,$squareroot,$count);
        @primes=(2,3,5,7); #initial prime numbers
        my $sum=17;  #initial sum = 2+3+5+7
        #We know only 2 is the even prime numbers, hence skip all even numbers
        for ($i=9;$i<=$ulimit; $i+=2) {
                $prime=0;
                #Divide the number by all the prime numbers less than the square root
                $squareroot=sqrt($i);
                foreach $j (@primes) {
                        if ( $j > $squareroot ) {
                                last;
                        }
                        if (($i%$j) == 0) {
                                $prime=1;
                                last;
                        }
                }
                if ($prime == 0 ) {
                        print "The current prime number is: $i\n";
                        $sum+=$i;
                        print "sum till now: $sum \n";

                }
        }
}

Saturday, November 5, 2011

Solution to Project Euler Problem 7 - 10001th prime number

http://projecteuler.net/problem=7
Problem:

By listing the first six prime numbers: 2, 3, 5, 7, 11, and 13, we can see that the 6th prime is 13.
What is the 10 001st prime number?

Answer: The 10001 prime number is: 104743

Solution:
#!/usr/bin/perl -w
use strict;
use Math::Complex;
my (@primes,$ulimit,$stop);
$ulimit=1000000;
$stop=10001;
generate_prime();


sub generate_prime {
        my ($i,$j,$prime,$squareroot,$count);
        @primes=(2,3,5,7);
        $count=4;
        #We know only 2 is the even prime numbers, hence skip all even numbers
        for ($i=9;$i<=$ulimit; $i+=2) {
                $prime=0;
                #Divide the number by all the prime numbers less than the square
 root
                $squareroot=sqrt($i);
                foreach $j (@primes) {
                        if ( $j > $squareroot ) {
                                last;
                        }
                        if (($i%$j) == 0) {
                                $prime=1;
                                last;
                        }
                }
                if ($prime == 0 ) {
                        $count+=1;
                        print "$count: $i \n";
                        push(@primes,$i);
                        if($count == $stop ) {
                                print "The $stop prime number is: $i \n";
                                exit(1);
                        }
                }
        }
}


Friday, November 4, 2011

Solution to Project Euler Problem 6 - sum of the squares of the first one hundred natural numbers and the square of the sum.

Problem: 
The sum of the squares of the first ten natural numbers is,
12 + 22 + ... + 102 = 385
The square of the sum of the first ten natural numbers is,
(1 + 2 + ... + 10)2 = 552 = 3025
Hence the difference between the sum of the squares of the first ten natural numbers and the square of the sum is 3025 − 385 = 2640.
Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum.

Answer: 
The sum of the squares of the first ten natural numbers is:338350
The square of the sum of the first 100 natural numbers is: 25502500
The difference between the sum of the squares of the first ten natural numbers and the square of the sum is: 25164150

Solution:

#!/usr/bin/perl -w
use strict;
my ($i,$ulimit,$sosq,$sqos);
$ulimit=100;
print "The sum of the squares of the first ten natural numbers is:";
for ( $i=1; $i<=$ulimit;$i++ )
{
        $sosq+=$i*$i;
        $sqos+=$i;
}


print "$sosq \n";
$sqos=$sqos*$sqos;
print "The square of the sum of the first $ulimit natural numbers is: $sqos \n";


my $diff=$sqos-$sosq;
print "The difference between the sum of the squares of the first ten natural nu
mbers and the square of the sum is: $diff \n";



Tuesday, November 1, 2011

Solution to Project Euler Problem 5 - the smallest positive number that is evenly divisible by all of the numbers from 1 to 20

http://projecteuler.net/problem=5

Question:

2520 is the smallest number that can be divided by each of the numbers from 1 to 10 without any remainder.
What is the smallest positive number that is evenly divisible by all of the numbers from 1 to 20?

Answer: 232,792,560

Solution:
#!/usr/bin/perl -w
use strict;


my ($max,$i,$num,$found);
$max=20;
$num=2;
while($num) {
        $found=1;
        for ($i=2;$i<=$max;$i++)
        {
                print "$num%$i \n";
                if( ($num%$i) != 0 ) {
                        last;


                }else {
                        $found++;
                }


        }
        if($found == $max ) {
                print "The smallest number that can be divided by each of the nu
mbers from 1 to $max is:  $num \n";
                exit (0);
        } else  {
                $num++;
        }
}


Output:
The smallest number that can be divided by each of the numbers from 1 to 20 is:
 232792560

Solution to Project Euler Problem 4 - The largest palindrome made from the product of two 2-digit numbers and two 3-digit numbers

http://projecteuler.net/problem=4

What will you know in this perl script ?
1) How to split a number/string (like 123456) into an array?
2) How to convert array into string?
3) Perl's numerical sort function and the <=> numerical comparison operator
4) Finding uniq elements in an array using grep and hash
5) You will know how to generate palindromes



Question: A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91 × 99.
Find the largest palindrome made from the product of two 3-digit numbers.

Answer:  906609 (993 * 913)


Solution: 

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


#Palindrome from 2 digit products
print "Palindromes from 2 digit products are ... \n";
generate_palindrome( 10, 99);
print "Palindromes from 3 digit products are ... \n";
#palindrome from 3 digit numbers
generate_palindrome( 100, 999);


sub generate_palindrome {
        my ($start, $end)=@_;
        my ($i, $j, $res,@number,@revers,$rev, @palindromes,@sorted, @unique, %s
een);
        for ($i=$start;$i<=$end;$i++) {
                for ($j=$start;$j<=$end;$j++) {
                        $res=$i*$j;
                        #Split a number into array
                        @number = ( $res =~ m/./g );
                        #reverse the array which stores the number
                        @revers=reverse(@number);
                        #convert array to string
                        $rev = "@revers";
                        #Replace the Extra separating spaces with blank
                        $rev =~ s/(.)\s/$1/seg;
                        #print "$i * $j = $res \n";
                        #print "Reverse: $rev \n";
                        if ( $res eq $rev ) {
                                #print "$res \n";
                                push (@palindromes, $res);
                        }
                }
        }


        #Perl's sort function and the <=> numerical comparison operator
        #The sort function takes an optional code block, which lets you replace
the default alphabetic comparison subroutine with your own.
        #This comparison function is called each time sort has to compare two va
lues.
        #The values to compare are loaded into the special package variables $a
and $b , which are automatically local ized.


        @sorted = sort { $a <=> $b } @palindromes;
        # Finding uniq elements in an array using grep and hash
        @unique = grep { ! $seen{$_}++ } @sorted;
        print "@unique\n";
        print "The largest palindrome is $unique[$#unique] \n";
}


Output: 
Palindromes from 2 digit products are ...
121 242 252 272 323 363 414 434 444 464 484 494 525 555 575 585 595 616 636 646 656 666 676 686 696 737 767 777 828 848 858 868 888 949 969 979 989 999 1001 1221 1551 1771 1881 2002 2112 2332 2442 2552 2772 2992 3003 3663 3773 4004 4224 4554 4664 4774 4884 5005 5115 5225 5335 5445 5775 6006 6336 6776 7007 7227 8008 8118 8448 9009
The largest palindrome is 9009
Palindromes from 3 digit products are ...
10201 11211 12221 12321 13231 13431 14241 14541 14641 15151 15251 15351 15651 15851 16261 16761 17271 17871 18081 18281 18981 19291 19591 20002 20202 20402 20502 21012 21112 21312 21412 21712 21812 21912 22022 22422 22922 23232 23432 23532 23632 23932 24442 24642 24742 25152 25252 25452 25652 25752 26062 26162 26462 26562 26862 26962 27072 27472 27572 27772 27872 27972 28182 28282 28482 28782 29192 29392 29492 29592 29792 29892 29992 30003 30303 30603 31313 31413 31613 3252332623 33033 33233 33333 33633 34243 34443 34643 34743 35453 35653 35853 35953 36663 36863 36963 37073 37373 37673 37873 37973 38383 38683 39093 39593 39693 39893 40004 40304 40404 40504 40704 40804 41114 41314 41514 41814 42024 42224 42624
42824 42924 43134 43434 43734 43834 44044 44144 44344 44444 44544 44744 44844 44944 45154 45254 45854 45954 46364 46464 46664 46764 46864 46964 47174 47674 47874 47974 48184 48384 48484 48884 48984 49494 49594 49794 49894 50005 50505 50605 51015 51315 51415 51615 51815 52125 52325 52425 52525 52625 52725 52925 53235 53535 53835 53935 54145 54945 55055 55255 55555 55755 55955 56165 56265 56465 56565 56865 57275 57375 57475 57575 57875 58185 58485 58685 58985 59095 59295 5949559595 59895 59995 60006 60306 60606 60706 61016 61116 61516 61716 62426 62526 62626 62726 62826 62926 63036 63336 63536 63736 63936 64246 64446 64546 64746 65056 65156 65556 65656 65856 66066 66466 66566 66666 66766 66866 67076 67176 67276
67776 67876 67976 68086 68186 68286 68486 68586 68686 68786 68886 69296 69496 69596 69696 69996 70007 70307 70707 70807 71117 71217 71817 72027 72627 72927 73337 73437 73537 73937 74347 74447 74547 74847 74947 75057 76167 76467 76867 77077 77677 77777 77877 78287 78387 78987 79097 79297 79497 79597 79797 79897 80008 80208 80408 80608 80808 80908 81018 81618 81718 81918 82128 82228 82328 82628 82728 82928 83538 83638 83738 83838 84048 84148 84348 84448 85058 85158 85358 86268 86668 86768 86868 87078 87178 87278 87478 87978 88088 88288 88688 88788 88888 89198 89298 89498 89598 89698 89798 90009 90109 90209 90909 91719 92129 92229 92329 92529 92629 92829 93639 93839 93939 94149 94249 95259 95559 95659 96369 96669
96869 97079 98189 98289 98489 98589 98789 98889 99099 99199 99299 99599 99699 99799 99899 99999 101101 102201 105501 106601 108801 110011 111111 117711 119911 121121 122221 123321 127721 128821 129921 131131 133331 135531 137731 138831 140041 141141 142241 143341 147741 149941 154451 155551 156651 159951 161161 162261 165561 168861 171171 174471 178871 180081 182281 184481 187781 188881 189981 198891 201102 202202 204402 209902 210012 212212 213312 214412 215512 216612 219912 220022 221122 222222 225522 227722 231132 232232 234432 235532 238832 239932 242242 244442 246642 249942 252252 255552 256652 257752 258852 259952 262262 266662 270072 272272 273372 276672 277772 279972 280082 282282 284482 286682 289982 290092 292292 294492 296692 297792 299992 301103 302203 303303 306603 308803 320023 321123 324423 329923 330033 333333 335533 343343 345543 348843 354453 357753 359953 363363 366663 367763 369963 371173 372273 374473 375573 377773 378873 384483 391193 393393 397793 399993 401104 402204 404404 405504 407704 408804 409904  412214 414414 416614 420024 421124 424424 425524 426624 428824 432234 434434 436634 438834 440044 441144 442244 443344 444444 445544 447744 452254 456654 459954 461164 462264 464464 468864 469964 470074 471174 474474 476674 477774 484484 485584 487784 488884 489984 491194 493394 505505 506605 507705 508805 509905 510015 512215 513315 514415 515515 519915 520025 522225 523325 525525 528825 531135 534435 535535 536635 543345 545545 548845 549945 550055 551155 554455 555555 560065 561165 564465 565565 570075 571175 573375 575575 576675 577775 579975 580085 585585 588885 589985 592295 595595 601106 602206 603306 604406 606606 611116 612216 616616 618816 619916 623326 630036 631136 636636 639936 642246 648846 649946 650056 652256 653356 654456 656656 657756 660066 661166 663366 666666 672276 675576 678876 689986 693396 696696 698896 723327 729927 737737 747747 749947 770077 780087 793397 801108 802208 804408 807708 809908 819918 821128 824428 828828 840048 853358 855558 861168 886688 888888 906609
The largest palindrome is 906609 (993 * 913 )

Solution to Project Euler Problem 3 - Finding prime numbers till trillion and largest prime factors for a large number (over 6 billion)



I wrote the most processing power consuming script of my life. It's running from last 7 hours, till not completed !!! 
What you will know in this script? 
A optimized (to best of my knowledge) perl function to generate prime numbers.
Perl module to find square root.
How to find prime factors for a given number.
How to screw up your CPU :)

Question:
The prime factors of 13195 are 5, 7, 13 and 29.
What is the largest prime factor of the number 600851475143 ?

Solution:

#!/usr/bin/perl -w
use strict;
use Math::Complex;
my (@primes,$ulimit);
$ulimit=600851475143;
generate_prime();
prime_factors($ulimit);


sub prime_factors {
        my ($num)=@_;
        my (@prime_factors,@sorted);
        print "Prime factors of $num are \n";
        foreach(@primes) {
                if ( $_ > $num ) {
                        last;
                } else {
                        if ( ($num%$_) == 0 ) {
                                push(@prime_factors,$_);
                        }
                }
        }
        @sorted = sort { $a <=> $b } @prime_factors;
        print "@sorted \n";
        print "The largest prime factor of $num is: $sorted[$#sorted] \n";
}


sub generate_prime {
        my ($i,$j,$prime,$squareroot);
        @primes=(2,3,5,7);  # Initializing known prime numbers
        #We know only 2 is the even prime numbers, hence skip all even numbers
        for ($i=9;$i<=$ulimit; $i+=2) {
                $prime=0;
                #Divide the number by all the prime numbers less than the square root
                $squareroot=sqrt($i);
                foreach $j (@primes) {
                        if ( $j > $squareroot ) {
                                last;
                        }
                        print "$i: $i%$j\n";
                        if (($i%$j) == 0) {
                                $prime=1;
                                last;
                        }
                }
                if ($prime == 0 ) {
                        print "$i \n";
                        push(@primes,$i);
                }
        }
        print "@primes \n";
        open (FH, ">prime-numbers.txt") || die "Cant create prime-numbers.txt $!";
        print FH "@primes\n";
        my $len=@primes;
        print "Total number of prime numbers from 1 to $ulimit= $len \n";
}




Monday, October 31, 2011

Solution to ProjectEuler Problem2 - Fibonacci Series till 4 million and sum of even numbers

projecteuler.net problem 2

Problem 2: Each new term in the Fibonacci sequence is generated by adding the previous two terms. By starting with 1 and 2, the first 10 terms will be:
1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
By considering the terms in the Fibonacci sequence whose values do not exceed four million, find the sum of the even-valued terms.

Answer: 4613732

Solution:

#!/usr/bin/perl -w
use strict;
my ($sum, $first, $second, $evensum);
$first=1;
$second=2;
$evensum=2;
print "Fibonacci sequence \n";
print "$first $second";
fib($first,$second);


sub fib
{
        my ($num1, $num2)=@_;
        #Limiting fibonacce sequence to 4000000
        if ($num2 <= 3500000 )
        {
                $sum=$num1+$num2;
                print " $sum";
                if ( ($sum%2) == 0 ) {
                        $evensum+=$sum;
                }
                fib($num2, $sum);
        }else {
                print "\nEven Sum = $evensum \n";
                exit (0);
        }
}


Output:
Fibonacci sequence till 4000000
1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578
Even Sum = 4613732

Solution to Project Euler Problem1 - sum of all the multiples of 3 or 5 below 1000

Just now I got to know about the site projecteuler.net, which post lots of mathematical problems, that needs computer programming to solve it. As soon I read 2 or 3 problems, I got tempted solve it.
I thought it's giving life back to my dying perl programming skills.

Here is the first problem (they have put easier one to  attract average minds like mine)


If we list all the natural numbers below 10 that are multiples of 3 or 5, we get 3, 5, 6 and 9. The sum of these multiples is 23.
Find the sum of all the multiples of 3 or 5 below 1000.

Answer:   233168

Solution in Perl: 

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

my ($i, $div3, $div5, $sum);
$sum=0;
for ($i = 1; $i<1000; $i++)
{
        $div3= $i%3;
        $div5= $i%5;
        if ( ($div3 == 0) || ($div5 == 0) ) {
                $sum+=$i;
                print "$i \n";
        }
}

print "Sum= $sum \n";

Output: 

Multiples of 3 and 5 below 1000 are
 3 5 6 9 10 12 15 18 20 21 24 25 27 30 33 35 36 39 40 42 45 48 50 51 54 55 57 60 63 65 66 69 70 72 75 78 80 81 84 85 87 90 93 95 96 99 100 102 105 108 110 111 114 115 117 120 123 125 126 129 130 132 135 138 140 141 144 145 147 150 153 155 156 159 160 162 165 168 170 171 174 175 177 180 183 185 186 189 190 192 195 198 200 201 204 205 207 210 213 215 216 219 220 222 225 228 230 231 234 235 237 240 243 245 246 249 250 252 255 258 260 261 264 265 267 270 273 275 276 279 280 282 285 288 290 291 294 295 297 300 303 305 306 309 310 312 315 318 320 321 324 325 327 330 333 335 336 339 340 342 345 348 350 351 354 355 357 360 363 365 366 369 370 372 375 378 380 381 384 385 387 390 393 395 396 399 400 402 405 408 410 411 414 415 417 420 423 425 426 429 430 432 435 438 440 441 444 445 447 450 453 455 456 459 460 462 465 468 470 471 474 475 477 480 483 485 486 489 490 492 495 498 500 501 504 505 507 510 513 515 516 519 520 522 525 528 530 531 534 535 537 540 543 545 546 549 550 552 555 558 560 561 564 565 567 570 573 575 576 579 580 582 585 588 590 591 594 595 597 600 603 605 606 609 610 612 615 618 620 621 624 625 627 630 633 635 636 639 640 642 645 648 650 651 654 655 657 660 663 665 666 669 670 672 675 678 680 681 684 685 687 690 693 695 696 699 700 702 705 708 710 711 714 715 717 720 723 725 726 729 730 732 735 738 740 741 744 745 747 750 753 755 756 759 760 762 765 768 770 771 774 775 777 780 783 785 786 789 790 792 795 798 800 801 804 805 807 810 813 815 816 819 820 822 825 828 830 831 834 835 837 840 843 845 846 849 850 852 855 858 860 861 864 865 867 870 873 875 876 879 880 882 885 888 890 891 894 895 897 900 903 905 906 909 910 912 915 918 920 921 924 925 927 930 933 935 936 939 940 942 945 948 950 951 954 955 957 960 963 965 966 969 970 972 975 978 980 981 984 985 987 990 993 995 996 999
Sum= 233168

Monday, November 2, 2009

Posting a JIRA bug using Perl Mechanize

Perl provides modules which can be used as command line browser to automate tasks dependent on web pages. Among them LWP and mechanize are important ones. Mechanize is latest module with more features compared to LWP.
Recently I wrote a perl script to integrate a perl tool with JIRA bug tracking tool using mechanize, I just want to document here about mechanize usage with JIRA.
Basically this perl script post a bug in Jira after authentication

#!/usr/bin/perl -w
use WWW::Mechanize;
use HTTP::Cookies;
$mech = WWW::Mechanize->new();

# Authenticate to Jira and get a cookie back for the subsequent post.
$root_uri = "http://your-jira-site.com";

$mech->cookie_jar(HTTP::Cookies->new()); # Don't write cookies to file!
$mech->get($root_uri);
#login to Jira
$mech->form_name('loginform');
$mech->field(os_username => $jira_id);
$mech->field(os_password => $jira_pass);
$mech->click();
my $response = $mech->content();
if ($response !~ m/Dashboard for (\w+) (\w+)/) {
print_error("Failed to add new bug: authentication failed. Below you might find a clue as to what happened.");
print_error("
");
print_error($response);
return;
} else {
$username="$1 $2";
}



print "

creating new Jira bug ...

\n";
my $show_uri = "$root_uri/browse";
# Go to Product page in Jira
$mech->follow_link(text => "$product", n => 1);
#Browse to create new issue form
$mech->follow_link(text => "Create a new issue in project $product", n => 1);
$mech->form_name('jiraform');
$mech->click();

#Create a new bug
$mech->form_name('jiraform');
$mech->field(summary => "$formdata{hotfix}: $formdata{bugtitle}");
$mech->field(components => "$components_map{\"$formdata{component}\"}");
$mech->field(customfield_10044 => "$formdata{platform}"); #OS/Platform
$mech->field(customfield_10054 => "moderate"); #Bug severity
$mech->field(assignee => "$jira_id");
$mech->field(description => "$comment");
$mech->field(customfield_10067 => "$_[0]"); #Found in Version
$mech->field(customfield_10007 => "All"); #Appserver
$mech->field(customfield_10060 => "Support request (CE_Assistance)"); #Type of defect
$mech->field(customfield_10020 => "CS - other"); #Discovered by function
$mech->field(customfield_10019 => "Use in production "); #Discovered by activity
$mech->click();
print "

  posting bug ...\n";
$response = $mech->content();
my $bz_msg;
my $bug_number;
if ($response =~ m/Key:.*?browse\/(\w+)-(\w+)/s) {
$bug_number = "$1-$2";
print "done

\n";
$bz_msg = "

Bug #$bug_number for version $_[0] has been posted to " . "Jira.

\n";
print "$bz_msg";
$bz_donemsg .= $bz_msg;
} else {
$bz_donemsg .= "

No Jira bug was filed for version $_[0]. This will need to be done manually.

\n";
print_error("Failed to add new bug (Jira output follows):\n$response");
}



Reference: http://www.ibm.com/developerworks/linux/library/wa-perlsecure.html

Tuesday, November 11, 2008

Splitting columns in Perl

Splitting columns or fields is one of the most common tasks. Among the many ways to split columns in perl, the best and the simplest way is
Suppose if we want to split 4th field, where the field separator is tab
while() {
chomp;
my $var=(split /\t+/)[3];
}

Wednesday, July 9, 2008

How to install Perl modules

For example to install Mail::Mailer module, you can use below
command

perl -MCPAN -e 'install Mail::Mailer'

Also refer http://www.cpan.org/modules/INSTALL.html for another
approach

Offline Installation of Perl module
perl Makefile.PL
make
make test
make install 

How do I find out what modules are already installed on my system?

Each time a module is installed on your system, it appends information like the following to a file called perllocal.pod which can be found in /usr/local/lib/perl5/version number/architecture/ or something akin to that. The path for your specific installation is in your @INC which you can divine with perl -V.
=head2 Wed May 12 13:42:53 1999: C L
=over 4
=item *
C
=item *
C
=item *
C
=item *
C
=back

Each entry includes the Module name, date and time it was installed, where it was installed, linktype [ static or dynamic ], version and executables, if any, included with the module.

Another way to do this is http://vijayk.blogspot.com/2008/06/list-all-installed-perl-modules.html

Tuesday, July 1, 2008

Perl Hobby Scripts

A. Simple

1. Write a Perl script to find and print the longest word in a text file.

2. Implement proactive password checker, means allow a person to enter his password, check for following conditions

- Password should be at least 8 characters in length

- It should contain alphanumeric, upper & lowercase letters

- It should contain any of these special characters @, $ and #.

Solutions


#!/usr/bin/perl -w

#Write a Perl script to find and print the longest word in a text file.

#Importing packages

use strict;

use Getopt::Long;

#Global variables

my ($help, $file);

#Processing command line arguments

GetOptions("h"=>\$help,

"f=s"=>\$file,

);

if($help) {

usage();

}

#Check for -f option

if(!defined($file)){

print "ERROR: -f option is compulsory\n";

usage();

}

open(FH, "$file") || die "Error: Can't open $file: $!";

my ($len,$word,@line,$element);

my $largest=0;

foreach()

{

@line=split(/\s+/,$_);

foreach $element (@line)

{

$len=length($element);

if($len > $largest) {

$largest=$len;

$word=$element;

}

}

}

print "Largest word length is: $largest and the word is $word\n";

sub usage

{

print "USAGE: $0 -f \n";

exit(1);

}

2.

#!/usr/bin/perl -w

## Proactive password checker ##########

use strict;

use Term::ReadKey;

my $user=`whoami`; chomp($user);

print "Hello $user ..\n";

my $try=0;

my $passwd;

accept_password();

sub accept_password

{

$try++;

if($try <= 3)

{

print "Enter your password\n";

ReadMode 'noecho';

$passwd=ReadLine 0;chomp($passwd);

ReadMode 'normal';

check_passwd();

}else

{

print "You exceeded maximum attempts\n";

exit(1);

}

}

sub check_passwd

{

#Check if password length is atleast 8

if(length($passwd) <>

{

print "ERROR: Your password length is less than 8\n";

print "PASSWORD REJECTED\n";

accept_password();

}

#Check for digit

if($passwd =~ /[0-9]/) {

}else{

print "ERROR: No digit in your password\n";

print "PASSWORD REJECTED\n";

accept_password();

}

#Check for lowercase letter

if($passwd =~ /[a-z]/) {

}else{

print "ERROR: No lowercase letter in your password\n";

print "PASSWORD REJECTED\n";

accept_password();

}

#Check for Uppercase letter

if($passwd =~ /[A-Z]/) {

}else{

print "ERROR: No Uppercase letter in your password\n";

print "PASSWORD REJECTED\n";

accept_password();

}

#Check for special characters

#if(($passwd =~ /\@/)|| ($passwd =~ /#/) || ($passwd =~ /\$/)){

if( ($passwd =~ /\@/) || ($passwd =~ /\$/) || ($passwd =~ /\#/) ){

}else{

print "ERROR: No special characters \@ # \$\n";

print "PASSWORD REJECTED\n";

accept_password();

}

}

print "PASSWORD ACCEPTED\n";