http://www.perlmonks.org?node_id=905538

2015-09-17

use strict; use warnings; use Math::Round qw(round_even); use v5.16; # numbers are actual numbers that I use to do math on video geometry # I'm having to upscale some video to match other geometry. # MP4 requires height and width be divisible by 2. my $h1 = 480; my $h2 = 368; my $w = 640; my $ratio = $h1/$h2; my $upscaled_w = $w * $ratio; say "Raw upscale is $upscaled_w"; my $rounded = round_even($upscaled_w); say "Rounded upscale is $rounded";

2015-09-09

sub copy_file_local { my $srv = $conf->get("proxy_server"); $logger->info("Making SCP connection to $srv"); my $ssh = Net::SSH2->new(); my $start_time = $conf->get('start_time'); $ssh->connect($srv); $ssh->auth_publickey( $conf->get('uid'), $conf->get('pubkey'), $conf->get('privkey') ) or die $!; foreach my $file (@_) { my $target = catfile($conf->get('local_storage'), "${start_tim +e}_$file"); $logger->info("Copying $file to $target"); my $success = 0; my $attempts = 0; while (!$success && $attempts < 3) { $attempts++; $ssh->scp_get($file, $target); $logger->info("Gathering file data..."); my @remote_stat = split /\|/, $control->cmd("perl -e 'print join(\"|\", stat(\"$file +\")), \"\\n\"'") ; my @local_stat = stat($target); if ($remote_stat[7] == $local_stat[7]) { $success = 1; $logger->info("File sizes match."); last; } } $logger->info("Deleting $file from remote."); $control->cmd("rm $file"); } $ssh->disconnect(); }

2015-09-07

C:\STRAWB~1\c\bin\gcc.exe -c -DNDEBUG -DWIN32 -D_CONSOLE -DNO_STRIC +T -DWIN64 -DCONSERVATIVE -DPERL_TEXTMODE_SCRIPTS -DUSE_SITECUSTOMIZE +-DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DHASATTRIBU +TE -fno-strict-aliasing -mms-bitfields -O2 -DVERSION=\"0.17\" + -DXS_VERSION=\"0.17\" "-IC:\Perl64\lib\CORE" InsertResourceSect +ion.c In file included from C:\Perl64\lib\CORE/win32thread.h:4:0, from C:\Perl64\lib\CORE/perl.h:2834, from InsertResourceSection.xs:6: C:\Perl64\lib\CORE/win32.h:297:13: error: conflicting types for 'mkste +mp' extern int mkstemp(const char *path); ^ In file included from C:/STRAWB~1/c/lib/gcc/x86_64-w64-mingw32/4.9.2/i +nclude/mm_malloc.h:27:0, from C:/STRAWB~1/c/lib/gcc/x86_64-w64-mingw32/4.9.2/i +nclude/xmmintrin.h:34, from C:/STRAWB~1/c/lib/gcc/x86_64-w64-mingw32/4.9.2/i +nclude/x86intrin.h:31, from C:/STRAWB~1/c/x86_64-w64-mingw32/include/winnt.h +:1521, from C:/STRAWB~1/c/x86_64-w64-mingw32/include/minwind +ef.h:163, from C:/STRAWB~1/c/x86_64-w64-mingw32/include/windef. +h:8, from C:/STRAWB~1/c/x86_64-w64-mingw32/include/windows +.h:69, from InsertResourceSection.xs:2: C:/STRAWB~1/c/x86_64-w64-mingw32/include/stdlib.h:381:15: note: previo +us declaration of 'mkstemp' was here int __cdecl mkstemp(char *template_name); ^ dmake.exe: Error code 129, while making 'InsertResourceSection.o' dmake.exe: Error code 255, while making 'subdirs' MDOOTSON/Win32-Exe-0.17.tar.gz C:\STRAWB~1\c\bin\dmake.exe -- NOT OK eellis@FOCUS C:\Users\eellis

<2015-09-02>

eellis@eellis-ws ~ $ perl -v This is perl 5, version 20, subversion 2 (v5.20.2) built for x86_64-li +nux (with 1 registered patch, see perl -V for more detail) Copyright 1987-2015, Larry Wall Perl may be copied only under the terms of either the Artistic License + or the GNU General Public License, which may be found in the Perl 5 source ki +t. Complete documentation for Perl, including FAQ lists, should be found +on this system using "man perl" or "perldoc perl". If you have access to + the Internet, point your browser at http://www.perl.org/, the Perl Home Pa +ge. eellis@eellis-ws ~ $ perlbrew list * perl-5.20.2 eellis@eellis-ws ~ $ perlbrew list-modules Algorithm::Diff Encode::Locale File::Listing HTML::Parser HTML::Tagset HTTP::Cookies HTTP::Daemon HTTP::Date HTTP::Message HTTP::Negotiate IO::HTML LWP LWP::MediaTypes Net::HTTP PadWalker Perl Spiffy Tcl Test::Base Test::YAML Text::Diff Tkx URI WWW::RobotRules XML::Parser XML::Twig YAML YAML::AppConfig YAML::Syck eellis@eellis-ws ~ $ cpan install JSON Reading '/home/eellis/.cpan/Metadata' Database was generated on Wed, 02 Sep 2015 06:53:25 GMT Running install for module 'JSON' Checksum for /home/eellis/.cpan/sources/authors/id/M/MA/MAKAMAKA/JSON- +2.90.tar.gz ok Configuring M/MA/MAKAMAKA/JSON-2.90.tar.gz with Makefile.PL Welcome to JSON (v.2.90) ============================= *************************** CAUTION ********************************* +***** * + * * INCOMPATIBLE CHANGE (JSON::XS version 2.90) + * * + * * JSON.pm had patched JSON::XS::Boolean and JSON::PP::Boolean interna +lly * * on loading time for making these modules inherit JSON::Boolean. + * * But since JSON::XS v3.0 it use Types::Serialiser as boolean class. + * * Then now JSON.pm breaks boolean classe overload features and + * * -support_by_pp if JSON::XS v3.0 or later is installed. + * * + * * JSON::true and JSON::false returned JSON::Boolean objects. + * * For workaround, they return JSON::PP::Boolean objects in this versi +on. * * + * * isa_ok(JSON::true, 'JSON::PP::Boolean'); + * * + * * And it discards a feature: + * * + * * ok(JSON::true eq 'true'); + * * + * * In other word, JSON::PP::Boolean overload numeric only. + * * + * * ok( JSON::true == 1 ); + * * + * ********************************************************************* +***** ************************** CAUTION ************************** * This is 'JSON version 2' and there are many differences * * to version 1.xx * * Please check your applications useing old version. * * See to 'INCOMPATIBLE CHANGES TO OLD VERSION' and 'TIPS' * ************************************************************* Checking if your kit is complete... Looks good Generating a Unix-style Makefile Writing Makefile for JSON Writing MYMETA.yml and MYMETA.json MAKAMAKA/JSON-2.90.tar.gz /home/eellis/perl5/perlbrew/perls/perl-5.20.2/bin/perl Makefile.PL I +NSTALLDIRS=site -- OK Running make for M/MA/MAKAMAKA/JSON-2.90.tar.gz cp lib/JSON.pm blib/lib/JSON.pm cp lib/JSON/backportPP/Compat5005.pm blib/lib/JSON/backportPP/Compat50 +05.pm cp lib/JSON/backportPP/Boolean.pm blib/lib/JSON/backportPP/Boolean.pm cp lib/JSON/backportPP.pm blib/lib/JSON/backportPP.pm cp lib/JSON/backportPP/Compat5006.pm blib/lib/JSON/backportPP/Compat50 +06.pm Manifying blib/man3/JSON.3 Manifying blib/man3/JSON::backportPP.3 Manifying blib/man3/JSON::backportPP::Boolean.3 Manifying blib/man3/JSON::backportPP::Compat5005.3 Manifying blib/man3/JSON::backportPP::Compat5006.3 MAKAMAKA/JSON-2.90.tar.gz /usr/bin/make -- OK Running make test PERL_DL_NONLAZY=1 /home/eellis/perl5/perlbrew/perls/perl-5.20.2/bin/pe +rl "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Har +ness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t t/00_load.t ................. ok t/00_pod.t .................. skipped: Test::Pod 1.00 required for tes +ting POD t/01_utf8.t ................. ok t/02_error.t ................ ok t/03_types.t ................ ok t/06_pc_pretty.t ............ ok t/07_pc_esc.t ............... ok t/08_pc_base.t .............. ok t/09_pc_extra_number.t ...... ok t/10_pc_keysort.t ........... ok t/11_pc_expo.t .............. ok t/12_blessed.t .............. ok t/13_limit.t ................ ok t/14_latin1.t ............... ok t/15_prefix.t ............... ok t/16_tied.t ................. ok t/17_relaxed.t .............. ok t/18_json_checker.t ......... ok t/19_incr.t ................. ok t/20_unknown.t .............. ok t/21_evans_bugrep.t ......... ok t/22_comment_at_eof.t ....... ok t/99_binary.t ............... ok t/e00_func.t ................ ok t/e01_property.t ............ ok t/e02_bool.t ................ ok t/e03_bool2.t ............... ok t/e04_sortby.t .............. ok t/e05_esc_slash.t ........... ok t/e06_allow_barekey.t ....... ok t/e07_allow_singlequote.t ... ok t/e08_decode.t .............. ok t/e09_encode.t .............. ok t/e10_bignum.t .............. ok t/e11_conv_blessed_univ.t ... ok t/e12_upgrade.t ............. ok t/e13_overloaded_eq.t ....... ok t/e14_decode_prefix.t ....... ok t/e15_tie_ixhash.t .......... ok t/e16_incr_parse_fixed.t .... ok t/e90_misc.t ................ ok t/x00_load.t ................ ok t/x02_error.t ............... ok t/x12_blessed.t ............. ok t/x16_tied.t ................ ok t/x17_strange_overload.t .... ok t/xe01_property.t ........... ok t/xe02_bool.t ............... ok t/xe03_bool2.t .............. ok t/xe04support_by_pp.t ....... ok t/xe05_indent_length.t ...... ok t/xe08_decode.t ............. ok t/xe10_bignum.t ............. ok t/xe11_conv_blessed_univ.t .. ok t/xe12_boolean.t ............ ok t/xe19_xs_and_suportbypp.t .. ok t/xe20_croak_message.t ...... ok t/xe21_is_pp.t .............. ok All tests successful. Files=58, Tests=3801, 4 wallclock secs ( 0.45 usr 0.09 sys + 3.01 c +usr 0.25 csys = 3.80 CPU) Result: PASS MAKAMAKA/JSON-2.90.tar.gz /usr/bin/make test -- OK Running make install Appending installation info to /home/eellis/perl5/lib/perl5/x86_64-lin +ux/perllocal.pod MAKAMAKA/JSON-2.90.tar.gz /usr/bin/make install -- OK eellis@eellis-ws ~ $ perl -e "use warnings; use JSON" Can't locate JSON.pm in @INC (you may need to install the JSON module) + (@INC contains: /home/eellis/perl5/perlbrew/perls/perl-5.20.2/lib/si +te_perl/5.20.2/x86_64-linux /home/eellis/perl5/perlbrew/perls/perl-5. +20.2/lib/site_perl/5.20.2 /home/eellis/perl5/perlbrew/perls/perl-5.20 +.2/lib/5.20.2/x86_64-linux /home/eellis/perl5/perlbrew/perls/perl-5.2 +0.2/lib/5.20.2 .) at -e line 1. BEGIN failed--compilation aborted at -e line 1. eellis@eellis-ws ~ $

2014-12-10

<script type="text/javascript" src="//code.jquery.com/jquery-1.11.1.mi +n.js"></script> <script type="text/javascript" src="//maxcdn.bootstrapcdn.com/bootstra +p/3.2.0/js/bootstrap.min.js"></script> <script type="text/javascript" src="//cdnjs.cloudflare.com/ajax/libs/h +ighlight.js/8.2/highlight.min.js"></script> <script type="text/javascript" src="//buzzword.org.uk/2014/pm/pm2.js"> +</script>

2014-02-07

if ($foohash->{$key} > $dbhash->{$key}) { # if any of these are greater, go ahead and update print "An update to $key has occured!\n"; print("to " . $foohash->{$key} . " from " . $dbhash->{$key} . "\n" +); #$dbh->do( # "update daily_urls set $key = " . $foohash->{$key} . # "where id = " . $check->[0]->[0] #); }

output:

An update to bytes has occurred! to 1988574506.81257 from 1988574506.81257 An update to bytes has occurred! to 1161805289.10036 from 1161805289.10036 An update to bytes has occurred! to 287736468.69037 from 287736468.69037

2014-02-06

SELECT distinct date as d, (select sum(bytes) from daily_url where date like d and url like 'long/path/to/foo/%') from daily_url limit 20;

date is varchar, could be int(10) as it's an epoch timestamp for that day.

bytes is varchar, could be float, but it would have to be pretty big.

daily_url is varchar

2014-01-22

sub package_on_usual_location($) { my $file = shift; my ($top, $subdir, @rest) = splitdir $file; defined $subdir or return 0; !@rest # path is at top-level of distro || $subdir eq 'lib'; # inside lib }

2013-11-22

explain select db1.questionnaire_question.content AS 'question content +', db1.questionnaire_quest_choice.content AS 'choice content', avg(db1.questionnaire_response_rank.rank) AS 'average rank' from db1.questionnaire_response_rank INNER JOIN db1.questionnaire_question ON (db1.questionnaire_response_r +ank.question_id=db1.questionnaire_question.id) INNER JOIN db1.questionnaire_quest_choice ON (db1.questionnaire_quest_ +choice.question_id=db1.questionnaire_question.id) INNER JOIN db1.questionnaire ON (db1.questionnaire.id=db1.questionnair +e_question.survey_id) INNER JOIN db1.local_ltiprovider ON (db1.questionnaire.course=db1.loca +l_ltiprovider.courseid) INNER JOIN db1.local_ltiprovider_user ON (db1.local_ltiprovider_user.t +oolid=db1.local_ltiprovider.id) INNER JOIN db2.i_users_sections ON (db1.local_ltiprovider_user.sourcei +d=db2.i_users_sections.id) INNER JOIN db2.course_sections ON (db2.course_sections.id=db2.i_users_ +sections.course_section_id) INNER JOIN db2.courses ON (db2.courses.id=db2.course_sections.course_i +d) where db2.courses.id=167 AND db1.questionnaire_question.deleted="n" group by db1.questionnaire_quest_choice.id;

2013-09-17

use strict; use warnings; use XML::Twig; my $twig = XML::Twig->new(pretty_print => "indented"); $twig->parse('<foo/>'); my $root = $twig->root(); foreach my $i (qw(bar baz qux)) { my $inserted = $root->insert($i); $inserted->set_atts({bark => 'woof'}); my $second_inserted = $root->insert($i . 'second_tag'); $second_inserted->set_atts({type => 'deep'}); } $twig->print;
I expect the return to be:
<foo> <bar bark="woof"/> <barsecond_tag type="deep"/> <baz bark="woof"/> <bazsecond_tag type="deep"/> <qux bark="woof"/> <quxsecond_tag type="deep"/> </foo>
I'm getting the following:
<foo> <quxsecond_tag type="deep"> <qux bark="woof"> <bazsecond_tag type="deep"> <baz bark="woof"> <barsecond_tag type="deep"> <bar bark="woof"/> </barsecond_tag> </baz> </bazsecond_tag> </qux> </quxsecond_tag> </foo>

2013-06-17

Installing redmine 2.3.x on Ubuntu 12.04.

Add the following repo:

https://launchpad.net/~ondrej/+archive/redmine

The easy way to do this is by adding the ppa using add-apt-repository.

sudo apt-get install python-software-properties sudo add-apt-repository ppa:ondrej/redmine

After you have that repo installed, you can use this tutorial: http://www.redmine.org/projects/redmine/wiki/HowTo_Install_Redmine_on_Ubuntu_step_by_step

2013-06-05

$VAR1 = { 'source' => '[path def]', 'git_server' => 'git://trident.classroom24-7.lan', 'permissions' => '0665', 'target_group' => 'www-data', 'rename' => 'gttest', 'target_owner' => 'www-data', 'target' => '.', 'preserve' => [ [ 'moodlite_config.php', 'not_moodlite_config.php' ] ], 'title' => 'moodlite' }; $VAR2 = { 'source' => '[path def]', 'permissions' => '755', 'target_group' => 'eellis', 'target_owner' => 'root', 'rename' => 'notmoodlite', 'target' => '.', 'preserve' => [ $VAR1->{'preserve'}[0] ], 'title' => 'moodlite/copy1' };

2013-05-23

The following assumes you're using gitolite on a remote server.

#!/bin/bash # to add repos for redmine, do the following: # git clone --bare git@[server]:[repo] # then add two stanzas here to get updates echo "Running [repo]" cd /path/to/repo.git /usr/bin/git fetch origin '+refs/heads/*:refs/heads/*' -v cd ~
Set the above in a cron (I have it run every 5 minutes) and all of your updates get pulled so Redmine can see them.

2013-04-19

Given the tables as follows:

courses - id - short_name - long_name i_courses_accreditors - id - courses_id - accreditors_id accreditors - id - name

Any given course can have multiple accreditors. I would like to return a single row with all accreditors for each course. I suspect either group_concat or concat_ws will come into play, but I can't put all the magic together yet.

2013-04-05

use strict; use warnings; my $string = "\n\nThis is a string"; my $start_time = time(); my $times = 9999999999999; for (my $i = 0; $i == $times; $i++){ my $result = reverse($string); $result = reverse(chomp($string)); } my $end_time = time(); print "Double reverse = " . ($end_time - $start_time) . " seconds\n"; $start_time = time(); for (my $i = 0; $i == $times; $i++){ my $result = $string; $result =~ s/\n//; } $end_time = time(); print "regex = " . ($end_time - $start_time) . " seconds";

2013-03-29

CREATE PROCEDURE `sp_DBR`(email_to varchar(50), global_filter varchar( +50)) BEGIN declare findme varchar(50) default '%'; IF CHAR_LENGTH(global_filter) >= 1 THEN set findme = concat('%', global_filter, '%'); END IF; select u.id as 'Id', u.username as 'Username', u.first_name as 'First_name', u.last_name as 'Last_name', u.email as 'Email', from_unixtime(u.last_login) as 'Last login', from_unixtime(u.reg_date) as 'Reg date', u.organization as 'Organization' from moodlite.users u where u.id like findme; END $$

2013-03-21

use strict; my $VAR1 = { 'wizard' => { 'spell' => 4, 'ppd' => 10, 'breath weapon' => 9, 'pp' => 7, 'rsw' => 5 }, 'warrior' => { 'spell' => 6, 'ppd' => 3, 'breath weapon' => 4, 'pp' => 4, 'rsw' => 5 }, 'rogue' => { 'spell' => 7, 'ppd' => 9, 'breath weapon' => 12, 'pp' => 8, 'rsw' => 6 } }; my $stat = 'spell'; my $smallest; foreach my $class (keys $VAR1) { my $val = $VAR1->{$class}->{$stat}; if (!$smallest) { $smallest->{'class'} = $class; $smallest->{'val'} = $VAR1->{$class}->{$stat}; } else { if ($smallest->{'val'} > $VAR1->{$class}->{$stat}) { $smallest->{'class'} = $class; $smallest->{'val'} = $VAR1->{$class}->{$stat}; } } } print "Smallest value for $stat is in class $smallest->{'class'}, with + value $smallest->{'val'}";

2012-12-07

I'm having a similar problem on ActivePerl 5.14.2 and have made it to this point with troubleshooting:

Sample code:

use strict; use warnings; use WWW::Mechanize; # LWP complains if this isn't included with the packaged executable. # This may be because I'm on Win32. At any rate, PP isn't smart enoug +h # to know it's needed, so I include it here to make packaging easier. use Encode::Byte; # WWW::Mechanize debugging # per http://search.cpan.org/~mstrout/WWW-Mechanize/lib/WWW/Mechanize/ +FAQ.pod#How_do_I_figure_out_why_$mech-%3Eget%28$url%29_doesn%27t_work +? use LWP::Debug qw(+); # by default, PP picks Net::SSLeay # It appears to test for IO::Socket::SSL first and use it if it's avai +lable. # use Crypt::SSLeay; # use IO::Socket::SSL; my $mech = WWW::Mechanize->new(); my $url = 'http://google.com'; $mech->get($url); if ($mech->success() == 1) { print "yay"; } else { die "Can't fetch $url"; }

I have verified that the site is reachable from a browser on my machine.

In the example above, I'm using a non-SSL site. It works both packaged and unpackaged as expected.

Altering the URL to try and talk https is where the problem starts to show.

Unpackaged, the script works as expected.

Packaged the problem rears its head: Error GETing https://google.com: Can't connect to google.com:443 at script/mech_test.pl line 17.

So the problem definitely lies within the idea that something that's required is not being packaged by pp. The problem is that the documentation states that if you want to use SSL, you use either Crypt::SSLeay or IO::Socket::SSL, which we can explicity include, but it doesn't alter the result.

How I'm using pp: pp mech_test.pl -x -o mech_test.exe

-x is supposed to execute the program so pp can sort out what exactly it needs, per http://search.cpan.org/~autrijus/PAR-0.85_01/script/pp#OPTIONS.

Digging through the packed executable, it appears that both IO::Socket::SSL and Crypt::SSLeay are included with the output, so the the safe assumption is that one of those has a missing depenancy that it's not yelling about.

Crypt::SSLeay documentation