I'm trying to generate an ICal feed using Data:ICal but some events are printed without a time. I've read that the time is not required if it's 000000 but Google Calendar does not handle those events without a time properly.
Here is an example script and output. I need the output to to be in the UTC timezone.
#!/usr/bin/perl -w
use strict;
use Date::ICal;
use Data::ICal;
use Data::ICal::Entry::Event;
use DateTime;
use Data::Dumper;
sub get_utc_offset($) {
my ($orig_tz_str) = #_;
# Using a set winter date to avoid problems with daylight savings time
my $utc_compare_datetime = DateTime->new(
year => 2012,
month => 1,
day => 1,
hour => 1,
minute => 1,
time_zone => 'UTC'
);
my $tz = DateTime::TimeZone->new(name => $orig_tz_str);
my $utc_offset = $tz->offset_for_datetime($utc_compare_datetime);
my $utc_offset_str = DateTime::TimeZone->offset_as_string($utc_offset);
return $utc_offset_str;
}
sub add_ical_event($$$$$$) {
my ($calendar, $start, $end, $summary, $description, $timezone) = #_;
my $offset = get_utc_offset($timezone);
$description = 'none' if (!$description);
my $event = Data::ICal::Entry::Event->new();
$event->add_properties(
summary => $summary,
description => $description,
dtstart => Date::ICal->new( ical => $start, offset => $offset )->ical,
dtend => Date::ICal->new( ical => $end, offset => $offset )->ical,
dtstamp => Date::ICal->new( epoch => time )->ical
);
$calendar->add_entry($event);
}
# Tests
# ----------------------------------------------------------------------------
my $timezone = 'America/New_York';
my $calendar = Data::ICal->new();
$calendar->add_properties(
method => "PUBLISH",
prodid => "-//Test Cal//NONSGML Calendar//EN",
'X-WR-CALNAME' => 'Test Cal'
);
my (%events) = (
1 => {
summary => 'Test Shift Tool - Testing Shift',
description => '',
start => '20130828T160000',
end => '20130828T190000',
timezone => $timezone
},
2 => {
summary => 'New Member Meeting',
description => '',
start => '20130722T190000',
end => '20130722T210000',
timezone => $timezone
},
3 => {
summary => 'public',
description => '',
start => '20130630T130000',
end => '20130630T140000',
timezone => $timezone
}
);
foreach my $key (sort keys %events) {
my $e = $events{$key};
add_ical_event(
$calendar,
$e->{start},
$e->{end},
$e->{summary},
$e->{description},
$e->{timezone}
);
}
print $calendar->as_string;
Notice that some events have start or end dates without a time. When I manually add T000000Z, those events are imported properly to Google Calendar. Any suggestions on how to force all events to have a time?
BEGIN:VCALENDAR
VERSION:2.0
METHOD:PUBLISH
PRODID:-//Digital Cheetah//NONSGML Calendar//EN
X-WR-CALNAME:Digital Cheetah
BEGIN:VEVENT
DESCRIPTION:none
DTEND:20130829Z
DTSTAMP:20130823T214317Z
DTSTART:20130828T210000Z
SUMMARY:Test Shift Tool - Testing Shift
END:VEVENT
BEGIN:VEVENT
DESCRIPTION:none
DTEND:20130723T020000Z
DTSTAMP:20130823T214317Z
DTSTART:20130723Z
SUMMARY:New Member Meeting
END:VEVENT
BEGIN:VEVENT
DESCRIPTION:none
DTEND:20130630T190000Z
DTSTAMP:20130823T214317Z
DTSTART:20130630T180000Z
SUMMARY:public
END:VEVENT
END:VCALENDAR
I've read that the time is not required if it's 000000
That's not what the RFC says. Let's refer to the following sections:
4.3.4 Date
4.3.5 Date-Time
4.8.7.2 Date/Time
I'll quote the relevant format specifications, here:
date = date-value
date-value = date-fullyear date-month date-mday
date-fullyear = 4DIGIT
date-time = date "T" time ;As specified in the date and time
;value definitions
dtstamp = "DTSTAMP" stmparam ":" date-time CRLF
When your output includes a DTSTAMP, the ICal specification expects a date-time following it.
Which brings us to Date::ICal and its ical method. Does it return an iCal date or a date-time? As it turns out, it tries to guess which format you want by checking whether your timestamp has a time of 000000. See for yourself at line 286 of ICal.pm.
It could be that we expect Data::ICal::Entry to handle this scenario. I could be missing validation code on that end, but at the moment I'm not seeing anything that's obviously relevant. It looks like it accepts the property values without checking them.
Depending on your perspective, this sounds like a bug or a limitation of the libraries.
So... how should you fix this? Ideally, one of these libraries should probably check for and handle this scenario. In the meantime, though, you need to get back on your feet:
Quick and dirty fix: if your time is zero, bump it by one second; ical will now return a valid but slightly inaccurate date-time string.
A little better: check the return value from ical; if it's a date, reformat it as a date-time.
Test this before using it, but maybe something like this:
dtstart => $ical =~ s/(\d{8})Z/$1T000000Z/r;
Related
I've created a CGI form using perl, everything works really good, except I'm having a hard time finding a solution as to how I can get the current time and date filled in the form while giving the user the option to change the input with a date and time picker. here is pieces of code I've written:
sub output_form {
my ($q) = #_;
print $q->start_form(
-name => 'main',
-method => 'POST',
);
print $q->start_table;
print $q->Tr(
$q->td('Update#:'),
$q->td(
$q->textfield(-name => "update_num", -size => 02)
)
);
print $q->Tr(
$q->td('Date:'),
$q->td(
$q->textfield(-name => "date", -size => 50)
)
);
print $q->Tr(
$q->td('Time:'),
$q->td(
$q->textfield(-name => "time", -size => 50)
)
);
Add http://jqueryui.com/datepicker/ to your html page.
print "<link rel='stylesheet' href='//code.jquery.com/ui/1.12.0/themes/base/jquery-ui.css'>";
print "<script src='//code.jquery.com/jquery-1.12.4.js'></script>";
print "<script src='//code.jquery.com/ui/1.12.0/jquery-ui.js'></script>";
...
Then add the ID tag to your textfield.
print $q->Tr(
$q->td('Date:'),
$q->td(
$q->textfield(-name => "date", -size => 50, -id => "datepicker")
)
);
You might also find this reference helpful from perl monks on using javascript with perl: http://www.perlmonks.org/?node_id=1050387
Here another conversation on the topic of data pickers.
jQuery date/time picker
If you know your users are going to be using modern browsers like Edge or Chrome, then you can use the HTML5 date input.
<input type="date" value="2016-09-15">
That gives a nice date-picker on supported browsers and downgrades to a simple text input where it isn't supported.
You can create it with CGI's HTML creation functions.
$q->input({type => 'date', value => '2016-09-15'});
But as others have pointed out, we've known that the HTML creation functions are a stupid idea for at least 15 years. No-one should be using them now. Please use a templating engine instead.
As for getting the date. The easiest option is probably to use Time::Piece.
use Time::Piece;
my $date = localtime;
say $q->input({type => 'date', value => $date->strftime('%Y-%m-%d')});
I am having trouble comparing DateTime objects in my Catalylst. I have an end_date column which is being inflated by DBIx::Class::InflateColumn::DateTime, and I am inflating it with my timezone:
__PACKAGE__->add_columns(
end_date => { data_type => 'datetime', time_zone => 'America/Chicago' },
);
I have a function that is supposed to tell me if my event has closed or not, this is defined in my Schema for this class:
sub closed {
my ($self) = #_;
my $now = DateTime->now(time_zone => 'America/Chicago');
warn DateTime->compare($now, $self->end_date);
warn $now;
warn $self->end_date;
return DateTime->compare($now, $self->end_date) == 1;
}
However, it is not working properly. It is telling me that events have closed before they actually have. Here is an example output from the warns:
1
2014-06-29T12:20:48
2014-06-29T12:20:50
As you can see, it is saying that the first date is greater than end_date, even though it is not. I haven't been able to figure out why this is. However, whenever I convert them and create new DateTime objects:
sub closed {
my ($self) = #_;
my $now = DateTime::Format::ISO8601->parse_datetime(DateTime->now(time_zone => 'America/Chicago'));
my $end_date = DateTime::Format::ISO8601->parse_datetime($self->end_date);
return DateTime->compare($now, $end_date) == 1;
}
Then they compare correctly, and compare returns -1. Does anyone know why this could be?
Your debugging information is useless since you didn't include the time zone offsets (e.g. by using ->strftime('%FT%T%z')). If you did, I bet you'll find the first date is indeed greater than the end date, and I bet it's using UTC for your inflated column.
Looking at the docs, the time zone is to be provided by the timezone attribute, but you used time_zone.
{ data_type => 'datetime', timezone => "America/Chicago", locale => "de_DE" }
(That was a poor, confusing choice on D::C::IC::DT's behalf.)
How can you convert from multiple currencies, using the PayPal API (Adaptive Payments) system? The documents only have stuff for Ruby, iOS, PHP, Rails etc... but not Perl!
https://developer.paypal.com/docs/classic/api/adaptive-payments/ConvertCurrency_API_Operation/
This is only meant as a guideline (to run in command line). It will run via the browser, but you need to add in a header (otherwise it'll give a 500 Internal Server Error)
The perl code is as follows:
currency.cgi
#!/usr/bin/perl
use warnings;
use strict;
use HTTP::Request::Common;
use LWP::UserAgent;
my $user = 'your PayPal API username';
my $password = 'your PayPal API password';
my $signature = 'your PayPal API signature';
my $application_id = 'APP-80W284485P519543T'; # this is the sandbox app ID... so you would just change this to your own app-id when going live
my #currencies = qw/GBP EUR CHF USD AUD/; # Enter all the currency codes you want to convert here
my $url = 'https://svcs.sandbox.paypal.com/AdaptivePayments/ConvertCurrency'; # remove the "sandbox." part of this URL, when its ready to go live...
my $ua = LWP::UserAgent->new();
my $headers = HTTP::Headers->new(
'X-PAYPAL-SECURITY-USERID' => $user,
'X-PAYPAL-SECURITY-PASSWORD' => $password,
'X-PAYPAL-SECURITY-SIGNATURE' => $signature,
'X-PAYPAL-APPLICATION-ID' => $application_id,
'X-PAYPAL-DEVICE-IPADDRESS' => $ENV{REMOTE_ADDR},
'X-PAYPAL-REQUEST-DATA-FORMAT' => 'JSON',
'X-PAYPAL-RESPONSE-DATA-FORMAT' => 'JSON'
);
foreach (#currencies) {
print qq|\nGetting exchange rates for $_.... \n|;
my ($status,$vals) = get_converted_amounts($_);
if ($vals->{error}) {
print qq|There was an error: $vals->{error}\n|;
exit;
} else {
print qq|Got conversion rates of:\n|;
foreach (#currencies) {
if ($vals->{$_}) {
print qq|\t$_ => $vals->{$_}\n|;
}
}
}
}
sub get_converted_amounts {
my ($currency_from) = #_;
my #currencies_to_grab;
foreach (#currencies) {
next if $_ eq $currency_from; # We dont wanna bother asking it to convert from this currency, into this currency =)
push #currencies_to_grab, $_;
}
my $json_var = {
requestEnvelope => {
detailLevel => "ReturnAll",
errorLanguage => "en_US",
},
baseAmountList => [{ 'currency' => { 'code' => $currency_from, 'amount' => 1 } }],
convertToCurrencyList => [{ currencyCode => \#currencies_to_grab }]
};
use JSON;
my $new_json = JSON::to_json($json_var);
my $request = HTTP::Request->new( 'POST', $url, $headers, $new_json );
my $response = $ua->request( $request );
my $json_returned = decode_json($response->decoded_content);
if ($json_returned->{error}[0]) {
return (0, { error => "There was an error: $json_returned->{error}[0]->{message} ($json_returned->{error}[0]->{errorId}) " });
}
my $vals;
foreach (#{$json_returned->{estimatedAmountTable}->{currencyConversionList}[0]->{currencyList}->{currency}}) {
$vals->{$_->{code}} = $_->{amount};
}
return (1,$vals);
}
Running it:
You would simply run it via SSH/Telnet, with:
perl /path/to/script/currency.cgi
You can play around with the currency codes (be sure to only use the currencyCode values found here: https://developer.paypal.com/docs/classic/api/adaptive-payments/ConvertCurrency_API_Operation/, as these are the only ones that are supported)
Although this converts from a given currency into the other related currencies (good if you want to run the script every couple of hours, and store the conversion rates) - it wouldn't be hard to tweak it so you can do:
convert(from_currency,to_currency,amount)
Hopefully this will save someone a bit of time (as I spent almost a day trying to get this going)
I am new in Perl and also RRDs.
I have tried to implement a simple example, and although it seems that is operating correctly the output is not displayed. The pictures are produced normally but there is no data in the graphs.
I have been following the CPAN documentation for implementation RRD::Simple and theoretically I am doing something wrong. I tried to debug the code and it seems fine, but when it comes to print the graphs there is no data.
#!/usr/bin/perl
use strict;
use warnings;
use RRD::Simple ();
use Data::Dumper;
$| = 1; # Flush the output
my ($rrd, $unixtime, $file);
$file = "perl.txt";
my $path = '/home/os/Desktop/Test_Perl/';
my $period = '3years';
my $rrdfile = 'myfile.rrd';
while (sleep 15) {
open(FH, ">>", $file) || die "Unable to open $file: $!\n";
my $range = 50;
my $minimum = 100;
my $random_number_in = int(rand($range)) + $minimum;
my $random_number_out = int(rand($range)) + $minimum;
my $random_number_sec = int(rand($range)) + $minimum;
# Create an interface object
$rrd = RRD::Simple->new(
file => $rrdfile,
cf => [qw( AVERAGE MIN MAX LAST )],
#default_dstype => "DERIVE",
);
unless (-e $rrdfile) {
# Create a new RRD file with 3 data sources called
# bytesIn, bytesOut and faultsPerSec.
$rrd->create(
$period,
step => 5, # 5 sec interval
bytesIn => "GAUGE",
bytesOut => "GAUGE",
faultsPerSec => "GAUGE"
);
}
# Put some arbitary data values in the RRD file for the same
# 3 data sources called bytesIn, bytesOut and faultsPerSec.
$rrd->update(
bytesIn => $random_number_in,
bytesOut => $random_number_out,
faultsPerSec => $random_number_sec
);
print FH "This is the bytes_in: $random_number_in\n";
print FH "This is the bytes_out: $random_number_out\n";
print FH "This is the bytes_sec: $random_number_sec\n";
# Generate graphs:
# /home/os/Desktop/Test_Perl/myfile-hourly.png, /home/os/Desktop/Test_Perl/myfile-daily.png
# /home/os/Desktop/Test_Perl/myfile-weekly.png, /home/os/Desktop/Test_Perl/myfile-monthly.png
my %rtn = $rrd->graph(
$rrdfile,
destination => $path,
basename => "my_graph",
timestamp => "both", # graph, rrd, both or none
periods => [qw(hour day week month)], # omit to generate all graphs
sources => [qw(bytesIn bytesOut faultsPerSec)],
source_colors => [qw(ff0000 aa3333 000000)],
source_labels => [("Bytes In", "Bytes Out", "Faults Per Second")],
source_drawtypes => [qw(LINE1 AREA LINE)],
line_thickness => 2,
extended_legend => 1,
title => "Network Interface eth0",
vertical_label => "Bytes/Faults",
width => 800,
height => 500,
interlaced => "", # If images are interlaced they become visible to browsers more quickly
);
printf("Created %s\n", join(", ", map { $rtn{$_}->[0] } keys %rtn));
# Return information about an RRD file
my $info = $rrd->info($rrdfile); # This method will return a complex data structure containing details about the RRD file, including RRA and data source information.
print Data::Dumper::Dumper($info);
my #sources = $rrd->sources($rrdfile);
my $seconds = $rrd->retention_period($rrdfile); # This method will return the maximum period of time (in seconds) that the RRD file will store data for.
# Get unixtime of when RRD file was last updated
$unixtime = $rrd->last($rrdfile);
print FH "myfile.rrd was last updated at " . scalar(localtime($unixtime)) . "\n";
# Get list of data source names from an RRD file
my #dsnames = $rrd->sources;
print "Available data sources: " . join(", ", #dsnames) . "\n";
my $heartbeat_In = $rrd->heartbeat($rrdfile, "bytesIn");
my $heartbeat_Out = $rrd->heartbeat($rrdfile, "bytesOut");
my $heartbeat_sec = $rrd->heartbeat($rrdfile, "faultsPerSec"); # This method will return the current heartbeat of a data source.
printf "This is the heartbeat_in: %s\n", $heartbeat_In;
my #rtn_In = $rrd->heartbeat($rrdfile, "bytesIn", 10);
my #rtn_Out = $rrd->heartbeat($rrdfile, "bytesOut", 10);
my #rtn_sec = $rrd->heartbeat($rrdfile, "faultsPerSec", 10); # This method will set a new heartbeat of a data source.
close(FH);
}
Part of the output:
'myfilerrd' => {
'last_ds' => 'U',
'value' => undef,
'min' => '0',
'max' => undef,
'minimal_heartbeat' => 120,
'index' => 3,
'type' => 'DERIVE',
'unknown_sec' => 15
}
I do not understand why the value is undefined?
After 3-4 days of testing and searching over the Internet for more information I just found the answer to my problem. RRD is a very simple to use tool but very very powerful. I would recommend anybody to use it through Perl especially with RRD::Simple module is very easy.
Answer:
I was adjusting the heart beat of my RRD to 10 sec, while my step (data collection time) is 300 by default. If the user do not specify the step "sampling frequency" by default the system will use 300. In result the graph takes 0 values so there is not output. More information and very nice analysis can be found here HeartBeat
Based on my experimentation, I found that since I am using a while loop inside the create function I have to first give the command:
my $rrd = RRD::Simple->new( file => "myfile.rrd" );
and as a second step I had to kill the process and set the step by entering the command:
my $rrd = RRD::Simple->new(
file => "myfile.rrd",
step => 50 );
Based on my experimentation I found that I had to remove this block of code below had to be added to the file as a second step. First had to make the creation and then add it on my loop. This is because initially the "myfile.rrd" has to be created with all the settings, before the user start modifying them.
unless (-f "myfile.rrd") {
$rrd->create(
step => 50,
bytesIn => "GAUGE",
bytesOut => "GAUGE",
faultsPerSec => "COUNTER"
);
}
Another point that worth mentioning here is that by default RRD Data Source (DS) is set to GAUGE. More information can be found here RRDtool
The Perl module can be found easily CPAN RRD::Simple which provides analysis and extra "features" that you can add to your code.
In conclusion RRD::Simple is very simple, it can be executed by copy-paste into your program. Any further modifications (e.g sample rates, Average/Max/Min values etc.) need a bit of reading upon but definitely worth the effort. Unfortunately there is not much of examples online so some testing need it to be done in order to understand what I need to modify in my code to make it work. By writing this short analysis and providing some links to read upon I hope to save someone else from spending a few days to come up with the answer to his problem.
Again I encourage anyone to try implementing RRD's is a very powerful tool to graphically view your results and store the data up to 3 years.
Another update that I think is useful to some people maybe. Instead of following all this process by adding and removing code in order to make the rrd file working.
After modifications and experimentation I found another solution.
use strict;
use RRD::Simple;
use RRDs;
my $rrd = RRD::Simple->new(
file => "myfile.rrd",
rrdtool => "/usr/local/rrdtool-1.2.11/bin/rrdtool", #optional
tmpdir => "/var/tmp", #optional
cf => [ qw(AVERAGE MAX) ], #optional
default_dstype => "COUNTER", #optional
on_missing_ds => "add", #optional
RRDs::tune("myfile.rrd", "-i", "Source_Name:0") #optional -i or --minimum
RRDs::tune("myfile.rrd", "-a", "Source_Name:200") #optional -a or --maximum
);
There are several optional values that someone can use, but I recommend to use all of them so you can take full control of the program.
I am using:
default_dstype => "COUNTER", #optional
Because by default RRD's will set GAUGE as Data Source (DS). By setting the DS to COUNTER the user can set the minimum and maximum values. Short examples can be found here also RRD::Simple::Examples.
Is there a way of converting a time, say 17:00 to 5:00pm using Zend Locale?
I've tried the method in the docs as it is (which has a typo), but it doesn't work. It gives the error 'Unable to parse date '13:44:42' using 'dd.MM.yyyy' (M <> y)'
$locale = new Zend_Locale('de_AT');
if (Zend_Locale_Format::getTime('13:44:42',
array('date_format' =>
Zend_Locale_Format::STANDARD,
'locale' => $locale))) {
print "time";
} else {
print "not a time";
}
I then tried a 2 step method, getting the time format of the current locale first, and then using that in the getTime function.
$locale = new Zend_Locale('en_US');
$tf = Zend_Locale_Format::getTimeFormat($locale);
$test = Zend_Locale_Format::getTime('17:00', array('date_format' => $tf, 'locale' => $locale));
This returns a result but just gives me back what I had
array('date_format'=>'h:mm:ss a', 'locale'=>'en_US', 'hour'=>'17', 'minute'=>'00')
Is there something that will convert the time to the actual locale I'm trying to parse it to?
You need to be using Zend_Date with the locale to get the date in the format you want.
$date = new Zend_Date(); // Default ISO format type & en_US
// Set the time and pass the format I am using to set the time
$date->setTime('17:00:00', 'HH:mm:ss');
echo $date; // Jul 15, 2011 5:00:00 PM
EDIT
More on how you can use Zend_Locale with Zend_Date
$locale = new Zend_Locale('de_AT');
echo $date->toString(Zend_Locale_Format::getTimeFormat($locale)) ; // 17:00:00
$locale = new Zend_Locale('en_US');
echo $date->toString(Zend_Locale_Format::getTimeFormat($locale)) ; // 5:00:00 PM