Szia!
Ha a számok kellenek, akkor ezt a reguláris kifejezést tudom javasolni:
$sor =~ m/^[^\d]*(\d{3})/;
$szam = $1;
Ha a tényleg a pozíció érdekel:
$sor =~ m/^([^\d]*)\d{3}/;
$poz = length( $1 );
És ezt lehet kombinálni is. 
$sor =~ m/^([^\d]*)(\d{3})/;
$poz = length( $1 );
$szam = $2;
Ajánlott olvasmány, ha Perlben sztringeket kell szabni-varrni:
http://perldoc.perl.org/perlre.html
Üdv: Mijo
Kössz a gyors választ!
Azt nem értem, hogy a $1 és $2 változók azok mikor kapnak értéket?
Azok a reguláris kifejezésből kapják az értéket, a ( és ) közötti részeket veszik fel.
$str = 'abcdef';
$str =~ m/(...)(...)/;
print $1; # 'abc'
print $2; # 'def'
Amit linkeltem doksi oldal szépen leírja az összes lehetőséget. Ha magyarul szeretnéd inkább és nem ilyen mélységekben, ezt nézd meg:
http://nyelvek.inf.elte.hu/leirasok/Perl/
Üdv: Mijo
Ez lett a megoldás:
$orszagnev = "USA Amerikai Csendes-óceáni szigetek 581 UMI UM ISO 3166-2:U";
chomp ($orszagnev);
$poz = index($orszagnev, "\t");
$orszagnev = substr($orszagnev, 0, $poz-1);
print "$orszagnev\n"
A kimenet:
USA Amerikai Csendes-óceáni szigetek
Ui.: a tabulátor szivatott, space-nek hittem.
@ Mijo:
Van itt előttem egy ~750 oldalas könyv, de valami összeszedettebb dolog kellene, majd megnézem amit linkeltél.
Thx!
[ Szerkesztve ]
Kezdetnek ezt a cikket, cikksorozatot megnézhetnéd, elég jól magyarázza az alapokat.
http://prog.hu/cikkek/443/Mintaillesztesek.html
Ha biztos vagy abban, hogy tab szeparált a sorod, ezt is használhatod:
$orszagnev = "USA Amerikai Csendes-óceáni szigetek 581 UMI UM ISO 3166-2:U";
chomp( $orszagnev );
@rekordok = split( /\t/, $orszagnev );
print "$rekordok[0]\n";
Üdv: Mijo
Sziasztok!
Egy olyan problémám lenne, hogy per-lben kilistázok pár dolgot egy fájlba. Termék kódját és a termék elkészülésének dátumát. Jelenleg a termék kódja szerint rakja sorba őket. Őszinte leszek, nem igazán értek a perl-hez. A kérdésem az lenne, hogy, hogy tudnám megoldani, hogy dátum szerint rakja sorba a termékeket?
Tehát most úgy van, hogy mondjuk A-termék: 10:00 B-termék: 8:00 C-termék: 12:00.
Helyette kéne úgy, hogy: B-termék: 8:00 A-termék:10:00 C-termék:12:00.
Előre is köszönöm a választ annak aki esetleg tud segíteni benne
Szia!
Milyen struktúrában található az adatod?
Tömb esetén mondjuk legyen ilyen:
$data = [
[ 'A', '2012.08.24. 10:00' ],
[ 'B', '2012.08.24. 08:00' ],
[ 'C', '2012.08.24. 12:00' ],
];
Ezután szépen átalakítjuk:
my @sorted = sort { $a->[1] cmp $b->[1] } @$data;
Ez alap esetben szövegeket hasonlít össze, ha nem ilyen szép az időformátumod akkor érdemes egy függvényhívással ilyenre alakítani, ami a fenti linken a map { } @data rész lenne.
my @sorted = map { $_->[1] } # visszavesszük az eredeti rekordot
sort { $a->[0] cmp $b->[0] } # rendezünk timstamp szerint
map { [ make_timestamp( $_->[1] ), $_ ] } # elkészítjük a [ timestamp, [eredeti rekord] ] struktúrát
@$data; # bemenet
Remélem ennek segítségével sikerül megoldani, de kérdezz bátran, ha elakadasz!
Üdv: Mijo
Köszi szépen, ez alapján megpróbálkozok vele 
, de igen, kicsit pontatlan voltam a leírásnál. Mert ráadásul az adatokat is máshonnan nyerem ki
Write_log("script started");
$mappres=MappNetSrc($netpath);
Write_log("mapping $netpath");
if($mappres==1)
{
my $name_date= get_timestamp4();
if(!(-d $netpath))
{
Write_log("mapping source error $_[0]");
}
else
{
Write_log("mapping source $_[0] is mapped succesfully");
if((opendir SO, $sourcedir) ==1)
{
Write_log("$sourcedir has been opened");
$today = get_timestamp3();
open out, ">", $lstfiledir.$name_date.'_'.$cell.'.lst' or die $!;
print out "Barkod;Ido\n";
while ($file = readdir(SO))
{
if ($file ne "." and $file ne "..")
{
$fidate=get_creation_time($sourcedir."\\$file");
if ($fidate gt get_timestamp())
{
Write_log("$sourcedir"."\\$file"." creation time is:".$fidate);
open input, "<","$sourcedir"."\\$file" or die $!;
#my $lines = <input>;
while (<input>)
{
#print $_;
$date_from_file =substr($_,0,10);
#print $today.'-'.$date_from_file.'';
if ($today eq $date_from_file)
{
#print $_;
my $out_date =substr($_,11,8);
my $out_ttnr =substr($_,24,6);
print out $out_date .';'.$out_ttnr."\n";
Itt a végén jön ki ugye a $out_date-nél a kimeneti dátum, a $out_ttnr, pedig a száma.
Jelenleg úgy gondoltam, hogy beviszem külön azt a részt amit most csak printelek a végén. És azt "sort"olom. ha az úgy megoldás lehet.
[ Szerkesztve ]
Szia!
Ha ilyen bonyolult az adatok kinyerése, talán inkább előbb írjad ki egy fájlba, majd a Tie:
ile modullal nyisd meg a fájlt, és rendezd a fenti módszerrel. Lehet egy kis tesztelést igényel, hogy mekkora cache-t kapjon a modul, hogy a jellemzően előforduló fájlmérettel gyorsan megbírkózzon, és ne kelljen a vinyóra pakolni folyamatosan.
Amit még tehetsz, hogy egyből Tie:ile-ba pakolod az adatokat, majd a végén rendezel újabb megnyitás nélkül.
Üdv: Mijo
sziasztok!
hátha még valaki téved errefelé...
valahogyan lehetséges a device::serialport-al vagy bármi mással perl alatt 9 bites csomagokat fogadni? a küldés nem is érdekes, csak a fogadás... adott egy speciális protokol, ahol a 8 bites adatcsomagokat mindig követi egy 9dik bit aminek szintnén van jelentősége - ez mondja meg hogy mikor kezdődik új parancs. lehet valahogy kezelni ezt az utolsó bitet? a databits csak 5,6,7,8 lehet - 9-nél ki is akad. esetleg valahogyan lehet a paritással bűvészkedni? aktiválni a paritás fogadását de ignorálni hogy hibás e a byte szerinte, viszont használni egyéb célra azt a bitet?
Sziasztok!
Kubuntu 12.04 szeretnék Perl Tk-ban ismerkedni, aztán van egy egyszerű teszt programom, és ugye a következő hibát kapom:
couldn't connect to display ":0" at /usr/lib/perl5/Tk/MainWindow.pm line 55.
Tk::MainWindow->new() at tk_proba.pl line 5.
Nem találtam megoldást rá, ami működött volna.
Kiderült a probléma, az volt, hogy rootként futattam a scriptet
Sziasztok!
Tudnátok segíteni, hogy az alábbi 2 sort megegye a scriptem?
Az első még ok, de nem tudok rájönni, hogy a második sort, hogy fogadtassam el vele. Már próbáltam a vagyot, minden karaktert, de semmi.
Az elegáns megoldás az lenne, hogy a /FM2-el is menjen, de akkor se akadjon ki, ha a /FM2 hiányzik.
#0546NNN124:CH/FT0/FM2 RS ok
#0546NNN124:CH/FT2 RS ok
if ( m!^(0546NNN124:CH/FT\d+/FM\d+) \s+ RS \s+ (\S+) \s*$!ix )
[ Szerkesztve ]
Szia!
Javaslom a non capturing groupot: (?:pattern)
Üdv: Mijo
#!/usr/bin/perl
use strict;
use warnings;
my @tests = (
'#0546NNN124:CH/FT0/FM2 RS ok',
'#0546NNN124:CH/FT2 RS ok',
);
for my $test ( @tests ) {
if ( $test =~ m!^
(\#0546NNN124:CH/FT\d+
(?:/FM\d+)?
)
\s+
RS
\s+
(\S+)
\s*
$!ix
) {
print "Match: code=[".$1."] status=[".$2."]\n";
} else {
print "No match: [". $test ."]\n";
}
}
./test.pl
Match: code=[0546NNN124:CH/FT0/FM2] status=[ok]
Match: code=[0546NNN124:CH/FT2] status=[ok]
Üdv,
Adott ez a bug.
Ki akarom javítani, csak azt nem értem, hogy hogy kell..
A ~1470 körül ki kell kommentezni a szöveget, azt értem.
CPAN:: FirstTime-ba kell beilleszteni egy sort, az oké, de a "<missing prompt> $item"; nem tudom, hogy milyen promptokat takar..
Valakinek van ötlete?
[ Szerkesztve ]
Szia!
Ez a bug 2-3 éves. Nem lett kijavítva valami frissebb verzióban?
Van arra lehetőség, hogy CPAN-ról letöltöd a tar.gz-t, és kézzel cseréled ki, aztán ráfrissítesz a Perl modulokra, hogy minden up to date legyen?
Egyébként keress ezekre a sorokra:
sub my_dflt_prompt
sub my_yn_prompt
sub my_prompt_loop
Lesz ezekben a függvényekben "prompt" függvényhívás, azok elé kell várhatóan betenni ezt:
$prompts{$item} = "<missing prompt> $item";
Persze ha egy rendes diff-et tett volna be, sokkal egyszerűbb lenne...
Üdv: Mijo
[ Szerkesztve ]
Köszönöm a választ!
Újratelepítettem a perlt, most másra panaszkodik:
Can't locate Term/ReadLine.pm in @INC (@INC contains: /usr/lib/perl5/5.10 /root) at /usr/lib/perl5/5.10/CPAN.pm line 162.
A rendszer amúgy openwrt, fordítani egyelőre nem igazán tudok rajta... Pedig virtuális gépen fut.
Hiányolja a modult a két felsorolt útvonalból (@INC tartalma).
Nézzük meg, van-e ilyen fájl egyáltalán a rendszeren!
find / -name 'ReadLine.pm' 2>/dev/null
Hogyan telepítetted a Perlt?
Elvileg ilyen hibának nem lenne szabad megjelenni a CPAN modul használatakor, mert vagy az alap Perlhez adott modulokat használja, vagy van fall back módszere.
Mi a végső cél, amihez a Perl kell?
Ennyire nem bonyolult a Perl telepítése, lásd Perlbrew.
Ha csak frissebb Perlt szeretnél, próbáld meg ezzel, bár egy routeren lehet nem lesz elég hely hozzá, de lehet van külső tárhelyed. Így a rendszer Perl érintetlen maradhat.
Üdv: Mijo
Üdv,
Végül sikerült megoldani.
Újrakezdtem az elejétől.
A term-et is telepíteni kellett...
Sziasztok!
Hogy lehetne átírni a lenti kódot úgy, hogy ha die ágra fut, akkor még 2x próbálja meg létrehozni a kapcsolatot.
Néha előfordul, hogy ez az üzenet keletkezik:
Failed to establish a socket connection with host 111.111.111.111 on port 2222
my ($acknowledge, $error_number, $error_text);
$emi = Net::UCP->new(SMSC_HOST => '111.111.111.111',
SMSC_PORT => 2222,
SENDER_TEXT => '+36111111111',
WARN => 1,
FAKE => 0
) or die("Failed to create SMSC object");
$emi->open_link() or die($!);
Szia!
A suttyó megoldást alább láthatod:
my ($acknowledge, $error_number, $error_text);
my %net_ucp_config = (
SMSC_HOST => '111.111.111.111',
SMSC_PORT => 2222,
SENDER_TEXT => '+36111111111',
WARN => 1,
FAKE => 0
);
$emi = Net::UCP->new( %net_ucp_config )
|| Net::UCP->new( %net_ucp_config )
|| Net::UCP->new( %net_ucp_config )
|| die( "Failed to create SMSC object ".$! );
$emi->open_link() || die($!);
Ha általánosan kell ez az ismétlés, lehet valami ilyennel próbálkozni:
sub retry_net_ucp {
my $obj = shift;
my $method = shift;
$obj->$method( @_ )
|| $obj->$method( @_ )
|| $obj->$method( @_ )
|| die "Error during $method on $object :".$!;
}
Üdv: Mijo
Sziasztok!
Ugyan kissé inaktív a topik, de azért hátha előkerül valaki aki tud segíteni, hogy miért nem működik a következő kód minden https lekérésnél:
#!/usr/bin/perl
use strict;
use warnings;
use POSIX qw(strftime);
use LWP::UserAgent;
use open qw(:std :utf8);
my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 } );
$ua->agent('Mozilla/5.0');
my $crypt = $ua->get("https://min-api.cryptocompare.com/data/generateAvg?fsym=ETH&tsym=USD&markets=Poloniex");
print "\n>>> ".$crypt->decoded_content." <<<\n";
my $pool = $ua->get("https://ethermine.org/api/miner_new/33babc6cd1a6c0aee80622cc742f3e2d24463397");
print "\n>>> ".$pool->decoded_content." <<<\n";
Az első címet sikeresen lekérdezi és kiírja a tartalmát, a másodikra viszont ezt dobja:
Can't connect to ethermine.org:443
LWP::Protocol::https::Socket: SSL connect attempt failed with unknown errorerror:14077438:SSL routines:SSL23_GET_SERVER_HELLO:tlsv1 alert internal error at C:/Strawberry/perl/site/lib/LWP/Protocol/http.pm line 51.
Tudnátok segíteni hogy hogyan kellene kapcsolódnom ahhoz hogy a másodikat is le tudjam kérdezni? Böngészőből megnyitva természetesen él az oldal...
Üdv!
Nekem működik mindkettő. Így is, ahogy beidézted, és úgy is, ha megfordítom a két lekérést.
Környezet:
This is perl 5, version 20, subversion 2 (v5.20.2) built for MSWin32-x86-multi-thread-64int
(with 1 registered patch, see perl -V for more detail)
Copyright 1987-2015, Larry Wall
Binary build 2002 [299195] provided by ActiveState http://www.ActiveState.com
Built Jul 20 2015 13:29:53
Imi.
Strawberry Perl 5.12 volt fent, lecsaptam és feltelepítettem én is a legújabb ActiveState 5.24-est és így pöccre megy...
Köszönöm a próbát!
Hello,
"$count = () = $string =~ /-\d+/g;"
Ha jól tudom, akkor a "=~" operátor figyeli, hogy mibe rakod az eredményt, ami lehet skalár vagy lista.
Ezzel a trükkel, amit írtál, rákényszeríted a "=~" operátort, hogy lista kontexusban adja vissza az eredményt. Ami azt jelenti, hogy visszad egy tömböt, benne a 0 vagy több egyező résszel. Aztán utána ebből egy mostmár skalár kényszerítéssel kinyered a darabszámot, mert ugye ha tömböt direktbe skalárba teszel, akkor visszakapod a tömb elemeinek a számát.
Vigyázz, így nem jó:
$count = ($string =~ /-\d+/g);
Imi.
Hello,
my $string = "-1 -2 -3 -ötszáz -1000";
my @hits = ();
my $count = @hits = $string =~ /-\d+/g;
say "count: $count";
if ($count > 0) {
for (my $i = 0; $i < $count; $i++) {
print "hits[$i]: $hits[$i]";
print ', ' if $i != $#hits;
}
}
Eredmény:
count: 4
hits[0]: -1, hits[1]: -2, hits[2]: -3, hits[3]: -1000
Imi.
[ Szerkesztve ]
