PERL SDL Game development

SDL Perl are a set of bindings to the Simple DirectMedia Layer (SDL).
'Simple DirectMedia Layer is a cross-platform multimedia library designed to provide low level access to audio, keyboard, mouse, joystick, 3D hardware via OpenGL, and 2D video framebuffer. It is used by MPEG playback software, emulators, and many popular games, including the award winning Linux port of "Civilization: Call To Power."' --www.libsdl.org
SDL Perl is an active and exciting project with many facets. Explore this website to learn more.
 --------------------------------------------------------------------------------------------------------------------
#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

# let's roll!
$app->run;
--------------------------------------------------------------------------------------------------------------------------

--------------------------------------------------------------------------------------------------------------------------
#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
           
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
           
            $app->update();
    }
);
# let's roll!
$app->run;
------------------------------------------------------------------------------------------------------------------------------------

------------------------------------------------------------------------------------------------------------------------------

#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
          
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# let's roll!
$app->run;
--------------------------------------------------------------------------------------------------------------------

------------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# let's roll!
$app->run;
------------------------------------------------------------------------------------------------------------------------------

----------------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# let's roll!
$app->run;
-----------------------------------------------------------------------------------------------------------------------------

---------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# let's roll!
$app->run;
---------------------------------------------------------------------------------------------------------------------

------------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# let's roll!
$app->run;
-----------------------------------------------------------------------------------------------------------------------
#!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
    v_x => -2.7,
    v_y => 1.8,
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
           
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
           
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# ---- handles Keyboard events
$app->add_event_handler(
    sub {
            my ( $event, $app ) = @_;
            # user pressing a key
            if ( $event->type == SDL_KEYDOWN ) {
                # up arrow key means going up (negative velocity)
                if ( $event->key_sym == SDLK_UP ) {
                    $player1->{v_y} = -500;
                }
                # down arrow key means going down (positive velocity)
                elsif ( $event->key_sym == SDLK_DOWN ) {
                    $player1->{v_y} = 500;
                }
            }
            # user releasing a key
            elsif ( $event->type == SDL_KEYUP ) {
                # up or down arrow keys released, stop the paddle
                if ( $event->key_sym==SDLK_UP or $event->key_sym== SDLK_DOWN ) {
                    $player1->{v_y} = $app->width/2;
                   
            }
        }
    }
);
# handles the ball movement
$app->add_move_handler (
    sub {
        my ( $step, $app )  = @_;
        my $ball_rect     = $ball->{rect};
       
        $ball_rect->x( $ball_rect->x +( $ball->{v_x} * $step));
        $ball_rect->y( $ball_rect->y +( $ball->{v_y} * $step));
    }
);

# let's roll!
$app->run;
--------------------------------------------------------------------------------------------------------------------------------

--------------------------------------------------------------------------------------------------------------------------------

 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;

# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 0,
    score   => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 0,
    score  => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
    v_x => -2.7,
    v_y => 1.8,
};

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
           
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
           
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# ---- handles Keyboard events
$app->add_event_handler(
    sub {
            my ( $event, $app ) = @_;
            # user pressing a key
            if ( $event->type == SDL_KEYDOWN ) {
                # up arrow key means going up (negative velocity)
                if ( $event->key_sym == SDLK_UP ) {
                    $player1->{v_y} = -500;
                }
                # down arrow key means going down (positive velocity)
                elsif ( $event->key_sym == SDLK_DOWN ) {
                    $player1->{v_y} = 500;
                }
            }
            # user releasing a key
            elsif ( $event->type == SDL_KEYUP ) {
                # up or down arrow keys released, stop the paddle
                if ( $event->key_sym==SDLK_UP or $event->key_sym== SDLK_DOWN ) {
                    $player1->{v_y} = $app->width/2;
                   
            }
        }
    }
);
# handles the ball movement
$app->add_move_handler (
    sub {
        my ( $step, $app )  = @_;
        my $ball_rect     = $ball->{rect};
       
        $ball_rect->x( $ball_rect->x +( $ball->{v_x} * $step));
        $ball_rect->y( $ball_rect->y +( $ball->{v_y} * $step));
       
        # collision to the bottom of the screen
        if ( $ball_rect->bottom >= $app->h ) {
            $ball_rect->bottom( $app->h );
            $ball->{v_y} *= -1;
        }
        # collision to the top of the screen
        elsif ( $ball_rect->top <= 0 ) {
            $ball_rect->top( 0 );
            $ball->{v_y} *= -1
        }
        # collision to the right: player1 score!
        elsif ( $ball_rect->right >= $app->w ) {
            $player1->{score}++;
            reset_game();
            return;
        }
        # collision to the right: player2 score!
        elsif ( $ball_rect->left <= 0 ) {
            $player2->{score}++;
            reset_game();
            return;
        }
    }
);

# let's roll!
$app->run;

sub reset_game {
    $ball->{rect}->x( $app->w/2 );
    $ball->{rect}->y( $app->h/2 );
}
-------------------------------------------------------------------------------------------------------------------------------

----------------------------------------------------------------------------------------------------------------------
 #!/usr/bin/perl

use strict;
use warnings;

use SDL;
use SDL::Events;
use SDLx::App;
use SDLx::Rect;
use SDLx::Text;
# create the main screen
my $app = SDLx::App->new(
    width    =>500,
    height    =>500,
    title        => 'Ping/Pong Game!',
    dt        => 0.02,
    exit_on_quit => 1,
);

my $player1 = {
    paddle => SDLx::Rect->new(10, $app->h/2, 10, 40),
    v_y        => 1,
    score   => 0,
};

my $player2 = {
    paddle => SDLx::Rect->new($app->w-20, $app->h/2, 10, 40),
    v_y       => 10,
    score  => 0,
};

my $ball = {
    rect => SDLx::Rect->new($app->w/2, $app->h/2, 10, 10),
    v_x => -2.7,
    v_y => 1.8,
};

my $score = SDLx::Text->new( font=>'font.ttf', h_align=>'center' );

$app->add_show_handler(
    sub {
            # first, clear the screen
            $app->draw_rect( [0, 0, $app->width, $app->height], 0x000000FF);
            # render the ball
            $app->draw_rect( $ball->{rect}, 0xFF0000FF);
            # each paddle
            $app->draw_rect( $player1->{paddle}, 0xFF0000FF);
            $app->draw_rect( $player2->{paddle}, 0xFF0000FF);
            $app->update();
    }
);
# ---- handles the player's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player1->{paddle};
            my $v_y        = $player1->{v_y};
          
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# handles AI's paddle movement
$app->add_move_handler(
    sub {
            my ( $step, $app ) = @_;
            my $paddle = $player2->{paddle};
            my $v_y        = $player2->{v_y};
          
            if ( $ball->{rect}->y > $paddle->y ) {
                $player2->{v_y} = 1.5;
            }
            elsif ( $ball->{rect}->y < $paddle->y) {
                $player2->{v_y} = -1.5;
            }
            else {
                $player2->{v_y} = 0;
            }
            $paddle->y( $paddle->y( $v_y * $step ));
    }
);
# ---- handles Keyboard events
$app->add_event_handler(
    sub {
            my ( $event, $app ) = @_;
            # user pressing a key
            if ( $event->type == SDL_KEYDOWN ) {
                # up arrow key means going up (negative velocity)
                if ( $event->key_sym == SDLK_UP ) {
                    $player1->{v_y} = -500;
                }
                # down arrow key means going down (positive velocity)
                elsif ( $event->key_sym == SDLK_DOWN ) {
                    $player1->{v_y} = 50;
                }
            }
            # user releasing a key
            elsif ( $event->type == SDL_KEYUP ) {
                # up or down arrow keys released, stop the paddle
                if ( $event->key_sym==SDLK_UP or $event->key_sym== SDLK_DOWN ) {
                    $player1->{v_y} = 500;
                  
            }
        }
    }
);
# handles the ball movement
$app->add_move_handler (
    sub {
        my ( $step, $app )  = @_;
        my $ball_rect     = $ball->{rect};
      
        $ball_rect->x( $ball_rect->x +( $ball->{v_x} * $step));
        $ball_rect->y( $ball_rect->y +( $ball->{v_y} * $step));
      
        # collision to the bottom of the screen
        if ( $ball_rect->bottom >= $app->h ) {
            $ball_rect->bottom( $app->h );
            $ball->{v_y} *= -1;
        }
        # collision to the top of the screen
        elsif ( $ball_rect->top <= 0 ) {
            $ball_rect->top( 0 );
            $ball->{v_y} *= -1
        }
        # collision to the right: player1 score!
        elsif ( $ball_rect->right >= $app->w ) {
            $player1->{score}++;
            reset_game();
            return;
        }
        # collision to the right: player2 score!
        elsif ( $ball_rect->left <= 0 ) {
            $player2->{score}++;
            reset_game();
            return;
        }
        # collision width player1's paddle
        elsif ( check_collision( $ball_rect, $player1->{paddle} )) {
            $ball_rect->left( $player1->{paddle}->right );
            $ball->{v_x} *= -1;
        }
        # collision width player2's paddle
        elsif ( check_collision($ball_rect, $player2->{paddle} )) {
            $ball->{v_x} *= -1;
            $ball_rect->right($player2->{paddle}->left );
        }  
    }
);

# let's roll!
$app->run;

sub reset_game {
    $ball->{rect}->x( $app->w/2 );
    $ball->{rect}->y( $app->h/2 );
}

sub check_collision {
    my ( $A, $B ) = @_;
  
    return if $A->bottom < $B->top;
    return if $A->top        > $B->bottom;
    return if $A->right      < $B->left;
    return if $A->left       > $B->right;
  
    # we have collision
    return 1;  
}
-----------------------------------------------------------------------------------------------------------------------

 --------------------------------------------- SFARSIT -----------------------------------------------------

Invata Perl

Articole de pe perltrick.com

What's new on CPAN - September 2017
Mock APIs for free using JSON Schemas
What's new on CPAN - August 2017
Plotting With Perl 6
Git bisect and Perl
What's new on CPAN - July 2017
Pretty Printing Perl 6
What's new on CPAN - June 2017
What's New on CPAN - Annual Edition
What's new on CPAN - May 2017
On Sigils
What's new on CPAN - April 2017
Getting started with XS
Thinking about Perl 6
What's new on CPAN - March 2017
AWS Cloudfront cache invalidation with Paws
Track Module Changes While You Sleep
What's new on CPAN - February 2017
Deploy a static website with AWS S3 and Paws
What's new on CPAN - January 2017
Six more things I like about 6
Laptop review: Dell XPS 13 2-in-1 (9365)
What's new on CPAN - December 2016
Obscure Perl trick: single-quote separators
Perl module names are filepaths - and that's all
What's new on CPAN - November 2016
How to build a base module
I'm speaking at the London Perl Workshop 2016
How to upload a script to CPAN
What's new on CPAN - October 2016

Articole de pe: blogs.perl.org — blogging the onion

ARTICOLE:

Announcing meta::hack v2
I'm wondering how to learn good perl
Perl 5 Porters Mailing List Summary: October 2nd-9th
Docker based Continuous Integration for perl projects
Dancer 2017 Survey: Update
Perl 6 at the London Perl Workshop - 25 Nov 2017
Fancy a Game of (Code) Golf?
Machine learning in Perl, Part3: Deep Convolutional Generative Adversarial network
Iridium Flare End-Of-Life
CPAN6 Is Here
Rakudo.js update - passes 64.65% roast test
Perl less buggy than Python?
Strawberry Perl 5.26.1.1 and 5.24.3.1 released
Call for Lightning Talks -- London Perl Workshop
Perl 5 Porters Mailing List Summary: September 25th - October 1st
Dancer Survey 2017
How to do Bit Operation Correctly in Perl? One Answer is SPVM.
Not-Perl: Career Advice for Programmers
YAML::PP Grant Report August/September 2017
6lang: The Naming Discussion Update

ATELIER->Perl si bazele de date

#!/usr/bin/perl

use DBI;
#use DBI::mysql;
use POSIX;
use SDBM_File;
use warnings;
use strict;

my @ary = DBI->available_drivers();
# Aceste linii afiseaza driverele disponibile pe sistemul dvs.
print join("\n", @ary), "\n";

my %dbm;
my $db_file = "demo.dbm";
tie %dbm, 'SDBM_File', $db_file, O_RDWR, 0 or die "error open $db_file: $!\n";

my $dbh = DBI->connect('dbi:DBM:');
$dbh->{RaiseError} = 1;

#@driver_names = DBI->available_drivers;
$dbh->disconnect;
print "Content-type: text/html\n\n";

print <<HTML;
<html>
 <head>
  <title>Salut</title>
 </head>
 <body bgcolor="white" text="blue">
  <p>SALUT!</p.
 </body>
<html>
HTML

Resurse:
http://zetcode.com/db/mysqlperl/dbi/

ATELIER -> Primul grafic plot in Perl

Module pentru grafice in Perl:

• Chart::Cliker
• Chart::OFC
• ChartDirector
• GD
• GD::Graph
• PDL::Graphics::PLplot
• PDL
• SVG::Template::Graph
• SVG::TT::Graph
• Chart::GRACE
• GraphViz
• Chart::Gnuplot
• PLplot 

Acesta este codul Perl care genereaza graficul test.png.

#!/usr/bin/perl

use PDL::Graphics::PLplot;
use PDL;
my $pl = PDL::Graphics::PLplot->new (DEV =>"png", FILE => "test.png");
my $x = sequence(10);
my $y = $x**2;

$pl->xyplot($x,$y);
$pl->close;

Resurse:
http://plplot.sourceforge.net/
http://search.cpan.org/~dhunt/PDL-Graphics-PLplot/plplot.pd
http://www.slideshare.net/dcmertens/p-lplot-talk
https://github.com/gphat/chart-clicker-examples 

ATELIER -> Extragerea datelor din site-uri HTML cu Perl

Acest script verifica numarul de telefon daca a fost portat pe siteul http://www.portabilitate.ro si afiseaza rezultatele intr-o fereastra terminal dupa cum se vede in imagine.

#!/usr/bin/perl
# Acest script verifica nr 0722270796 la ce retea este abonat
# pe siteul PORTABILITATE.ro
use warnings;
use strict;
# Utilizarea modului LWP::Simple
use LWP::Simple;

my $url = 'http://www.portabilitate.ro/ro-no-0722270796';
my $content = get $url;
die "Nu s-a incarcat $url" unless defined $content;
my @site = head($url);
print $site[1],$site[0], "\n";
if ($content =~ m/Numarul/s) {
 print 'Am gasit linia Numarul';
 #my $_=shift;
#<td style="padding:10px;" align="right"><span id="ctl00_cphBody_lblCurrentOperator">Operator curent:</span></td>
#<td style="color:red;padding:10px; font-weight:bold;"><a id="ctl00_cphBody_lnkOperator">RCS &amp; RDS</a></td>
 #m{<a id="ctl00_cphBody_lnkOperator">\s+</a>(\d+)} || die;
 #return $1;
}else{
 print "Nu am gasit linia";
}
if ($content =~ m/id="ctl00_cphBody_lnkOperator"/s) {
 print 'Am gasit linia Numarul';
}else{
 print "Nu am gasit linia";
} 
my( $m ) = $content =~ m/<a id="ctl00_cphBody_lnkOperator">(.*?)<\/a>/;
print "\n Am gasit Operatorul: $m" if defined $m;
# <span class="ContentTitle">
                # Numarul 0722270796 este portat
            # </span>
my ($nr)= $content =~ m/<span class="ContentTitle">(.*?)<\/span>/s;
print "\n $nr" if defined $nr;
#<a id="ctl00_cphBody_lnkOperatorInitial">VODAFONE ROMANIA</a>
my ($operator)= $content =~ m/<a id="ctl00_cphBody_lnkOperatorInitial">(.*?)<\/a>/;
print "\n Operatorul vechi: $operator";
# my @matches;
# while ($content =~ /Numarul/g) {
 # push @matches, $1;
 
# # }
# foreach my $m(@matches){
 # print $m, "\n";
# }

Resurse:
http://www.perlmonks.org/?node_id=10698

#!/usr/bin/perl

use warnings;
use strict;

use LWP::Simple;

my $url = 'http://www.portabilitate.ro/ro-no-0722270796';
my $content = get $url;
die "Nu s-a incarcat $url" unless defined $content;
my @site = head($url);
print $site[1],$site[0], "\n";
if ($content =~ m/Numarul/s) {
 print 'Am gasit linia Numarul';
 local $_=shift;
#<td style="padding:10px;" align="right"><span id="ctl00_cphBody_lblCurrentOperator">Operator curent:</span></td>
#<td style="color:red;padding:10px; font-weight:bold;"><a id="ctl00_cphBody_lnkOperator">RCS &amp; RDS</a></td>
 m{<a id="ctl00_cphBody_lnkOperator">\s+</a>(\d+)} || die;
 return $1;
}else{
 print "Nu am gasit linia";
}
if ($content =~ m/id="ctl00_cphBody_lnkOperator"/s) {
 print 'Am gasit linia Numarul';
}else{
 print "Nu am gasit linia";
}  

#!/usr/bin/perl -w

use strict;
use LWP::Simple;

my $url = "http://www.wunderground.com/cgi-bin/findweather/getForecast?"
        . "query=";
my $ca = get("${url}95472"); # Sebastopol, California
my $ma = get("${url}02140"); # Cambridge, Massachusetts

my $ca_temp = current_temp($ca);
my $ma_temp = current_temp($ma);
my $diff = $ca_temp - $ma_temp;

print $diff > 0 ? "California" : "Massachusetts";
print " is warmer by ", abs($diff), " degrees F.\n";

sub current_temp {
  local $_ = shift;
  m{<tr ><td>Temperature</td>\s+<td><b>(\d+)} || die "No temp data?";
  return $1;
}