This section is the place to post your general code offerings.

CUFP's
WWW::Mechanize inventory update for musicstack.com
No replies — Read more | Post response
by maruhige
on Jun 24, 2014 at 11:21

    Spent a bit longer on this than needs be with hindsight, so I figure i'd share the product of that time

    Music stack doesn't have much in the way of an API, instead it requires manual navigation to upload change files. The change file also has an enormous amount of saved customisations on the upload form which would be numbingly tedious to fill out manually in the $mech itself

    So! here's a short and effective means of putting inventory files up on Music Stack, using WWW::Mechanize to navigate from the login screen to the upload screen.

    use WWW::Mechanize; my $username = 'x@example.com'; my $password = 'mypw'; my $upfile = '/path/to/additions.csv'; my $mech = WWW::Mechanize->new() or die $!; $mech->cookie_jar(HTTP::Cookies->new()); $mech->get(q#http://www.musicstack.com/login.cgi#) or die $!; #need to use sequential identifiers when forms are either nameless + or share the same name $mech->form_number(3); $mech->field ('user' => $username); $mech->field ('pw' => $password); $mech->click_button(name => "login"); #now on the user account page $mech->follow_link( text => 'Upload' );#case sensitive #now on the inventory management page $mech->form_name('form'); # 2 forms on page - other is 'search' # 3 options here - add is incremental $mech->set_fields('delete' => 'add'); $mech->field('upfile' => $upfile ); $mech->click_button(value => 'Upload File'); #the file is uploaded and the status screen displayed here print $mech-> content();
Tk Tartaglia's triangle fun - Pascal's triangle fun
2 direct replies — Read more / Contribute
by Discipulus
on Jun 17, 2014 at 12:56
           Dedicated to my father who studied the other Tartaglia
    After more then one month of sparetime works and 35 subversion i'm very happy to present you:

    16 fun experiments with the Tartaglia's triangle

    This is a Perl Tk program that shows many of the properties of such incredible triangle: you can modify the aspect of the triangle itself and of the output window and of the help pages too.

    In Italy the name of the arithmetic triangle is dedicated Tartaglia so I want to present with this name.

    I'm not a mathematician and the math used in the code is something late Middle Age, but works.

    If someone wish to improve this program i will be very happy: inernal math used, better explication in output windows, or even typos spot(i'm not english native, as you can guess) or suggestion are welcome. In fact i wish this program to be used in educational context.

    Have fun!

    L*


    Update 1/07/2014: commented lines 188-190 and 555 (printing debug info for windows dimensions and positioning).

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Storing Experience for Posterity
4 direct replies — Read more / Contribute
by GotToBTru
on Jun 12, 2014 at 10:34

    I put the following together to scrape experience, level and writeups off my profile page and store it in a text file on my computer, to record my progress through the Monastery. A scheduled task runs this once a day.

    use strict; use warnings; use LWP::Simple; use URI::URL; my $date=`ECHO %DATE:~10,4%%DATE:~4,2%%DATE:~7,2%`; # YYYYMMDD my $url = url('http://perlmonks.org/?node_id=844862'); my $content = get($url); $content =~ s/\cJ//g; $content =~ s/\cM//g; my ($experience, $level, $posts) = ($content =~ /Experience:\D+(\d+).+ Level:.+([A-Z][a-z]+\s+\(\d+\)).+ Writeups:.+>(\d+)</x); open my $ofh, '>>','perl_xp.dat'; printf $ofh "%d,%d,%d,%s\n",$date,$experience,$posts,$level; close($ofh);

    There is probably a way to do this in Javascript that could be included in the Free Nodelet, but that's beyond my skill level.

    Update

    Improved version here.

    1 Peter 4:10
Snoopy Calendar
No replies — Read more | Post response
by timpoiko
on May 18, 2014 at 04:08

    I heard that every real programmer has a Snoopy Calendar dated from 1969. Because Fortran felt slightly uncomfortable for me, I decided to make own version with Perl. In my country first day of week is Monday. You can modify the zeller function if this is a question. This is not obfuscated code, but this code is not written as clearly as possible. Since this code requires some data, at bottom of message there is a link to .tar.bz2. Have fun.

    #!/usr/bin/perl # Copyleft Timo Poikola use strict; my %N; $N{0} = " 000 0 00 00 0 000 "; $N{1} = " 1 11 1 1 11111"; $N{2} = " 222 2 2 2 2 22222"; $N{3} = "33333 3 33 3 3 333 "; $N{4} = " 4 44 4 4 44444 4 "; $N{5} = "555555 5555 55555 "; $N{6} = " 666 6 6666 6 6 666 "; $N{7} = "77777 7 7 7 7 "; $N{8} = " 888 8 8 888 8 8 888 "; $N{9} = " 999 9 9 9999 9 999 "; $N{_} = " "; my @t = localtime(time); my $a = defined $ARGV[0]? $ARGV[0] : $t[5]+1900; my @dim = (undef,31,28,31,30,31,30,31,31,30,31,30,31); sub pn { my $n = shift; my $r = shift; if ($n eq "I") { print " I "; } else { print " "; print substr $N{$n},5*$r,5; print " "; } return $n; } sub zeller { use integer; my $month = shift; my $day = shift; my $year = shift; my $aa = (14 - $month) / 12; my $y = $year - $aa; my $m = $month + 12*$aa - 2; 1+(--$day + $y + $y/4 - $y/100 + $y/400 + (31*$m)/12) %7; } sub lightyear { my $ly = shift; return 1 if (0 == $ly % 4 and 0 != $ly % 100 or 0 == $ly % 400); return 0; } my $text = do { local( @ARGV, $/ ) = "snpdat.txt" ; <> } ; my @str = split //, do {local (@ARGV, $/ ) = "data.txt" ; <> } ; my $ascii = ""; for my $i (0..scalar(@str)/2-1) { $ascii .= $str[2*$i + 1] x unpack("C", $str[2*$i]); } my @art = split(/1/, $ascii); my $d="DAY"; sub label { my $z = shift; $z--; substr $text, $z*553,553; } $dim[2]++ if lightyear($a); for my $cnt (1..13) { my $aux; my $aux2; my $s; my $mm = $cnt; if ($cnt == 13) { $a++; $mm = 1; } $aux = zeller($mm,1,$a); if ($aux > 1) { if ($aux >= 3) { $aux--; $s .= "__I"x$aux; } else { $s .= "__I"; } } for $aux (1..$dim[$mm]) { if ($aux < 10) { $s .="_"; } $s .= $aux; if ((zeller($mm,$aux,$a) == 7) && ($aux < $dim[$mm])) { $s .= "\n"; } elsif ((zeller($mm,$aux,$a) == 7) && ($aux == $dim[$mm])) { $s .= " "; } else { $s .= "I"; } if (($aux == $dim[$mm]) && (zeller($mm,$aux,$a)) < 7) { $aux2 = 7-zeller($mm,$aux,$a); if ($aux2 == 1) { $s .= "__"; } else { $s .= "__I"x($aux2-1); } } } my @arr = split(/\n/, $s); my @l = split(/\n/, label($mm)); print @art[$cnt],"\n\n"; $a =~ /(.)(.)(.)(.)/; print" "x8;pn($2,0);print" "x13,$l[0]," "x13;pn($3,0);print "\n"; print" "x8;pn($2,1);print" "x13,$l[1]," "x13;pn($3,1);print "\n"; print" ";pn($1,0);pn($2,2);print" "x13,$l[2]," "x13;pn($3,2);pn($4,0 +);print"\n"; print" ";pn($1,1);pn($2,3);print" "x13,$l[3]," "x13;pn($3,3);pn($4,1 +);print"\n"; print" ";pn($1,2);pn($2,4);print" "x13,$l[4]," "x13;pn($3,4);pn($4,2 +);print"\n"; print" ";pn($1,3);print" "x20,$l[5]," "x20;pn($4,3);print "\n"; print" ";pn($1,4);print" "x20,$l[6]," "x20;pn($4,4);print "\n\n"; print " "x9,"MON$d"," "x12,"TUES$d"," "x10,"WEDNES$d"," "x9,"THURS$d +"," "x11,"FRI$d"," "x11,"SATUR$d"," "x10,"SUN$d\n"; for (@arr) { print " "," "x20,"I"," I"x5," "x20,"\n"; for my $x (0..4) { print " ";s/(.)/pn($1,$x)/eg;print"\n"; } print " "," "x20,"I"," I"x5," "x20,"\n"; print " ","-"x20,"I","-----------------I"x5,"-"x20,"\n"; } print "\n\n"; }
    http://ig.fi/snoopy.tar.bz2 : Datafiles and source
Tk image resizer
1 direct reply — Read more / Contribute
by Discipulus
on May 05, 2014 at 07:08
    Hello monks,

    was a rainy saturday and i need some resized images for a new website (a Dancer2 one).. but i'm digressing.
    This script globs all jpg images in the current directory and creates one or more resized ones with new names. EXIF data are cleaned in new images whilst you can view some of them, for your convenience, in the preview of the original image.

    Only argouments accepted are string in the form width x heigth x descr as in 1204x768xBig
    You can specify more then one format passing, for example: 1204x768xBig 640x480xMed 200x100xMin
    The description in the string is optional: if not present is used the given ratio: 1204x768 wil be appended to the file name given.

    Using Image::Resize the ratio is maintained for the original photo, ie only the width will be used, while the height will be adjusted as needed.

    The code is redundant and somehow ugly, but Perl does not complains about this..

    HtH
    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Indicator Applet by Gtk2-perl of Launcher
No replies — Read more | Post response
by toskanosu
on May 01, 2014 at 13:28

    Hello, everyone.

    Please permit my incorrect or poor english.

    I saw many Indicator Applet for Ubuntu Unity. Almost all Applet-s are made by Python. I do not see Applet by perl, yet. So, i made Indicator Applet by Gtk2-perl of Launcher.

    These are a program and a need file. Please refer for details: http://www.eonet.ne.jp/~toskanosu/

    #! /usr/bin/perl # # Copyright 2014 toskanosu (2014.04.23-05.01 run-perl.pl as /usr/local +/bin/run-perl) # (This is a perl Indicator Applet) (ubuntu Unity libappindicator) # # AUTO menu update is not implemented for Run_Any_File modified, but m +anualy. # use strict; use warnings; use Gtk2 '-init'; use Glib qw/TRUE FALSE/; use English; use utf8; use Encode; use Cwd; use Gtk2::AppIndicator; # libgtk2-appindicator-perl installed by Synap +tic my $HOME=$ENV{"HOME"}; my $USER=$ENV{"USER"}; my $Run_Any_File = $HOME."/.run-any"; # you can change contents in thi +s file. my $Myself_Icon="/usr/share/ubuntu-tweak/pixmaps/emblem-ohno.png"; # y +ou can change as you like. my $White = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0xFFFF); my $Red = Gtk2::Gdk::Color->new (0xFFFF,0,0); my (@Head,@Body,@Kind,$AppIndicator,$ImageMenuItem); sub Trim { my $v = shift; $v =~ s/^\s*(.*?)\s*$/$1/; return $v; } sub Left { return substr($ARG[0],0,$ARG[1]); } sub IsIt { return index($ARG[0],$ARG[1]) > -1 } sub Make_About { my $AboutDialog=Gtk2::AboutDialog->new; $AboutDialog->set_program_name('run-perl'); $AboutDialog->set_comments("Indicator Applet made by perl.\n". "Menu Launcher mde by toskanosu."); $AboutDialog->set_website('http://www.eonet.ne.jp/~toskanosu/'); $AboutDialog->signal_connect(response => sub { $AboutDialog->destr +oy }); $AboutDialog->show_all; } sub Get_Kind { my $Body=shift; return(0) if $Body eq ''; my @Line1=split(/\./,$Body); my $Ex=lc($Line1[$#Line1]); my @Line2=split(/ /,$Body); if ($Ex eq 'exe') { return 1 } # sh elsif($Ex eq 'pl') { return 2 } # perl elsif($Ex eq 'rb') { return 8 } # ruby elsif($Ex eq 'py') { return 3 } # python elsif($Ex eq 'sh') { return 4 } # sh elsif(Left($Body,4) eq 'http' || Left($Body,5) eq 'file:') { return 5 } # http or file +: elsif(IsIt($Body,'/') && $#Line2 == 0) { return 6 } # dir else { return 7 } # sh command } sub MenuItem_Clicked { my $Kind=$Kind[$ARG[1]]; return(TRUE) if $Kind == 0; my $Body=$Body[$ARG[1]]; if ($Kind == 2) { system("/usr/bin/perl ".$Body) } elsif($Kind == 8) { system("/usr/bin/ruby ".$Body) } elsif($Kind == 3) { system("/usr/bin/python ".$Body) } elsif($Kind == 5) { system("/usr/bin/xdg-open ".$Body) } elsif($Kind == 6) { system("/usr/bin/nautilus ".$Body) } else { system("/bin/sh -c '".$Body."'") } # 1, 4, 7 FALSE; } sub Set_Image { my $ImageMenuItem=shift; my $Stock_ID=shift; my $Image=Gtk2::Image->new; $Image->set_from_icon_name($Stock_ID,'menu'); # Get icon only! $ImageMenuItem->set_image($Image); $ImageMenuItem->set_always_show_image(TRUE); # Required! } sub Set_Icon { my $Menu=shift; my $Inx=shift; my $Stock_ID=shift; my $ImageMenuItem=Gtk2::ImageMenuItem->new($Head[$Inx]); Set_Image($ImageMenuItem,$Stock_ID); $ImageMenuItem->signal_connect("activate"=> \&MenuItem_Clicked, $I +nx ); $Menu->append($ImageMenuItem); } sub Set_My_Icon { my $Title=shift; my $Stock_ID=shift; $ImageMenuItem=Gtk2::ImageMenuItem->new($Title); my $Image=Gtk2::Image->new_from_stock($Stock_ID,'menu'); # Get ico +n and title $ImageMenuItem->set_image($Image); $ImageMenuItem->set_always_show_image(TRUE); } sub Make_Menu { @Head=(); @Body=(); @Kind=(); # Initialize my $Menu=Gtk2::Menu->new; $AppIndicator->set_menu($Menu); open(File, $Run_Any_File) || die "no file: ".$Run_Any_File; while(<File>) { chomp($ARG); next if Left($ARG,1) eq '#'; # comment next if $ARG eq ''; my @Line=split(/\|/,$ARG); my $Head=Trim($Line[0]); my $Body=$#Line >= 1 ? Trim($Line[1]) : ""; $Body =~ s/\{HOME\}/$HOME/; $Body =~ s/\{USER\}/$USER/; push(@Head,decode_utf8($Head)); push(@Body,$Body); push(@Kind, +Get_Kind($Body)); } close(File); if($#Head > -1) { for (0..$#Head) { if ($Kind[$ARG] == 1) { Set_Icon($Menu,$ARG,'application +-x-executable') } # exe elsif($Kind[$ARG] == 8) { Set_Icon($Menu,$ARG,'application +-x-ruby') } # ruby elsif($Kind[$ARG] == 2) { Set_Icon($Menu,$ARG,'application +-x-perl') } # perl elsif($Kind[$ARG] == 3) { Set_Icon($Menu,$ARG,'text-x-pyth +on') } # python elsif($Kind[$ARG] == 4) { Set_Icon($Menu,$ARG,'application +-x-executable') } # sh elsif($Kind[$ARG] == 5) { Set_Icon($Menu,$ARG,'text-html') + } # http elsif($Kind[$ARG] == 6) { #nautilus if ($Body[$ARG] eq $HOME) { Set_Icon($Menu, +$ARG,'gtk-home') } elsif($Body[$ARG] eq 'computer:///') { Set_Icon($Menu, +$ARG,'computer') } elsif($Body[$ARG] eq 'network:///') { Set_Icon($Menu, +$ARG,'folder-remote') } elsif($Body[$ARG] eq 'trash:///') { Set_Icon($Menu, +$ARG,'user-trash') } else { Set_Icon($Menu, +$ARG,'gtk-directory') } } elsif($Kind[$ARG] == 7) { Set_Icon($Menu,$ARG,'application +-x-executable') } # sh command elsif($Head[$ARG] eq '--TEAROFF--') { $Menu->append(Gtk2::TearoffMenuItem->new); # --------- } elsif($Head[$ARG] eq '--SEPARATOR--') { $Menu->append(Gtk2::SeparatorMenuItem->new); } else { # comment my $MenuItem=Gtk2::MenuItem->new($Head[$ARG]); $Menu-> +append($MenuItem); } } } $Menu->append(Gtk2::SeparatorMenuItem->new); # --------- Set_My_Icon('Refresh','gtk-refresh'); $ImageMenuItem->signal_connect("activate"=> \&Make_Menu); $Menu->append($ImageMenuItem); Set_My_Icon('About','gtk-about'); $ImageMenuItem->signal_connect("activate"=> \&Make_About); $Menu->append($ImageMenuItem); Set_My_Icon('Quit','gtk-quit'); $ImageMenuItem->signal_connect("activate",sub { Gtk2->main_quit; } +); $Menu->append($ImageMenuItem); $Menu->show_all(); } $AppIndicator=Gtk2::AppIndicator->new("Perl_AppIndicator",$Myself_Icon +); $AppIndicator->set_icon_theme_path(getcwd()); Make_Menu(); $AppIndicator->set_active(); Gtk2->main; TRUE; __END__

    The following file includes a japanese kanji. Sorry.

    # # 1st column # is a comment line. # This file is UTF-8 coding for Linux. # Spec by toskanosu. # This file is made in ~/.run-any # PATH end by ".pl" ==> start by perl # PATH end by ".py" ==> start by python # PATH end by ".sh" ==> start by sh (without STDIN) # PATH end by ".exe" ==> start by sh (for wine) # PATH start by "http" ==> start by xdg-open (URI) # no PATH ==> menu displayed (comment) # --SEPARATOR-- ==> Gtk2 separator (-------) # PATH without slash ==> start by sh (without STDIN) # PATH include space ==> start by sh (without STDIN) # else ==> start by xdg-open (folder) # # {HOME} is changed to ~ # {USER} is changed to your user name # # ---LABEL---- | ---PATH------ --------------- important --------------- &#9632; Paster | {HOME}/perlsrc1/paster2sub.pl Run GetTV (runner2) | {HOME}/perlsrc1/runner2.pl GetRSS &#12288;&#12288; | {HOME}/perlsrc1/getrssN1.pl GetTV 1-day &#12288;&#12288; | perl {HOME}/perlsrc1/gettv.p +l 0 Run-Show &#12288; | {HOME}/perlsrc1/runner3x.pl geany ~/.run-any | geany {HOME}/.run-any geany ~/MenuItem.linux | geany {HOME}/MenuItem.linux --------------- Folder --------------- &#12467;&#12531;&#12500;&#12517;&#12540;&#12479;&#12540;&#12288; + | computer:/// perlsrc1 | {HOME}/perlsrc1 pysrc | {HOME}/pysrc Toshi-HP | {HOME}/toshi_hp Free Icon | {HOME}/Hozon1/free-png ubuntu tweak png | /usr/share/ubuntu-tweak/pixmaps --SEPARATOR-- --------------- exec --------------- K-&#23558;&#26827; | wine /media/toshiaki/C-500GB +/K-Shogi/K-Shogi.exe Win&#29992;DLL&#31561; | winetricks XPad | xpad nautilus restart | nautilus -q world watch | gnome-clocks --TEAROFF-- -------------- install-------------- Ubuntu Software Center | software-center Synaptic Package Manager | synaptic-pkexec --------------- setup --------------- Set StartUp | gnome-session-properties ubuntu-tweak | ubuntu-tweak gnome-tweak-tool | gnome-tweak-tool unity-tweak-tool | unity-tweak-tool unsettings | unsettings CompizConfig | ccsm #EOF----------------------------------
read raw mouse data in Linux
No replies — Read more | Post response
by Lotus1
on Apr 30, 2014 at 16:58

    I'm working on a stepper motor project with the Raspberry Pi and I needed to detect when an an optical mouse stops seeing motion. I'm using the mouse in place of an optical encoder to tell me when the stepper is stalled.

    This code works on Raspbian with or without X. Since POSIX::read() waits for mouse events at first I thought I would have to use a second thread to poll somehow. Then I found the alarm function in "Programming Perl".

    I found solutions for reading raw mouse data in Python but of course I wanted to do it in Perl. And I'm sharing it here so others can find it. (The oo Mouse module makes websearches for Perl related mouse projects difficult to find.)

    #!/usr/bin/perl use warnings; use strict; use POSIX; use Time::HiRes qw( ualarm ); ### Detect if the mouse is moving or stopped. Tested on Raspian Linux. ### Adapted from http://www.the-ownage.com/?p=835 ### The guy soldered a pair of wires to a mouse button ### and used it to detect water leaks and send himself notifications. my $fd; my $buf; my $mousedev="/dev/input/mouse0"; $fd = POSIX::open($mousedev, &POSIX::O_RDONLY) or die ("Cannot open $m +ousedev: $!"); my $stopped = 1; print time,"--Mouse is stopped--\n"; while( 1 ) { local $SIG{ALRM} = sub { print time,"--Mouse is stopped--\n" if ! $stopped; #on tra +nsition $stopped = 1; ### turn on output bit on Raspberry Pi $buf =""; }; ualarm 200_000; ## time out after 0.2 seconds POSIX::read($fd, $buf, 1); if ( $buf and $stopped ) { print time,"--Mouse is moving--\n"; $stopped = 0; ### turn off output } ualarm 0; }
Substitution cipher or keyboard layout demo
1 direct reply — Read more / Contribute
by ohcamacj
on Apr 27, 2014 at 00:02

    As a longtime dvorak user, I've occassionally noticed that it's extremely unbalanced left-right. The right hand, does almost all of the work.

    A few times, I've tried using xmodmap to create a mirrored keyboard layout; but this didn't work well. Since my typing speed falls 10x, it's always faster to just leave the keyboard layout untouched.

    Wasn't there some way to practice a new keyboard layout, without constantly running

    setxkbmap -layout dvorak -option ctrl:nocaps; xmodmap new-layout; setxkbmap -layout dvorak -option ctrl:nocaps; xmodmap ~/.xmodmaprc
    to switch back and forth ?

    So, wrote a perl script, to apply what-if-the-keyboard was a different layout transform to input.

    That alone wouldn't be interesting enough to post. A trivial one-liner with s/./$map{$&} ? $map{$&} : $&/eg; is sufficient.

    But, it was sorta clumsy to use. In a shell, a lot of keystrokes are necessary (up-arrow, backspace, backspace, backspace) to change the text. So, I eventually wrote a terminal ui for it, to make it easier to use.

    The code

    Dvorak keyboard users are rare, people who are trying to become left-handed are extremely rare. So, change $leftside and $rightside to something else, more meaningful.

Perl Script to extract host list from Symmetrix DMX Array.
No replies — Read more | Post response
by pmu
on Apr 18, 2014 at 15:43

    Hi,

    As an Storage Administrator who works on EMC Symmetrix Storage Array, many times, I have to extract a list of all the hosts connected to the storage array. This needs to be extracted by logging into the storage array and running a command like symmask -sid 12345 list logins, and then the hostnames are to be extracted from the list and stored in a text file. If hostnames are not reflecting, then the corresponding World Wide Name (WWN) of the Host HBA should be included in the list. To ensure dual or quadruple redunduncy, each host will show two paths or four paths, so the duplicates need to be removed and the host names need to be in Upper case. There are many such arrays, and a seperate file needs to be created for each of them.

    Sometimes, the file has to be regenerated every few minutes due to some changes/requirements and the old file must be deleted, else wrong records will be captured. The script picks the array name from the command output stated earlier. This script is working fine on Redhat Linux 6.4 running Perl Version 5.10.1 and on Windows 2003 running Strawberry Perl version 5.18.2.2.

    Hoping fellow EMC Administrators will find this script useful. Please note - I dont get to write scripts on a regular basis, so there's quite a lot of improvement that can be done with the script. If so, kindly let me know. Here's the script:

    Here's the test file that's fed to the script. The actual file will have much more entries than what's given below.

    And here is the output:

    C:\Users\pmu\Documents\perl\work>perl hostnames.pl test_list_logins.tx +t Deleting existing "hostlist_hostnames.pl_000190101234.txt". A new one +will be created. ********************************************************************** +******************* Please Check the file - [ C:\Users\pmu\Documents\perl\work\hostlist_ho +stnames.pl_000190101234.txt ]. NULLs are replaced with corresponding pWWNs. ********************************************************************** +******************* C:\Users\pmu\Documents\perl\work

    And here's what the file - hostlist_hostnames.pl_000190101234.txt contains:

    -------------------------------------------------------------- Perspectum cognitio aeterna --------------------------------------------------------------
Sidef - The experimental scripting language written in Perl
No replies — Read more | Post response
by trizen
on Apr 17, 2014 at 09:28

    I remember that, a few years ago, someone asked a question about Writing a Programming Language in Perl. I was a little bit skeptical at first, but very interested in this subject too. Few years passed by, until me and a friend of mine decided to create a toy-language from scratch without using anything else, but Perl. We wanted it as simple as possible and powerful as much as it can be.

    Object-oriented paradigm must be the answer, right? We thought so. And it is, partially. The language we designed is called Sidef. It strongly follows the OO style; each piece of data is stored inside objects with own methods and operators defined to work on that type of data. (actually, in Sidef, an operator and a method are the same thing)

    Simplicity? What do we mean by something simple? How simple can a programming language be defined? This is the main question that I wanted to answer. A year after the start of the project, I think we found a reasonable answer: objects and methods. This is, I think, the simplest way a programming language can be defined. But, what about conditional expressions? They can't be created by objects and methods only, right? Wrong! They can:

    if (false) { } elsif (true) { } else { }
    is equivalent with:
    var condObj = if(false); # 'if' object condObj do { } elsif(true) do { } else { }
    What? Yes, the above code is valid code. if(expr) returns an object which accepts methods like 'do', 'elsif' and 'else'.
    This proves how flexible an OO language can be. The basic definition of Sidef is this: obj.method(obj), with minor exceptions.

    Objects are:
    • strings
    • files
    • numbers
    • arrays
    • everything else
    while methods are functions defined for that kind of object which returns other objects.

    In Sidef, the numbers have a very special purpose. We see the language as a toy-language and recommend to be seen only this way, but still it can be used in simple home-made projects, especially in those involving number computation. Numbers, by default, are represented by Math::BigFloat objects, giving them a better precision at the cost of being somewhat slower than Perl's standard representation for numbers (-Nfast).

    Perl related features:
    • any Sidef script can be compiled to a stand-alone Perl program (-c)
    • can load and use Perl modules (both OO and functional)
    • can evaluate arbitrary Perl code (Sys.eval(""))
    • supports memoization via Memoize (-M) (not enabled by default)
    • no CPAN module is required

    The project is available at: https://github.com/trizen/sidef
    The documentation page: https://github.com/trizen/sidef/wiki
    The RosettaCode page: http://rosettacode.org/wiki/Sidef

    The very basic concept of the language can be found at: https://github.com/trizen/sidef/blob/master/utils/sidef_concept.pl

check modules used by a script and their version
2 direct replies — Read more / Contribute
by Discipulus
on Apr 03, 2014 at 06:26
    another CUFP or better WICDWMBP (what i can do with my baby Perl)..
    Reading this post i'm started wondering if there was a way to wrap an existing script and grab modules it uses without exucuting it.
    Obviously the answer or part of it was in the monastery: here
    I very liked the
    perl -d:Modlist=options script.pl perl -MDevel::Modlist=options script.pl # equivalent
    part but, unfortunately it executes the script.pl
    Also liked the tachyon-II hack, but you have to edit the script.pl and i'm too lazy.
    No hope to use $^C = 1 as pointed wisely by shmem

    The UNITCHECK do the trick! Never known it seems quite usefull for this task: read about it

    #!perl #use strict; #commented to not pollute %INC #use warnings;#commented to not pollute %INC my $file = $ARGV[0]; my $content = do { open my $fh, '<', $file or die $!; local $/; <$fh> +}; my $begin =<<'THEEND'; UNITCHECK { no strict; # access $VERSION by symbolic reference no warnings qw (uninitialized); print map { s!/!::!g; s!.pm$!!; sprintf "%-20s %s\n", $_, ${"${_}::VERSION"} } sort keys %INC; exit; }; THEEND eval $begin.$content; print $@ if $@;
    Enjoy the results!
    HtH
    L*

    UPDATE 9 april 2014: BE CAREFULL, as stated by davido and also by LanX in other post, BEGIN blocks are executed anyway. In fact BEGIN blocks come first, in order of definition, then come UNITCHECK blocks and, being that block prepended to the original code in the above program, it will be executed just after the last BEGIN block and just before any UNITCHECK defined in the original program passed in via @ARGV. In the case of perl -c -d:TraceUse script.pl all the BEGIN UNITCHECK CHECK blocks are executed.

    Here two examples to demonstrate where the -c ends his operations (a simplified version of 16 pillars of wisdom):
    perl -c -e "BEGIN{print qq(1-begin\n)}; UNITCHECK {print qq(2-unitcheck\n)}; CHECK {print qq(3-check\n)}; INIT {print qq(4-init\n)}; print qq(5-main\n); END{print qq(6-end\n)}" __OUTPUT__ 1-begin 2-unitcheck 3-check -e syntax OK # the same code without -c __OUTPUT__ 1-begin 2-unitcheck 3-check 4-init 5-main 6-end
    L*
    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Automatic chrome extension generator
No replies — Read more | Post response
by Discipulus
on Mar 25, 2014 at 17:27
    Well, I needed to add few extensions to the browser and i ended with this...
    It generates a working chrome extension with only a context menu that acts as 'Search with <your search engine>'.

    You'll call the script with only 2 args: a_description and a partial URL
    as in extgen.pl Cpan_search http://search.cpan.org/search?query=
    Then you point chrome to chrome://extensions/, check 'Developer Mode' and choose 'Load an unpacked extension' and browse to early created folder containing the extension.

    Here is the code:
    #!/usr/bin/perl use strict; use warnings; my $folder = $ARGV[0]; my $url = $ARGV[1]; (my $descr = $folder) =~ s/_+/ /g; my $longname = 'Perl genarated extension - '.$descr; mkdir $folder or die "Cannot create $folder: $!"; chdir $folder or die "Cannot enter $folder: $!"; # the manifest open MANIF, '>', 'manifest.json' or die "Cannot open a file to write i +n: $!"; my $manifest = '{ "manifest_version": 2, "description": "'.$descr.'", "background": { "scripts": ["background.js"]}, "name": "'.$longname.'", "permissions": [ "contextMenus", "tabs" ], "version": "1.0" }'; print MANIF $manifest; close MANIF; # the jscript open JSCRIPT, '>', 'background.js' or die "Cannot open a file to write + in: $!"; my $background ='function customfunc(info) { var searchstring = info.selectionText; chrome.tabs.create({url: "'.$url.'" + searchstring}) } chrome.contextMenus.create({title: "'.$descr.'", contexts:["selection" +], onclick: customfunc});'; print JSCRIPT $background; close JSCRIPT;
    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Improving reproducibility and record-keeping with Log::Reproducible (create or re-run archive of script parameters, git snapshot, etc.)
2 direct replies — Read more / Contribute
by frozenwithjoy
on Mar 25, 2014 at 02:08

    I wrote a Perl module, Log::Reproducible, to help improve reproducibility (and record-keeping) of analyses. The code, README, and (some) tests are hosted on GitHub. I'm posting the README below. It contains relevant code snippets and describes how to use Log::Reproducible. If interested, please take a look the code on GitHub. I'm aiming to submit to CPAN and would really appreciate any feedback.

    EDIT: Added code for module, too (at very bottom)

    EDIT #2: Thanks to a suggestion by DrHyde in a GitHub issue, I've added some Perl-related info to the archives: version, path to the perl binary that was used, and @INC. It has already been pushed to the develop branch. Next, I'll update the module so that current vs archived Perl info is compared when reproducing an archive. In the event that the info doesn't match, the script will bail or the user will be prompted whether or not to continue.

    Note: I've tested this module alongside other modules that use and/or manipulate @ARGV and have not found any conflicts as long as Log::Reproducible is imported before the other modules.


    TAG LINE: Increase your reproducibility with the Perl module Log::Reproducible. Set it and forget it... until you need it!

    MOTIVATION: In science (and probably any other analytical field), reproducibility is critical. If an analysis cannot be faithfully reproduced, it was arguably a waste of time. Log::Reproducible provides effortless record keeping of the conditions under which scripts are run and allows easily replication of those conditions.

My own dynamic DNS setup
1 direct reply — Read more / Contribute
by Corion
on Mar 24, 2014 at 04:05

    I'm using DynDNS.org, but recently they got more obnoxious with their (free!) service, and being a cheapskate who doesn't want to be annoyed, I set up my own dynamic DNS update with my vhost at Hosteurope. I have set up ns.example.com as the DNS server for the dyn.example.com zone with the Hosteurope DNS and run my own DNS server on my vhost to serve entries for *.dyn.example.com. The key setup is done according to the many dynamic DNS articles.

    The below program reads the external IP address from my UPnP enabled gateway, a FritzBox. It then sends the signed DNS update packet to my DNS server.

    The setup is not particularly secure, as the key can be used to update any dynamic IP address in the dyn.example.com zone. But for my purpose of having one name map to a dynamic IP address, that's just enough.

Yet Another Perl-to-Lambda-Calculus Translator
1 direct reply — Read more / Contribute
by withering
on Mar 18, 2014 at 23:19

    There is an old post about Perl (maybe perl?) and (untyped) lambda calculus http://perl.plover.com/lambda/ . However, even from the perspective of a small compiler, we may reach almost the same simplicity.

    The code below is written in yapp (Parse::Yapp) grammar and should be compiled with yapp utilities:


Add your CUFP
Title:
CUFP:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.