Perl skriptas

R
  • 7 Rugs '13

Pirkčiau perl skripto nesudėtingą programėlę. Labai reikia!

T
Techtronic
Mindaugas N.
  • 7 Rugs '13

Dovanoju

#!/usr/bin/env perl
# rdate.pl --- print dates in a range
# Author: Mindaugas <mindeunix@gmail.com>
# Created: 21 Dec 2012
# Version: 0.01

use warnings;
use strict;

use Date::Simple;
use Date::Range;

if ($#ARGV != 1 ) {
    print "usage: rdate 2012-12-20 2013-08-10n";
    exit;
}

my $d1 = Date::Simple->new($ARGV[0]);
my $d2 = Date::Simple->new($ARGV[1]);

my $range = Date::Range->new( $d1, $d2 );

for my $date ($range->dates) {
    print $date->format("%Y-%m-%d"), "n"
}

__END__

=head1 NAME

rdate.pl - Describe the usage of script briefly

=head1 SYNOPSIS

rdate.pl [options] args

      -opt --long      Option description

=head1 DESCRIPTION

Stub documentation for rdate.pl,

=head1 AUTHOR

Mindaugas, E<lt>mindeunix@gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 by Mindaugas

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 BUGS

None reported... yet.

=cut

na ir dar viena...

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

# required modules
use Net::IMAP::Simple;
use Email::Simple;
use IO::Socket::SSL;

# fill in your details here
my $username = 'user name@gmail.com';
my $password = 'password here';
my $mailhost = 'pop.gmail.com';

# Connect
my $imap = Net::IMAP::Simple->new(
    $mailhost,
    port    => 993,
    use_ssl => 1,
) || die "Unable to connect to IMAP: $Net::IMAP::Simple::errstrn";

# Log in
if ( !$imap->login( $username, $password ) ) {
    print STDERR "Login failed: " . $imap->errstr . "n";
    exit(64);
}
# Look in the the INBOX
my $nm = $imap->select('INBOX');

# How many messages are there?
my ($unseen, $recent, $num_messages) = $imap->status();
print "unseen: $unseen, recent: $recent, total: $num_messagesnn";

## Iterate through unseen messages
for ( my $i = 1 ; $i <= $nm ; $i++ ) {
    if ( $imap->seen($i) ) {
        next;
    }
    else {
    my $es = Email::Simple->new( join '', @{ $imap->top($i) } );

    printf( "[%03d] %snt%sn", $i, $es->header('From'), $es->header('Subject') );
    }
}

# Disconnect
$imap->quit;

exit;

Na ir dar vienas, sockets

use strict;
use IO::Socket;

sub  call_server {
    my ($host, $port, $kidpid, $handle, $line);
    unless (@ARGV == 2) { die "usage: $0 host port" }
    ($host, $port) = @ARGV;
    # create a tcp connection to the specified host and port
    $handle = IO::Socket::INET->new(Proto => "tcp", PeerAddr => $host, PeerPort  => $port)
        or die "can't connect to port $port on $host: $!";
    $handle->autoflush(1); # so output gets there right away
    print STDERR "\e[1;34mConnected to: $host:$port\e[0m\n";

    # split the program into two processes, identical twins
    die "can't fork: $!" unless defined($kidpid = fork());

    if ($kidpid) {                      
        # parent copies the socket to standard output
        while (defined ($line = <$handle>)) {
            print STDOUT "\e[1;31m<\e[0m ", $line;
        }
        kill("TERM" => $kidpid);        # send SIGTERM to child
    }
    else {
        print "\e[1;32m>\e[0m "; # Just funny prompt ;)
        # child copies standard input to the socket
        while (defined ($line = <STDIN>)) {
            print $handle $line;
        }
    }
}

for(;;) {call_server()}

Klausk kas butent reikalinga.

T
Techtronic
Mindaugas N.
  • 7 Rugs '13

Prikabinu ir dar viena, naudoju ji kaip /etc/issue

#!/usr/bin/perl -w
# day --- Day.lt
# Author: Mindaugas <mindeunix@gmail.com>
# Created: 19 Jan 2013
# Version: 0.01

use warnings;
use strict;

use HTML::Tree;
use LWP::Simple;
use Encode;
use Term::ExtendedColor ':attributes';

my $tree = HTML::Tree->new();
my $content = get("http://day.lt");
$tree->parse($content);


my $get_diena = $tree->look_down( _tag => 'span', title=> "Data" );
my $get_menuo = $tree->look_down( _tag => 'a', href=> "menesiai" );
my $get_sdiena = $tree->look_down( _tag => 'span', title => "Savait\x{117}s diena" );
my $get_saule = $tree->look_down( _tag => 'p', class => "left", title => "Saul\x{117}" );
my $get_menulis = $tree->look_down( _tag => 'p', class => "left", title => "M\x{117}nulis" );
my $get_patarle = $tree->look_down( _tag => 'p', title => "Patarl\x{117}" );
my @get_orai = $tree->look_down( _tag => 'a', href => "links?link=http://www.orai.lt" );
my @get_vardadieniai = $tree->look_down( _tag => 'a', href => qr/vardai\W+/ );

my @vardai;
for my $item (@get_vardadieniai) {
    push(@vardai, encode_utf8($item->as_text));
}

my $menuo = encode_utf8($get_menuo->as_text);
my $sdiena = encode_utf8($get_sdiena->as_text);
my $diena = encode_utf8($get_diena->as_text);
my $saule = encode_utf8($get_saule->as_text);
my $menulis = encode_utf8($get_menulis->as_text);
my $patarle = encode_utf8($get_patarle->as_text);
my $orasd = encode_utf8($get_orai[0]->as_text);
my $orasr = encode_utf8($get_orai[1]->as_text);
my $vardadieniai = join(', ', @vardai);
my $tdata = $sdiena." ($diena, $menuo).";



print fg("179","Savaitės diena: "), fg("71", $tdata), "\n";
print fg("179","Saulė:"), fg("74", $saule), "\n";
print fg("179","Mėnulis:"), fg("74", $menulis), "\n";
print fg("179","Patarlė: "), fg("209", $patarle), "\n";
print fg("179","Oras šiandien: "), fg("103", $orasd), "\n";
print fg("179","Oras rytoj: "), fg("103", $orasr), "\n";
print fg("179","Šiandien vardadienius švenčia: "), fg("139", $vardadieniai), "\n";

$tree->delete;

__END__


=head1 NAME

day.pl - Describe the usage of script briefly

=head1 SYNOPSIS

day.pl [options] args

      -opt --long      Option description

=head1 DESCRIPTION

Parodo sios dienos informacija:

Savaitės diena: ANTRADIENIS (5, Vasaris).
Saulė: teka 08:04 leidžiasi 17:03 ilgumas 08.59 
Mėnulis: Delčia 25 mėnulio diena 
Patarlė: Pasikelsi kaip erelis - nusileisi kaip žvirblelis
Oras šiandien: -1°C / 1°C, debesuota su pragiedruliais
Oras rytoj: -7°C / 1°C, trumpalaikis sniegas
Šiandien vardadienius švenčia: Agota, Gaudvinas, Birutė

=head1 AUTHOR

Mindaugas, E<lt>mindeunix@gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013 by Mindaugas

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 BUGS

None reported... yet.

=cut
L
  • 12 Rugs '13

@Ring rašė:
Pirkčiau perl skripto nesudėtingą programėlę. Labai reikia!

#!/usr/bin/perl
 print "Hello World.\n";

50Lt

D
  • 12 Rugs '13

Fail

Reikėjo pirma 50 lt gaut, o tada duoti kodą

O jei rimtai, tai konkretumo prašom: ko reikia, ko tikitės ir t.t.

T
Techtronic
Mindaugas N.
  • 26 Rugs '13

Turiu toki idomu skripta kuris senai man nervus gadina... Gal kas pades isspresti ji

my %data; # Initialize a hash where all data will be stored.

my $tree = HTML::Tree->new(); # Redirects to "new" in HTML::TreeBuilder.
my $content = get( 'http://meteo.lt/oru_prognoze.php');
$tree->parse($content);

sub main {
  # Gaunam visas tables pagal tag oru_prog_lt_miest
  my @miestai = $tree->look_down( _tag => "table", class => 'oru_prog_lt_miest' );
  foreach my $miesto_pav (@miestai) { # Loop perl miestus
    # Suranda miesta: Vilnius, Kaunas, Klaipėda, Šiauliai, Panevėžys
    my $mp = $miesto_pav->look_down( _tag => "td", class => 'oplm_miesto_pav' );
    print $mp->as_text, "\n"; # Miesto pavadinimas

    # Gaunam savaites dienas pagal tag oplm_sav_diena
    my @sav_diena = $miesto_pav->look_down( _tag => "span", class => 'oplm_sav_diena' );
    foreach my $savdiena (@sav_diena) {
      print "\t", $savdiena->as_text, "\n"; # Savaites diena: Pitmadienis, Antradienis, Trečiadienis ...

      # Gauti paros meta
      my @oplm_paros_meto_pav = $miesto_pav->look_down( _tag => "td", class => 'oplm_paros_meto_pav' );
      foreach my $oplm_paros_meto_pav (@oplm_paros_meto_pav) {
    print "\t\t", $oplm_paros_meto_pav->as_text, "\n"; # Paros metas: Diena, Naktis

    my $oplm_reisk = $oplm_paros_meto_pav->look_down( _tag => "div", class => 'oplm_reisk' );
    my $oplm_vejas = $oplm_paros_meto_pav->look_down( _tag => "div", class => 'oplm_vejas' );

    print p($oplm_paros_meto_pav);
    my $img = $oplm_reisk->look_down( _tag => "img" );
    my $temp = $oplm_reisk->look_down( _tag => "span", class => "oplm_t_p10" );

    my $foo1 = $img->attr('title') // '';
    my $foo2 = $img->attr('src') // '';

    print "\t\t\t", $foo1, "\n";
    print "\t\t\t", $foo2, "\n";
      }
    }
  }
}

Reikia gauti html table's ir jas visas sukelti i hash.

A
  • 9 Spa '13

Tau čia netrūksta:

use HTML::Tree;
A
  • 9 Spa '13

Pythone atrodytu kazkas tokio:

#!/usr/bin/env python
# -*- coding: utf-8 -*-

import urllib2
import re

agentas = "ubuntu"
saltinis = urllib2.Request('http://meteo.lt/oru_prognoze.php',headers={'User-Agent':agentas}) 
atveriame     = urllib2.urlopen(saltinis) 
masyvas = atveriame.read() 

miestai = re.findall('class="oplm_miesto_pav">(.*?)</td>',masyvas) 
temp = re.findall('<span class = "oplm_t_p10">(.*?)</span>',masyvas)
diena = re.findall('<span class="oplm_sav_diena">(.*?)</span>',masyvas)

## Vilnius
for i in range(1):
    vilnius=miestai[i]
    print vilnius

# 5d. VIlniaus temp
for t in range(5):
    b=temp[t]
    print b

#rezultatas gaunasi
Vilnius
15 °C
16 °C
13 °C
14 °C
13 °C
T
Techtronic
Mindaugas N.
  • 12 Spa '13

@abrius rašė:
Tau čia netrūksta:

use HTML::Tree;

Taip, nes parasiau tik dali kodo.

@abrius rašė:
Pythone atrodytu kazkas tokio:

#rezultatas gaunasi
Vilnius
15 °C
16 °C
13 °C
14 °C
13 °C

Nice, Perl'e butu:

use HTML::Tree;
use LWP::Simple;

my $tree = HTML::Tree->new();
my $content = get( 'http://meteo.lt/oru_prognoze.php');
$tree->parse($content);

my @miestai = $tree->look_down( _tag => "td",   class => 'oplm_miesto_pav' );
my @temp    = $tree->look_down( _tag => "span", class => 'oplm_t_p10' );
my @dienas  = $tree->look_down( _tag => "span", class => 'oplm_sav_diena' );

foreach my $i (1) {
  my $vilnius=$miestai[0]->as_text;
  print $vilnius, "\n";
}

for my $t (1..5) {
  print $temp[$t]->as_text, "\n";
}
__END__
Rezultatas:
Vilnius
11 °C
11 °C
13 °C
12 °C
11 °C

Turbut jau ir pats supratai, kad tai nera ko man reikia

meteo = {
   vilnius = {
      naktis = {
    temp = "",
        vejas = "",
        ...
     },
      diena = {
    temp = "",
        vejas = "",
        ...
     }
   },
   kaunas = {
      naktis = {
    temp = "",
        vejas = "",
        ...
     },
      diena = {
    temp = "",
        vejas = "",
        ...
     }
  }
  ...
}

Reikia gauti visas tables ir kas juose + exportuoti taip pat kaip table (tinka xml, json...).

T
Techtronic
Mindaugas N.
  • 12 Spa '13

abrius, o kodel pas tave skripte yra tokia line:

# -*- coding: utf-8 -*-

GNU/Emacs naudoji? Nes as kiek zinau rasosi:

# coding: utf-8
A
  • 13 Spa '13

http://www.python.org/dev/peps/pep-0263/
encodinimas

Na, o tavo atveju, man atrodo daugiausia tokiu atveju naudojama Table Extract.
http://www.mojotoad.com/sisk/projects/H ... ables.html
Bent jau kiek teko skaitineti apie parsinimus perle.

A
  • 29 Grd '13

Kažkaip prisiminiau šią temą apie meteo.lt ir dar kartą prisėdau prie kodo.
Su python gavosi tai ko tikriausiai tau ir reikia. Jei tinka py, o ne perlo variantas, tai parašyk, papostinsiu kodą. Jei limpa, galiu pabandyti parašyt GUI naudojant GTK arba indicatorių viršutinėje juostoje.

T
Techtronic
Mindaugas N.
  • 3 Sau '14

Pirma, tema yra apie perl skriptus, o ne python.
Antra GTK SUX kaip ir python (o ir visiskai nera tinkamas skriptinti).

Todel jeigu jau neturi ka daugiau parasyti apie perl, tai nematau tikslo fleiminti i sia tema.

A
  • 3 Sau '14

@Techtronic rašė:
Pirma, tema yra apie perl skriptus, o ne python.
Antra GTK SUX kaip ir python (o ir visiskai nera tinkamas skriptinti).

Todel jeigu jau neturi ka daugiau parasyti apie perl, tai nematau tikslo fleiminti i sia tema.

Mda, ka čia bepridursi, kiekvienam savo.

T
Techtronic
Mindaugas N.
  • 3 Sau '14

Stai jums dar vienas example, butu saunu kad paaiskintumet ka tas example daro

@a = (10, 30, 5, 1, 50, 20, 20); [grep 100 == eval, glob join '', map "{,+$_}", @a];
E
  • 4 Sau '14

If Python is executable pseudocode, then perl is executable line noise.
Fleiminam ir trolinam toliau.

T
Techtronic
Mindaugas N.
  • 4 Sau '14

Uzgavau vargsa pythonista, jauciuosi kaltas

Paaiskinsiu ka tas example daro, gal tas pythonistas parasys ta pati tik python, ir kodas bus trumpesnis bei paprastesnis!

@a = (10, 30, 5, 1, 50, 20, 20); [grep 100 == eval, glob join '', map "{,+$_}", @a];

Sis one-liner bando sudeti skaicius esancius array @a ir gauti rezultata 100, parasant kokius skaicius naudojo.
output:

30+50+20, 10+50+20+20

return("LOL") unless found("python user!");

G
  • 4 Sau '14

Kaukitės asmeninėse žinutėse!

Tema buvo prikelta iš mirusių ne temos autoriaus iniciatyva - todėl ją rakinu.