Show
Ignore:
Timestamp:
10/07/08 16:52:52 (3 months ago)
Author:
ogawa
Message:

merged from cybozu2ical

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • WWW-CybozuOffice6-Calendar/trunk/lib/WWW/CybozuOffice6/Calendar.pm

    r369 r523  
    55use warnings; 
    66 
    7 use Encode qw/from_to/; 
     7use base qw( Class::Accessor::Fast ); 
     8use Carp; 
     9use Encode qw( from_to ); 
    810use LWP::UserAgent; 
    9 use DateTime; 
    10 use Text::CSV_XS; 
    11  
    12 our $VERSION = '0.02'; 
     11use WWW::CybozuOffice6::Calendar::Event; 
     12use WWW::CybozuOffice6::Calendar::RecurrentEvent; 
     13 
     14our $VERSION = '0.32'; 
    1315 
    1416sub new { 
    15     my($class, %param) = @_; 
    16     $param{url} ||= delete $param{cybozu_url}; 
    17     $param{ua} ||= LWP::UserAgent->new(); 
    18     bless \%param, $class; 
    19 } 
    20  
    21 sub url                 { shift->_accessor('url',               @_) } 
    22 sub username            { shift->_accessor('username',          @_) } 
    23 sub userid              { shift->_accessor('userid',            @_) } 
    24 sub password            { shift->_accessor('password',          @_) } 
    25 sub ua                  { shift->_accessor('ua',                @_) } 
    26 sub input_encoding      { shift->_accessor('input_encoding',    @_) } 
    27 sub _accessor { 
    28     my $this = shift; 
    29     my $key = shift; 
    30     $this->{$key} = shift if @_; 
    31     $this->{$key}; 
     17    my $class   = shift; 
     18    my (%param) = @_; 
     19    my $cal     = bless \%param, $class; 
     20    $cal->{url} ||= delete $cal->{cybozu_url}; 
     21    $cal->{calendar_driver} = 
     22      WWW::CybozuOffice6::CalendarDriverFactory->get_driver( 
     23        $cal->{calendar_driver} ) 
     24      unless ref $cal->{calendar_driver}; 
     25    $cal; 
     26} 
     27 
     28__PACKAGE__->mk_accessors(qw( url username userid password input_encoding )); 
     29 
     30sub request { 
     31    my $cal = shift; 
     32    $cal->{calendar_driver}->request($cal); 
     33} 
     34 
     35sub read_from_csv_file { 
     36    my $cal = shift; 
     37    my ($file) = @_; 
     38    local *FH; 
     39    open FH, $file or confess "Failed to read $file"; 
     40    my @lines; 
     41    while (<FH>) { 
     42        chomp; 
     43        push @lines, $_; 
     44    } 
     45    close(FH); 
     46    $cal->{response} = \@lines; 
     47 
     48    scalar @lines ? \@lines : undef; 
     49} 
     50 
     51sub response { 
     52    my $res = $_[0]->{response} || {}; 
     53    wantarray ? @$res : $res; 
    3254} 
    3355 
    3456sub get_items { 
    35     my $this = shift; 
    36  
    37     my $res = $this->_request(); 
    38     die 'Failed to access Cybozu Office 6: ' . $res->status_line 
    39         unless $res->is_success; 
    40  
    41     my $content = $res->content; 
    42     from_to($content, $this->{input_encoding} || 'shiftjis', 'utf8'); 
    43     my @lines = grep /^\d+,ts\.\d+,/, split(/\r?\n/, $content); 
    44  
    45     my @items; 
    46     my $csv = Text::CSV_XS->new({ binary => 1 }); 
    47     for my $line (@lines) { 
    48         $csv->parse($line) 
    49             or die 'Failed to parse CSV input'; 
    50         my @fields = $csv->fields; 
    51         next if $#fields < 13; # num. of fields 
    52  
    53         # Cybozu Calendar CSV Format 
    54         #      GENERIC     | RECCURENT 
    55         # [ 0] id?         | id? 
    56         # [ 1] created     | created 
    57         # [ 2] <BLANK>     x start_date 
    58         # [ 3] start_date  x end_date 
    59         # [ 4] end_date    x until_date 
    60         # [ 5] start_time  | start_time 
    61         # [ 6] end_time    | end_time 
    62         # [ 7] <BLANK>     | freq 
    63         # [ 8] <BLANK>     | freq_value 
    64         # [ 9] ???         | ??? 
    65         # [10] ???         | ??? 
    66         # [11] abbrev      | abbrev 
    67         # [12] summary     | summary 
    68         # [13] description | description 
    69  
    70         my %param; 
    71         @param{qw(created start_time end_time freq freq_value abbrev summary description)} = @fields[1,5..8,11..13]; 
    72         $param{created} =~ s/^ts\.//; 
    73         $param{time_zone} = $this->{time_zone} || 'Asia/Tokyo'; 
    74  
    75         my $item; 
    76         if (!$param{freq}) { 
    77             @param{qw(start_date end_date)} = @fields[3,4]; 
    78             $item = WWW::CybozuOffice6::Calendar::Event->new(%param); 
    79         } else { 
    80             @param{qw(start_date end_date until_date)} = @fields[2..4]; 
    81             $item = WWW::CybozuOffice6::Calendar::RecurentEvent->new(%param); 
    82         } 
    83  
    84         next unless $item; 
    85         $item->comment($line); # save the CSV line as for debug info. 
    86         push @items, $item; 
    87     } 
    88     wantarray ? @items : $items[0]; 
    89 } 
    90  
    91 sub _request { 
    92     my $this = shift; 
    93     $this->{ua}->post($this->{url} . '?page=SyncCalendar', { 
    94         _System    => 'login', 
    95         _Login     => 1, 
    96         csv        => 1, 
    97         notimecard => 1, 
    98         defined $this->{username} ? (_Account => $this->{username}) : (), 
    99         defined $this->{userid}   ? (_Id      => $this->{userid}  ) : (), 
    100         Password   => $this->{password} || '', 
    101     }); 
    102 } 
    103  
    104 package WWW::CybozuOffice6::Calendar::Event; 
    105  
    106 sub new { 
     57    my $cal = shift; 
     58    $cal->{calendar_driver}->get_items($cal); 
     59} 
     60 
     61package WWW::CybozuOffice6::CalendarDriverFactory; 
     62 
     63sub get_driver { 
    10764    my $class = shift; 
    108     my $self = { 
    109         is_full_day => 0, 
    110 #       modified => DateTime->now, 
    111     }; 
    112     bless $self, $class; 
    113     return unless $self->parse(@_); 
    114     $self; 
    115 } 
    116  
    117 sub start       { shift->_accessor('start',             @_) } 
    118 sub end         { shift->_accessor('end',               @_) } 
    119 sub summary     { shift->_accessor('summary',           @_) } 
    120 sub description { shift->_accessor('description',       @_) } 
    121 sub created     { shift->_accessor('created',           @_) } 
    122 sub modified    { shift->_accessor('modified',          @_) } 
    123 sub is_full_day { shift->_accessor('is_full_day',       @_) } 
    124 sub comment     { shift->_accessor('comment',           @_) } 
    125 sub _accessor { 
    126     my $this = shift; 
    127     my $key = shift; 
    128     $this->{$key} = shift if @_; 
    129     $this->{$key}; 
    130 } 
    131  
    132 sub parse { 
    133     my($this, %param) = @_; 
    134  
    135     $this->{time_zone} = $param{time_zone} || 'Asia/Tokyo'; 
    136  
    137     my $start = $this->to_datetime($param{start_date}, $param{start_time}); 
    138     my $end   = $this->to_datetime($param{end_date},   $param{end_time}); 
    139     return unless $start && $end; 
    140  
    141     # (start_time == empty) => A full-day event 
    142     # (start_time != empty) && (end_time == empty) => A malformed event 
    143     if ($param{start_time} eq ':') { 
    144         $start = $start->truncate(to => 'day'); 
    145         $end   = $end->add(days => 1)->truncate(to => 'day'); 
    146         $this->{is_full_day} = 1; 
    147     } elsif ($param{end_time} eq ':') { 
    148         $end   = $start->clone->add(minutes => 10); 
    149     } 
    150     $this->{start} = $start; 
    151     $this->{end}   = $end; 
    152  
    153     $this->{created} = DateTime->from_epoch(epoch => $param{created} || 0); 
    154     $this->{modified} = DateTime->from_epoch(epoch => $param{created} || 0); 
    155  
    156     my $summary = ($param{abbrev} ? $param{abbrev} . ': ' : '') . $param{summary}; 
    157     $this->{summary} = $summary; 
    158     $this->{description} = $param{description} || $summary; 
    159     1; 
    160 } 
    161  
    162 # convert (ymd, hms) pair to a DateTime object (timezone: localtime) 
    163 sub to_datetime { 
    164     my $this = shift; 
    165     my($ymd, $hms) = @_; 
    166  
    167     my %args; 
    168     return unless $ymd && $ymd =~ m!^(\d+)/(\d+)/(\d+)$!; 
    169     @args{qw(year month day)} = ($1, $2, $3); 
    170  
    171     if ($hms && $hms ne ':') { 
    172         return unless $hms =~ m!^(\d+):(\d+)(?:\:?(\d+)?)$!; 
    173         @args{qw(hour minute second)} = ($1, $2, $3 || 0); 
    174         @args{qw(hour minute second)} = (23, 59, 59) if $args{hour} > 23; 
    175     } else { 
    176         @args{qw(hour minute second)} = (0, 0, 0); 
    177     } 
    178  
    179     $args{time_zone} = $this->{time_zone}; 
    180  
    181     DateTime->new(%args); 
    182 } 
    183  
    184 package WWW::CybozuOffice6::Calendar::RecurrentEvent; 
    185  
    186 @WWW::CybozuOffice6::Calendar::RecurrentEvent::ISA = qw( WWW::CybozuOffice6::Calendar::Event ); 
    187  
    188 sub frequency           { shift->_accessor('frequency',         @_) } 
    189 sub frequency_value     { shift->_accessor('frequency_value',   @_) } 
    190  
    191 our %FREQUENCY = ( y => 'YEARLY', m => 'MONTHLY', w => 'WEEKLY', 
    192                    d => 'DAILY', n => 'WEEKDAYS' ); 
    193 sub parse { 
    194     my($this, %param) = @_; 
    195     $this->SUPER::parse(%param); 
    196  
    197     # frequency 
    198     my $freq = $param{freq}; 
    199     return unless $freq && exists $FREQUENCY{$freq}; 
    200  
    201     $this->{frequency} = $FREQUENCY{$freq}; 
    202     $this->{frequency_value} = $param{freq_value} || 0; 
    203  
    204     if ($param{until_date} =~ m!^(\d+)/(\d+)/(\d+)$!) { 
    205         my %args = (year => $1, month => $2, day => $3); 
    206         my $until; 
    207         if ($this->{is_full_day}) { 
    208             $until = $this->to_datetime($param{until_date}, ':'); 
    209         } else { 
    210             $until = $this->{end}->clone->set(%args); 
    211             $until->set_time_zone('UTC'); # timezone must be UTC 
    212         } 
    213         $this->{until} = $until; 
    214     } 
    215     1; 
     65    my ($driver_name) = @_; 
     66    $driver_name ||= 'ApiCalendar'; 
     67    $driver_name = 'WWW::CybozuOffice6::CalendarDriver::' . $driver_name 
     68      if $driver_name !~ m/^WWW::CybozuOffice6::CalendarDriver::/; 
     69    eval "use $driver_name;"; 
     70    $driver_name->new; 
    21671} 
    21772 
    … …  
    22176=head1 NAME 
    22277 
    223 WWW::CybozuOffice6::Calendar - Perl extension for accessing Cybozu Office 6 Calendar 
     78WWW::CybozuOffice6::Calendar - Perl extension for accessing Cybozu Office Calendar 
    22479 
    22580=head1 SYNOPSIS 
    … …  
    23489  ); 
    23590 
     91  # request calendar contents 
     92  $calendar->request(); 
     93 
    23694  # get list of items in the calendar 
    23795  my @items = $calendar->get_items(); 
    … …  
    24098 
    24199C<WWW::CybozuOffice6::Calendar> is a Perl extension for accessing 
    242 Cybozu Office 6 Calendar. 
     100Cybozu Office Calendar. 
    243101 
    244102=head1 REQUIREMENT 
    … …  
    249107=over 4 
    250108 
    251 =item Text::CSV_XS 
     109=item Text::CSV_XS or Text::CSV 
    252110 
    253111=item DateTime 
     112 
     113=item LWP::UserAgent 
     114 
     115=item Class::Accessor::Fast 
    254116 
    255117=back 
    … …  
    278140Password for Cybozu Office 6. 
    279141 
    280 =item ua 
    281  
    282 (optional) An LWP::UserAgent object used for accessing Cybozu. 
    283  
    284142=item input_encoding 
    285143 
    … …  
    311169 
    312170Gets/sets the Cybozu Office 6 encoding. 
     171 
     172=item request() 
     173 
     174Requests to obtain the contents of Cybozu Office 6 Calendar. 
     175 
     176=item read_from_csv_file($filename) 
     177 
     178Instead of requesting Cybozu Office 6 server, reads from a local CSV file. 
    313179 
    314180=item get_items() 
    … …  
    319185=over 8 
    320186 
     187=item id (string) 
     188 
     189A unique id. 
     190 
    321191=item start (DateTime object) 
    322192 
    … …  
    347217Modified date of the item, or current timestamp.  DateTime object. 
    348218 
    349 =item frequency (string) 
     219=item rrule (HASHREF of rrule properties) 
     220 
     221Assocative list of recurrence rules for the item, which is *roughly* 
     222based on iCalendar Specification (RFC 2445). 
     223 
     224=item exdates (ARRAYREF of DateTime objects) 
     225 
     226Excluded dates of the reccurent item.  If the item has no excluded 
     227dates, this should be "undefined". 
     228 
     229=item [obsolete] frequency (string) 
    350230 
    351231Frequency mode of the recurrent item.  Each recurrent items has one 
    … …  
    354234  "YEARLY", "MONTHLY", "WEEKLY", "DAILY", "WEEKDAYS" 
    355235 
    356 =item frequency_value (integer) 
     236=item [obsolete] frequency_value (integer) 
    357237 
    358238Frequency value of the recurrent item. 
    359239 
    360 =item until (DateTime object) 
     240=item [obsolete] until (DateTime object) 
    361241 
    362242End date of the recurrence for the recurrent item.  If the recurrence 
    … …  
    384264Any comments, suggestions, or patches are welcome. 
    385265 
    386 =head1 AUTHOR 
    387  
    388 Hirotaka Ogawa E<lt>hirotaka.ogawa at gmail.comE<gt> 
    389  
    390 This script is free software and licensed under the same terms as Perl 
    391 (Artistic/GPL). 
     266=head1 LICENSE 
     267 
     268Copyright (c) 2008 Hirotaka Ogawa E<lt>hirotaka.ogawa at gmail.comE<gt>. 
     269All rights reserved. 
     270 
     271This library is free software; you can redistribute it and/or modify 
     272it under the terms of either: 
     273        
     274   a) the GNU General Public License as published by the Free Software 
     275      Foundation; either version 1, or (at your option) any later 
     276      version, or 
     277                          
     278   b) the "Artistic License" which comes with Perl. 
    392279 
    393280=cut