Perl

average

#!/usr/bin/perl

open(GRADES, "grades") or die "Can’t open grades: $!\n";

while ($line = <GRADES>) {
	($student, $grade) = split(" ", $line);
	$grades{$student} .= $grade . " ";
}

foreach $student (sort keys %grades) {
	$scores = 0;
	$total = 0;
	@grades = split(" ", $grades{$student});

	foreach $grade (@grades) {
		$total += $grade;
		$scores++;
	}

	$average = $total / $scores;
	print "$student: $grades{$student}\tAverage: $average\n";
}

grades

Noël 25
Ben 76
Clementine 49
Norm 66
Chris 92
Doug 42
Carol 25
Ben 12
Clementine 0
Norm 66

assign_01_01

#!/usr/bin/perl
# Problem_01.Version_03
# Name:		Husain AlKhamees

print "Enter file name: ";
$_ = <STDIN>;
open(FILENAME, $_) or die "Can’t open $_ : $!\n";

while(<FILENAME>){
	chomp;
	print "Before stripping: ", $_, "\n";
	s/^[\d\W]+//; #same as: $_ =~ s/^[\d\W]+//;
	# what if "tr///" is used instead of "s///"

	s/[\d\W]+/ /g; # same as: $_ =~ s/[\d\W]+/ /g;
	# what if "tr///" is used instead of "s///"
	print "After stripping : ", $_, "\n\n";
}

to be stripped

This<<<is>>>an+=-(example) line9739784of #$input!
&(^the file!can.have****more(than)one////line@@@

assign_01_02

#!/usr/bin/perl
# Problem_02
# Name:		Husain AlKhamees

# @ARGV is the array where arguments from the command line are stored
open(SUBSTITUTIONS, $ARGV[0]) or die "Can’t open $ARGV[0] : $!\n";
open(FILE, $ARGV[1]) or die "Can’t open $ARGV[1] : $!\n";

$i = 0;
while($line = ){
	chomp ($line);
	#splitting the line and storing the values in 2 arrays
	($sub1[$i], $sub2[$i]) = split(":", $line);
	$i++;
}

while($line = ){
	chomp ($line);
	print "Before substituting: ", $line ,"\n";

	$j = 0;
	do{
		#use the 2 arrays to make the substitutions
		$line =~ s/$sub1[$j]/$sub2[$j]/g;
	} until $j++ eq $i;

	print "After substituting : ", $line ,"\n\n";
}

substitutions

it's:it is
recieve:receive
don't:do not

to be substituted

it's better to give than to recieve! So, don't recieve unless it's necessary!
don't wait till the last meoment!

assign01_03

#!/usr/bin/perl
# Problem_03.Version_02
# Name:		Husain AlKhamees

open(PAIRS, "pairs") or die "Can’t open pairs : $!\n";

print "Input:\n";
while(<PAIRS>){
	print , "\n"; #same as print $_, "\n";

	chomp;

	s/[ \t]//g;		# Subsituting every space with empty space
	s/\)\(/:/g;		# Subsituting every )( with :
	s/[\(\)]//g;	# Subsituting any ( or ) with empty space

	#splitting the pairs (x,y)
	split(":", $_);

	foreach $pair (@_){
		($x, $y)= split(",", $pair);
		#appending a non-digit to the number, so we can split the numbers in the below loop
		$pairs{$x} .= $y . " ";
		#print "$x and $y\n";
	}
}

print "\nOutput:\n";
#sorting keys numerically
foreach $x (sort { $a <=> $b } keys %pairs){
	#splitting all values/numbers for the current key
	@pairs = split(" ", $pairs{$x});
	$tot = 0;
	foreach $y (@pairs){
		#sum up all Ys for this X
		$tot += $y;
	}
	print "$x, $tot\n";
}

#These are just subroutines for ascending/descending numerical sort
sub ascendingNum { $a <=> $b }
sub descendingNum { $b <=> $a }

#this is a test
#@sortedbynumber = sort ascendingNum 53,29,11,32,7;
#$sortedbynumber = join (" ", @sortedbynumber);
#print $sortedbynumber, "\n";

#@sortedbynumber = sort descendingNum 53,29,11,32,7;
#$sortedbynumber = join (" ", @sortedbynumber);
#print $sortedbynumber, "\n";

pairs

(2,   10) (10, 	1) ( 5, 2)
(10, 3) ( 1 , 2 )
(2, 1)

check links

#!/usr/bin/perl -w
# diary-link-checker - check links from diary page

use strict;
use LWP;
$ARGV[0] = "http://www.google.com";
if(not $ARGV[0]){
	print "usage: checklink url\n";
	exit
}

my $doc_url = $ARGV[0];
my $document;
my $browser = new LWP::UserAgent;

initialize();

while($document =~ m/href\s*=\s*"([^"\s]+)"/gi){
	check_url(absolute($1, $doc_url));
}

sub initialize{
	my $response = $browser->get($doc_url);
	die "Couldn't get $doc_url: ", $response->status_line
		unless $response->is_success;
	$document = $response->content;
	$doc_url = $response->base;
}

sub absolute{
	my($url, $base) = @_;
	use URI;
	return URI->new_abs($url, $base)->canonical;
}

sub check_url{
	my ($url) = @_;
	print "$url:";
	my $browser = new LWP::UserAgent;
	my $response = $browser->head($url);
	if($response->is_success){
		print " OK\n";
	}
	else{
		print " BROKEN\n";
	}
}

check images

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

$ARGV[0] = 'astate.html';
if(not $ARGV[0]){
	print "usage: images html\n";
	exit;
}
my @lines = <ARGV>;
my $html = join(' ', @lines);

# extract images using the HTML::TreeBuilder

my $doc = new HTML::TreeBuilder;
# or parse filehandler: $doc->parse_file(<ARGV>);
# or parse filename: $doc->parse_file($ARGV[0]);
$doc->parse($html);
$doc->eof(); # done parsing for this tree

my @images = $doc->find_by_tag_name('img');
my $cnt = 0;
for (@images){
	my $img = $_->attr('src');
	print ++$cnt, ": $img\n" unless (not $img);
}

# $doc->dump; # output tree
$doc->delete; # delete tree (and memory)

print "\n\n";

# extract images using regular expressions
@images = ($html =~ m/img.*?src\s*=(.*?)\s/g);
$cnt = 0;
for (@images){
	my $img = ($_)?substr($_, 1, length($_)-2):undef;
	print ++$cnt, ": $img\n" unless (not $img);
}

assign_02 image downloader

#!/usr/bin/perl -w

use strict;
use HTML::TreeBuilder;
use LWP;

#$ARGV[0] = "http://www.ubuntu.com";
#$ARGV[1] = "dir";

my $url = $ARGV[0];
my $document;
my $browser = new LWP::UserAgent;

if(not ($ARGV[0] && $ARGV[1])){
	print "Make sure you entered a URL and a Directory!\n";
	exit;
}

print "processing images for $ARGV[0] ...\n";

initialize();# get the content and store in $document

my $doc = new HTML::TreeBuilder;
$doc->parse($url);
$doc->eof(); # done parsing for this tree

my @images = ($document =~ m/img.*?src\s*=(.*?)\s/g);

mkdir $ARGV[1];# make a directory to which images will be downloaded

foreach my $filename (@images){
	#my @imgName = ($filename =~ m/([\w\d]+\.\w+)$/); # it doesn't work! why??
	my @imgName = ($filename =~ m/([\w\d]+\.\w+)/gi);
	# extract the image names. when () are used then what is matched inside
	# will be returned in $1

	my $imgURL = absolute($filename, $url); # convert image relative links to absolute ones

	if(check_url($imgURL, $1)){ # modifies check_url()
		my $response = $browser->get($imgURL);
		my $content = $response->content;

		open(OF, ">./$ARGV[1]/$1");
		print OF $content;
		close OF;
	}
}

$doc->delete; # delete tree (and memory)

sub initialize{# get the content from the website
	my $response = $browser->get($url);
	die "Couldn't get $url: ", $response->status_line
		unless $response->is_success;
	$document = $response->content;
	$url = $response->base;
}

sub absolute{# convert relative links to absolute ones
	my($url, $base) = @_;
	use URI;
	return URI->new_abs($url, $base)->canonical;
}

sub check_url{# modifies check_url()
	my ($url, $imgname) = @_;
	print "$imgname:";
	my $browser = new LWP::UserAgent;
	my $response = $browser->head($url);
	if($response->is_success){
		print " OK\n";
		return 1;
	}
	else{
		print " NOT FOUND\n";
		return 0;
	}
}

backreference

#!/usr/bin/perl
# backreference.pl

while(<DATA>){
	# match html tags
	#@a = m/(<\w+\s+\w+\=(?:".*?"|'.*?'|[^"'>]*?)>.*?<\/.*?>)+?/g;# extract the matched pattern and store in the array

	# match pairs
	@a = m/([ \t]*?\([ \t]*\d+?[ \t]*,[ \t]*\d+?[ \t]*\)[ \t]*)+?/g;# extract the matched pattern and store in the array

	foreach $q (@a){
		#print "found: ", $q, "\n";
		$_ = $q;
		@pair = m/\d+/g;
		$pairs{$pair[0]} += $pair[1];
		#print %pairs,"\n";
	}
}

foreach $pair (keys %pairs){
	print "($pair,$pairs{$pair})\n";
}

__DATA__
(1,1)(1,2)	(1	,3 )
(2,1)(2,2	)(2,3)
<body title="bodytitle"> something is here </body> <b prop=a>sd</b>
<b hhhhhh='bbb'>sd</b>
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: