Re: Convert any date format to ISO
I was trying to use Date::Simple to convert date from DD-MM- to ISO
standard -MM-DD, but it produced error below because it returned undef
when the date passed is not ISO standard.
$ perl -e 'use Date::Simple (":all");$date =
Date::Simple->new("29-01-1972"); $x = $date->as_iso; print "$x\n" or
"invalid\n";'
Can't call method "as_iso" on an undefined value at -e line 1.
Based on the following two results, it's obvious the module does not
support date formats other than ISO.
perl -e 'use Date::Simple (":all");$date = Date::Simple->new("1972-01-29");
$x = $date->as_iso; print "$x\n" or "invalid\n";'
1972-01-29
$ perl -e 'use Date::Simple (":all");$date = Date::Simple->new("19720129");
$x = $date->as_iso; print "$x\n" or "invalid\n";'
1972-01-29
Most of the date modules on CPAN cannot do the job for me. I spent time
reading documentations but as it now stands, I have to do this myself.
Mimi
On 24 July 2013 15:24, mimic...@gmail.com wrote:
> I'm trying to convert dates (input from user in any format) to ISO and
> check it's valid.
>
> Can someone provide an example of this using Date::Simple or Date::Manip?
>
> Mimi
>
Perl Debugger: DBD::mysql::db do failed: MySQL server has gone away at
In my script, I previous connected and disconnected to the database within
every subroutine. Now I have made changes and it now connect/disconnect to
mysql only once within main:: (at the start and end of script
respectively). Although my script works fine, I am wondering whether this
is the best way.
I'm not very familiar with the debugger, but I tried it and it reported
MySQL has gone away and then it stopped. I expected the debugger to go
through all the subroutines within the script, but it doesn't. Does the
output of the debugger point to a problem? As said the script behaves as
expected when I run it.
$ perl -dT usermap.cgi
Loading DB routines from perl5db.pl version 1.32
Editor support available.
Enter h or `h h' for help, or `man perldebug' for more help.
main::(usermap.cgi:23): my $session = initialise_session();
DB<1> c
Set-Cookie: token_id=75cf9b9da31cf21ce755a3a6971049e2; path=/
Date: Sun, 28 Jul 2013 02:54:37 GMT
Content-Type: text/html; charset=ISO-8859-1
Don't know what to do here. Did you pass any parameter?
at usermap.cgi line 107
DBD::mysql::db do failed: MySQL server has gone away at
/usr/local/share/perl5/CGI/Session/Driver/mysql.pm line 50.
at /usr/local/share/perl5/CGI/Session/Driver/mysql.pm line 50
CGI::Session::Driver::mysql::store('CGI::Session::Driver::mysql=HASH(0x3499de0)',
'75cf9b9da31cf21ce755a3a6971049e2', '$D = {\'_SESSION_ETIME\' =>
7200,\'_SESSION_ID\' => \'75cf9b9...') called at
/usr/local/share/perl5/CGI/Session.pm line 251
CGI::Session::flush('CGI::Session=HASH(0x2036e90)') called at
/usr/local/share/perl5/CGI/Session.pm line 92
CGI::Session::DESTROY('CGI::Session=HASH(0x2036e90)') called at
usermap.cgi line 129
eval {...} called at usermap.cgi line 129
(in cleanup) DBD::mysql::db do failed: MySQL server has gone away
at /usr/local/share/perl5/CGI/Session/Driver/mysql.pm line 50.
Debugged program terminated. Use q to quit or R to restart,
use o inhibit_exit to avoid stopping after program termination,
h q, h R or h o to get additional info.
DB<1> w
Adding a watch-expression requires an expression
DB<1>
excerpt from my code.
48 my $dbh = db_connect();
107 die "Don't know what to do here. Did you pass any parameter?\n";
108 }
22 $dbh->do(qq{UPDATE user SET login_status = 'N' WHERE login_status = 'Y'
AND last_active < DATE_SUB(CURRENT_TIMESTAMP,INTERVAL $log_in_time2live
MINUTE)}) ||
123 warn "Couldn't update database table user:$DBI::errstr\n";
124
125
126 $dbh->disconnect;
127
128
129 exit 0;
Thanks
Mimi
How to Auto Generate range of years (year of birth between 18 and 73)
I have this simple script to automatically print HTML selection option.
#!/usr/bin/env perl
use strict;
for (reverse(1943 .. 1991)){
print "\$_\<\/option\>\n";
}
I need to print all the years between 18 and 73 without hard coding the
range in the for loop as in the above. I am considering the use of
localtime to compute the current year as below $yr=(localtime)[5], but I
can't think of an easy way to achieved what I want to do.
Any help appreciated.
Mimi
Re: How to Auto Generate range of years (year of birth between 18 and 73)
The following works, but is this the way to go?
#!/usr/bin/env perl
use strict;
my ($min_yr, $max_yr);
$min_yr =(localtime)[5] + 1900 - 18;
$max_yr = (localtime)[5] + 1900 - 73;
for (reverse($max_yr .. $min_yr)){
print "\$_\<\/option\>\n";
}
Mimi
On 16 September 2013 14:36, mimic...@gmail.com wrote:
> I have this simple script to automatically print HTML selection option.
>
> #!/usr/bin/env perl
>
> use strict;
>
> for (reverse(1943 .. 1991)){
> print "\$_\<\/option\>\n";
> }
>
>
> I need to print all the years between 18 and 73 without hard coding the
> range in the for loop as in the above. I am considering the use of
> localtime to compute the current year as below $yr=(localtime)[5], but I
> can't think of an easy way to achieved what I want to do.
>
> Any help appreciated.
>
> Mimi
>
LWP/UserAgent fail authentication:
Hi
I receive error when calling GitHub API from Perl (LWP). Basically, the
problemis authentication failure, although the username and password
combination is valid.
In the code snippet below, I have tried changing the values passed to
credentials() in several ways, however it does not work.
#!/usr/bin/perl
use warnings;
use strict;
use LWP::Simple;
use LWP::UserAgent;
use HTTP::Request::Common qw(GET);
my $url = shift;
chomp $url;
my $auth_token = "username:token"
#my ($login, $pass) = split /:/, $auth_token;
#print "\nDEBUG: $login\n\n";
my $ua = LWP::UserAgent->new;
$ua->agent('Mozilla/8.0');
#$ua->credentials("www.github.com:443","Authorization: token", "$login",
"$pass");
$ua->credentials("api.github.com:443","Authorization
Basic:","$auth_token","");
my $request = GET "$url";
my $resp = $ua->request($request);
my $httpd_code = $resp->status_line;
my $code_cont = $resp->decoded_content;
if ($httpd_code eq "200 OK"){
print "$code_cont\n";;
}
else {
print "ERROR: $httpd_code $code_cont\n";
}
Receive 404 code: in GitHub API terms, this means authentication failed.
$ lwpagent.pl https://api.github.com/teams/123456
'https://api.github.com/teams/123456'
404 Not Found {"message":"Not Found","documentation_url":"
https://developer.github.com/v3"}
GitHub API will return 404 Not Found, instead of 403 Forbidden, in some
places. This is to prevent the accidental leakage of private repositories
to unauthorized users.
if I remove the credentials() line, then tried to access a url that does
not require password, then it works mean.
Can you detect any issue with the way I pass the auth token to GitHub?
Please note that I cannot use any of the new GitHub modules on CPAN, hence
my own implementation.
Any pointer appreciated.
mimi
Re: LWP/UserAgent fail authentication:
Hi David
The LWP::UserAgent docs isn't clear on how it handles the password. Thanks
to your input, it's now clear why GitHub auth was failing.
As you have noted, "$token:x-oauth-basic" doesn't work. # Basic
authorization user name can't contain ':' at
/usr/share/perl5/HTTP/Message.pm line 658
I have now used authorization_basic() from HTTP::Header as you suggested,
and bingo (problem resolved).
This works
$req->authorization_basic("$login", "$pass"); # works fine.
It did like this either
$req->authorization_basic("$user/token", "$token"); #
Thanks for your input.
Cheers
Mimi
On 31 July 2014 23:29, David Precious wrote:
> On Thu, 31 Jul 2014 17:01:38 +0100
> "mimic...@gmail.com" wrote:
>
> > I receive error when calling GitHub API from Perl (LWP). Basically,
> > the problemis authentication failure, although the username and
> > password combination is valid.
> >
> > In the code snippet below, I have tried changing the values passed to
> > credentials() in several ways, however it does not work.
> [...]
> > my $auth_token = "username:token"
> [...]
> > my $ua = LWP::UserAgent->new;
> > $ua->agent('Mozilla/8.0');
> >
> > #$ua->credentials("www.github.com:443","Authorization: token",
> > "$login", "$pass");
> > $ua->credentials("api.github.com:443","Authorization
> > Basic:","$auth_token","");
>
> The problem, I believe, is that LWP will send the details you've given
> it for that hostname and realm, when it sends a request and the remote
> server responds with a 401 Unauthorized response with a
> WWW-Authenticate header, stating the auth type and realm.
> Unfortunately, as you mentioned, GitHub does not do that; instead, it
> pretends the resource requested does not exist.
>
> So, LWP, never being asked to authenticate, will not do so.
>
> You'll need to manually do it by creating a HTTP::Request object
> rather than letting LWP do it for you.
>
> From some code of mine that successfully worked:
>
> my $url = "http://github.com/api/v2/json/pulls/"; . $project;
> my $ua = LWP::UserAgent->new;
> my $req = HTTP::Request->new(GET => $url);
>
> # Auth if necessary
> if (my $auth = $self->auth_for_project($project)) {
> my ($user, $token) = split /:/, $auth, 2;
> $req->authorization_basic("$user/token", "$token");
> }
>
> my $res = $ua->request($req)
> or return "Unknown - error fetching $url";
>
>
> (this is from:
>
> https://github.com/bigpresh/Bot-BasicBot-Pluggable-Module-GitHub/blob/master/lib/Bot/BasicBot/Pluggable/Module/GitHub/PullRequests.pm#L67-L77
> )
>
> ... reading it, though, I'm not sure quite why it worked; GitHub's docs
> say that, if you're using a token, the username should be set as
> "$token:x-oauth-basic", and the password being unimportant; maybe this
> code worked against their older, now withdrawn v2 API.
>
> Anyway, I believe the lack of a proper WWW-Authenticate header from
> GitHub is what's causing your problems - they don't ask for auth, so
> LWP (correctly) doesn't send it.
>
>
> --
> David Precious ("bigpresh")
> http://www.preshweb.co.uk/ www.preshweb.co.uk/twitter
> www.preshweb.co.uk/linkedinwww.preshweb.co.uk/facebook
> www.preshweb.co.uk/cpanwww.preshweb.co.uk/github
>
>
>
> --
> To unsubscribe, e-mail: beginners-unsubscr...@perl.org
> For additional commands, e-mail: beginners-h...@perl.org
> http://learn.perl.org/
>
>
>
Match HTML ...... string over multiple
I am trying to extract a table (.. until ) and its content from an HTML file. With the file I have something like this . . . There could be more that one table in the file.however I am only interested in the table within . /^.*.+?()\s*<\/div>.*$/ims The above and various variations I tried do not much. I am able to easily match this using sed, however I need to try using perl. This sed work just fine: sed -n '//,/<\/table>/p' thelo826.html |sed -n '//p'| sed -e 's/class=".*"//g' Thanks Mimi
