RTx-Calendar-1.00/0000755000175000017500000000000012443706064012674 5ustar chmrrchmrrRTx-Calendar-1.00/META.yml0000644000175000017500000000124112443706032014136 0ustar chmrrchmrr--- abstract: 'Calendar for RT due dates' author: - 'Best Practical Solutions, LLC ' build_requires: ExtUtils::MakeMaker: 6.59 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.12' license: gpl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: RTx-Calendar no_index: directory: - html - inc - static requires: DateTime: 0 DateTime::Set: 0 perl: 5.8.3 resources: license: http://opensource.org/licenses/gpl-license.php version: '1.00' x_module_install_rtx_version: '0.36' x_requires_rt: 4.0.9 RTx-Calendar-1.00/README0000644000175000017500000000412112443706031013544 0ustar chmrrchmrrNAME RTx::Calendar - Calendar for RT due dates DESCRIPTION This RT extension provides a calendar view for your tickets and your reminders so you see when is your next due ticket. You can find it in the menu Search->Calendar. There's a portlet to put on your home page (see Prefs/MyRT.html) INSTALLATION perl Makefile.PL make make install May need root permissions Edit your /opt/rt4/etc/RT_SiteConfig.pm If you are using RT 4.2 or greater, add this line: Plugin('RTx::Calendar'); For RT 4.0, add this line: Set(@Plugins, qw(RTx::Calendar)); or add RTx::Calendar to your existing @Plugins line. Clear your mason cache rm -rf /opt/rt4/var/mason_data/obj Restart your webserver CONFIGURATION Base configuration To use the MyCalendar portlet, you must add MyCalendar to $HomepageComponents in etc/RT_SiteConfig.pm: Set($HomepageComponents, [qw(QuickCreate Quicksearch MyCalendar MyAdminQueues MySupportQueues MyReminders RefreshHomepage)]); Display configuration You can show the owner in each day box by adding this line to your etc/RT_SiteConfig.pm: Set($CalendarDisplayOwner, 1); You can change which fields show up in the popup display when you mouse over a date in etc/RT_SiteConfig.pm: Set(@CalendarPopupFields, ('Status', 'OwnerObj->Name', 'DueObj->ISO')); USAGE A small help section is available in /Prefs/Calendar.html AUTHOR Best Practical Solutions, LLC Originally written by Nicolas Chuche BUGS All bugs should be reported via email to L or via the web at L. LICENSE AND COPYRIGHT This software is Copyright (c) 2010-2014 by Best Practical Solutions Copyright 2007-2009 by Nicolas Chuche This is free software, licensed under: The GNU General Public License, Version 2, June 1991 RTx-Calendar-1.00/TODO0000644000175000017500000000054312443705763013373 0ustar chmrrchmrrTODO * add test with Test::WWW::Mechanize * add links from the calendar page ALREADY DONE * (chaka) add a personnal calendar with a saved query * (ymmv) ICal feeds * (chaka) put the results of a Query Builder search on a calendar * (chaka) link from MyCalendar should automatically go to Calendar.html with filter set to Owner=CurrentUser RTx-Calendar-1.00/Makefile.PL0000644000175000017500000000021312443705714014643 0ustar chmrrchmrruse inc::Module::Install; RTx('RTx-Calendar'); requires 'DateTime'; requires 'DateTime::Set'; requires_rt '4.0.9'; sign(); WriteAll(); RTx-Calendar-1.00/inc/0000755000175000017500000000000012443706064013445 5ustar chmrrchmrrRTx-Calendar-1.00/inc/YAML/0000755000175000017500000000000012443706064014207 5ustar chmrrchmrrRTx-Calendar-1.00/inc/YAML/Tiny.pm0000644000175000017500000006041312443706032015467 0ustar chmrrchmrr#line 1 use 5.008001; # sane UTF-8 support use strict; use warnings; package YAML::Tiny; BEGIN { $YAML::Tiny::AUTHORITY = 'cpan:ADAMK'; } # git description: v1.61-3-g0a82466 $YAML::Tiny::VERSION = '1.62'; # XXX-INGY is 5.8.1 too old/broken for utf8? # XXX-XDG Lancaster consensus was that it was sufficient until # proven otherwise ##################################################################### # The YAML::Tiny API. # # These are the currently documented API functions/methods and # exports: use Exporter; our @ISA = qw{ Exporter }; our @EXPORT = qw{ Load Dump }; our @EXPORT_OK = qw{ LoadFile DumpFile freeze thaw }; ### # Functional/Export API: sub Dump { return YAML::Tiny->new(@_)->_dump_string; } # XXX-INGY Returning last document seems a bad behavior. # XXX-XDG I think first would seem more natural, but I don't know # that it's worth changing now sub Load { my $self = YAML::Tiny->_load_string(@_); if ( wantarray ) { return @$self; } else { # To match YAML.pm, return the last document return $self->[-1]; } } # XXX-INGY Do we really need freeze and thaw? # XXX-XDG I don't think so. I'd support deprecating them. BEGIN { *freeze = \&Dump; *thaw = \&Load; } sub DumpFile { my $file = shift; return YAML::Tiny->new(@_)->_dump_file($file); } sub LoadFile { my $file = shift; my $self = YAML::Tiny->_load_file($file); if ( wantarray ) { return @$self; } else { # Return only the last document to match YAML.pm, return $self->[-1]; } } ### # Object Oriented API: # Create an empty YAML::Tiny object # XXX-INGY Why do we use ARRAY object? # NOTE: I get it now, but I think it's confusing and not needed. # Will change it on a branch later, for review. # # XXX-XDG I don't support changing it yet. It's a very well-documented # "API" of YAML::Tiny. I'd support deprecating it, but Adam suggested # we not change it until YAML.pm's own OO API is established so that # users only have one API change to digest, not two sub new { my $class = shift; bless [ @_ ], $class; } # XXX-INGY It probably doesn't matter, and it's probably too late to # change, but 'read/write' are the wrong names. Read and Write # are actions that take data from storage to memory # characters/strings. These take the data to/from storage to native # Perl objects, which the terms dump and load are meant. As long as # this is a legacy quirk to YAML::Tiny it's ok, but I'd prefer not # to add new {read,write}_* methods to this API. sub read_string { my $self = shift; $self->_load_string(@_); } sub write_string { my $self = shift; $self->_dump_string(@_); } sub read { my $self = shift; $self->_load_file(@_); } sub write { my $self = shift; $self->_dump_file(@_); } ##################################################################### # Constants # Printed form of the unprintable characters in the lowest range # of ASCII characters, listed by ASCII ordinal position. my @UNPRINTABLE = qw( 0 x01 x02 x03 x04 x05 x06 a b t n v f r x0E x0F x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x1A e x1C x1D x1E x1F ); # Printable characters for escapes my %UNESCAPES = ( 0 => "\x00", z => "\x00", N => "\x85", a => "\x07", b => "\x08", t => "\x09", n => "\x0a", v => "\x0b", f => "\x0c", r => "\x0d", e => "\x1b", '\\' => '\\', ); # XXX-INGY # I(ngy) need to decide if these values should be quoted in # YAML::Tiny or not. Probably yes. # These 3 values have special meaning when unquoted and using the # default YAML schema. They need quotes if they are strings. my %QUOTE = map { $_ => 1 } qw{ null true false }; # The commented out form is simpler, but overloaded the Perl regex # engine due to recursion and backtracking problems on strings # larger than 32,000ish characters. Keep it for reference purposes. # qr/\"((?:\\.|[^\"])*)\"/ my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/; my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/; # unquoted re gets trailing space that needs to be stripped my $re_capture_unquoted_key = qr/([^:]+(?::+\S(?:[^:]*|.*?(?=:)))*)(?=\s*\:(?:\s+|$))/; my $re_trailing_comment = qr/(?:\s+\#.*)?/; my $re_key_value_separator = qr/\s*:(?:\s+(?:\#.*)?|$)/; ##################################################################### # YAML::Tiny Implementation. # # These are the private methods that do all the work. They may change # at any time. ### # Loader functions: # Create an object from a file sub _load_file { my $class = ref $_[0] ? ref shift : shift; # Check the file my $file = shift or $class->_error( 'You did not specify a file name' ); $class->_error( "File '$file' does not exist" ) unless -e $file; $class->_error( "'$file' is a directory, not a file" ) unless -f _; $class->_error( "Insufficient permissions to read '$file'" ) unless -r _; # Open unbuffered with strict UTF-8 decoding and no translation layers open( my $fh, "<:unix:encoding(UTF-8)", $file ); unless ( $fh ) { $class->_error("Failed to open file '$file': $!"); } # flock if available (or warn if not possible for OS-specific reasons) if ( _can_flock() ) { flock( $fh, Fcntl::LOCK_SH() ) or warn "Couldn't lock '$file' for reading: $!"; } # slurp the contents my $contents = eval { use warnings FATAL => 'utf8'; local $/; <$fh> }; if ( my $err = $@ ) { $class->_error("Error reading from file '$file': $err"); } # close the file (release the lock) unless ( close $fh ) { $class->_error("Failed to close file '$file': $!"); } $class->_load_string( $contents ); } # Create an object from a string sub _load_string { my $class = ref $_[0] ? ref shift : shift; my $self = bless [], $class; my $string = $_[0]; eval { unless ( defined $string ) { die \"Did not provide a string to load"; } # Check if Perl has it marked as characters, but it's internally # inconsistent. E.g. maybe latin1 got read on a :utf8 layer if ( utf8::is_utf8($string) && ! utf8::valid($string) ) { die \<<'...'; Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set). Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"? ... } # Ensure Unicode character semantics, even for 0x80-0xff utf8::upgrade($string); # Check for and strip any leading UTF-8 BOM $string =~ s/^\x{FEFF}//; # Check for some special cases return $self unless length $string; # Split the file into lines my @lines = grep { ! /^\s*(?:\#.*)?\z/ } split /(?:\015{1,2}\012|\015|\012)/, $string; # Strip the initial YAML header @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines; # A nibbling parser my $in_document = 0; while ( @lines ) { # Do we have a document header? if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) { # Handle scalar documents shift @lines; if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) { push @$self, $self->_load_scalar( "$1", [ undef ], \@lines ); next; } $in_document = 1; } if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { # A naked document push @$self, undef; while ( @lines and $lines[0] !~ /^---/ ) { shift @lines; } $in_document = 0; # XXX The final '-+$' is to look for -- which ends up being an # error later. } elsif ( ! $in_document && @$self ) { # only the first document can be explicit die \"YAML::Tiny failed to classify the line '$lines[0]'"; } elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) { # An array at the root my $document = [ ]; push @$self, $document; $self->_load_array( $document, [ 0 ], \@lines ); } elsif ( $lines[0] =~ /^(\s*)\S/ ) { # A hash at the root my $document = { }; push @$self, $document; $self->_load_hash( $document, [ length($1) ], \@lines ); } else { # Shouldn't get here. @lines have whitespace-only lines # stripped, and previous match is a line with any # non-whitespace. So this clause should only be reachable via # a perlbug where \s is not symmetric with \S # uncoverable statement die \"YAML::Tiny failed to classify the line '$lines[0]'"; } } }; if ( ref $@ eq 'SCALAR' ) { $self->_error(${$@}); } elsif ( $@ ) { $self->_error($@); } return $self; } sub _unquote_single { my ($self, $string) = @_; return '' unless length $string; $string =~ s/\'\'/\'/g; return $string; } sub _unquote_double { my ($self, $string) = @_; return '' unless length $string; $string =~ s/\\"/"/g; $string =~ s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))} {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex; return $string; } # Load a YAML scalar string to the actual Perl scalar sub _load_scalar { my ($self, $string, $indent, $lines) = @_; # Trim trailing whitespace $string =~ s/\s*\z//; # Explitic null/undef return undef if $string eq '~'; # Single quote if ( $string =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) { return $self->_unquote_single($1); } # Double quote. if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) { return $self->_unquote_double($1); } # Special cases if ( $string =~ /^[\'\"!&]/ ) { die \"YAML::Tiny does not support a feature in line '$string'"; } return {} if $string =~ /^{}(?:\s+\#.*)?\z/; return [] if $string =~ /^\[\](?:\s+\#.*)?\z/; # Regular unquoted string if ( $string !~ /^[>|]/ ) { die \"YAML::Tiny found illegal characters in plain scalar: '$string'" if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or $string =~ /:(?:\s|$)/; $string =~ s/\s+#.*\z//; return $string; } # Error die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines; # Check the indent depth $lines->[0] =~ /^(\s*)/; $indent->[-1] = length("$1"); if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { die \"YAML::Tiny found bad indenting in line '$lines->[0]'"; } # Pull the lines my @multiline = (); while ( @$lines ) { $lines->[0] =~ /^(\s*)/; last unless length($1) >= $indent->[-1]; push @multiline, substr(shift(@$lines), length($1)); } my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; return join( $j, @multiline ) . $t; } # Load an array sub _load_array { my ($self, $array, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { die \"YAML::Tiny found bad indenting in line '$lines->[0]'"; } if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { # Inline nested hash my $indent2 = length("$1"); $lines->[0] =~ s/-/ /; push @$array, { }; $self->_load_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) { shift @$lines; unless ( @$lines ) { push @$array, undef; return 1; } if ( $lines->[0] =~ /^(\s*)\-/ ) { my $indent2 = length("$1"); if ( $indent->[-1] == $indent2 ) { # Null array entry push @$array, undef; } else { # Naked indenter push @$array, [ ]; $self->_load_array( $array->[-1], [ @$indent, $indent2 ], $lines ); } } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { push @$array, { }; $self->_load_hash( $array->[-1], [ @$indent, length("$1") ], $lines ); } else { die \"YAML::Tiny failed to classify line '$lines->[0]'"; } } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) { # Array entry with a value shift @$lines; push @$array, $self->_load_scalar( "$2", [ @$indent, undef ], $lines ); } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { # This is probably a structure like the following... # --- # foo: # - list # bar: value # # ... so lets return and let the hash parser handle it return 1; } else { die \"YAML::Tiny failed to classify line '$lines->[0]'"; } } return 1; } # Load a hash sub _load_hash { my ($self, $hash, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { die \"YAML::Tiny found bad indenting in line '$lines->[0]'"; } # Find the key my $key; # Quoted keys if ( $lines->[0] =~ s/^\s*$re_capture_single_quoted$re_key_value_separator// ) { $key = $self->_unquote_single($1); } elsif ( $lines->[0] =~ s/^\s*$re_capture_double_quoted$re_key_value_separator// ) { $key = $self->_unquote_double($1); } elsif ( $lines->[0] =~ s/^\s*$re_capture_unquoted_key$re_key_value_separator// ) { $key = $1; $key =~ s/\s+$//; } elsif ( $lines->[0] =~ /^\s*\?/ ) { die \"YAML::Tiny does not support a feature in line '$lines->[0]'"; } else { die \"YAML::Tiny failed to classify line '$lines->[0]'"; } # Do we have a value? if ( length $lines->[0] ) { # Yes $hash->{$key} = $self->_load_scalar( shift(@$lines), [ @$indent, undef ], $lines ); } else { # An indent shift @$lines; unless ( @$lines ) { $hash->{$key} = undef; return 1; } if ( $lines->[0] =~ /^(\s*)-/ ) { $hash->{$key} = []; $self->_load_array( $hash->{$key}, [ @$indent, length($1) ], $lines ); } elsif ( $lines->[0] =~ /^(\s*)./ ) { my $indent2 = length("$1"); if ( $indent->[-1] >= $indent2 ) { # Null hash entry $hash->{$key} = undef; } else { $hash->{$key} = {}; $self->_load_hash( $hash->{$key}, [ @$indent, length($1) ], $lines ); } } } } return 1; } ### # Dumper functions: # Save an object to a file sub _dump_file { my $self = shift; require Fcntl; # Check the file my $file = shift or $self->_error( 'You did not specify a file name' ); my $fh; # flock if available (or warn if not possible for OS-specific reasons) if ( _can_flock() ) { # Open without truncation (truncate comes after lock) my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT(); sysopen( $fh, $file, $flags ); unless ( $fh ) { $self->_error("Failed to open file '$file' for writing: $!"); } # Use no translation and strict UTF-8 binmode( $fh, ":raw:encoding(UTF-8)"); flock( $fh, Fcntl::LOCK_EX() ) or warn "Couldn't lock '$file' for reading: $!"; # truncate and spew contents truncate $fh, 0; seek $fh, 0, 0; } else { open $fh, ">:unix:encoding(UTF-8)", $file; } # serialize and spew to the handle print {$fh} $self->_dump_string; # close the file (release the lock) unless ( close $fh ) { $self->_error("Failed to close file '$file': $!"); } return 1; } # Save an object to a string sub _dump_string { my $self = shift; return '' unless ref $self && @$self; # Iterate over the documents my $indent = 0; my @lines = (); eval { foreach my $cursor ( @$self ) { push @lines, '---'; # An empty document if ( ! defined $cursor ) { # Do nothing # A scalar document } elsif ( ! ref $cursor ) { $lines[-1] .= ' ' . $self->_dump_scalar( $cursor ); # A list at the root } elsif ( ref $cursor eq 'ARRAY' ) { unless ( @$cursor ) { $lines[-1] .= ' []'; next; } push @lines, $self->_dump_array( $cursor, $indent, {} ); # A hash at the root } elsif ( ref $cursor eq 'HASH' ) { unless ( %$cursor ) { $lines[-1] .= ' {}'; next; } push @lines, $self->_dump_hash( $cursor, $indent, {} ); } else { die \("Cannot serialize " . ref($cursor)); } } }; if ( ref $@ eq 'SCALAR' ) { $self->_error(${$@}); } elsif ( $@ ) { $self->_error($@); } join '', map { "$_\n" } @lines; } sub _has_internal_string_value { my $value = shift; my $b_obj = B::svref_2object(\$value); # for round trip problem return $b_obj->FLAGS & B::SVf_POK(); } sub _dump_scalar { my $string = $_[1]; my $is_key = $_[2]; # Check this before checking length or it winds up looking like a string! my $has_string_flag = _has_internal_string_value($string); return '~' unless defined $string; return "''" unless length $string; if (Scalar::Util::looks_like_number($string)) { # keys and values that have been used as strings get quoted if ( $is_key || $has_string_flag ) { return qq['$string']; } else { return $string; } } if ( $string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/ ) { $string =~ s/\\/\\\\/g; $string =~ s/"/\\"/g; $string =~ s/\n/\\n/g; $string =~ s/[\x85]/\\N/g; $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g; $string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge; return qq|"$string"|; } if ( $string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or $QUOTE{$string} ) { return "'$string'"; } return $string; } sub _dump_array { my ($self, $array, $indent, $seen) = @_; if ( $seen->{refaddr($array)}++ ) { die \"YAML::Tiny does not support circular references"; } my @lines = (); foreach my $el ( @$array ) { my $line = (' ' x $indent) . '-'; my $type = ref $el; if ( ! $type ) { $line .= ' ' . $self->_dump_scalar( $el ); push @lines, $line; } elsif ( $type eq 'ARRAY' ) { if ( @$el ) { push @lines, $line; push @lines, $self->_dump_array( $el, $indent + 1, $seen ); } else { $line .= ' []'; push @lines, $line; } } elsif ( $type eq 'HASH' ) { if ( keys %$el ) { push @lines, $line; push @lines, $self->_dump_hash( $el, $indent + 1, $seen ); } else { $line .= ' {}'; push @lines, $line; } } else { die \"YAML::Tiny does not support $type references"; } } @lines; } sub _dump_hash { my ($self, $hash, $indent, $seen) = @_; if ( $seen->{refaddr($hash)}++ ) { die \"YAML::Tiny does not support circular references"; } my @lines = (); foreach my $name ( sort keys %$hash ) { my $el = $hash->{$name}; my $line = (' ' x $indent) . $self->_dump_scalar($name, 1) . ":"; my $type = ref $el; if ( ! $type ) { $line .= ' ' . $self->_dump_scalar( $el ); push @lines, $line; } elsif ( $type eq 'ARRAY' ) { if ( @$el ) { push @lines, $line; push @lines, $self->_dump_array( $el, $indent + 1, $seen ); } else { $line .= ' []'; push @lines, $line; } } elsif ( $type eq 'HASH' ) { if ( keys %$el ) { push @lines, $line; push @lines, $self->_dump_hash( $el, $indent + 1, $seen ); } else { $line .= ' {}'; push @lines, $line; } } else { die \"YAML::Tiny does not support $type references"; } } @lines; } ##################################################################### # DEPRECATED API methods: # Error storage (DEPRECATED as of 1.57) our $errstr = ''; # Set error sub _error { require Carp; $errstr = $_[1]; $errstr =~ s/ at \S+ line \d+.*//; Carp::croak( $errstr ); } # Retrieve error my $errstr_warned; sub errstr { require Carp; Carp::carp( "YAML::Tiny->errstr and \$YAML::Tiny::errstr is deprecated" ) unless $errstr_warned++; $errstr; } ##################################################################### # Helper functions. Possibly not needed. # Use to detect nv or iv use B; # XXX-INGY Is flock YAML::Tiny's responsibility? # Some platforms can't flock :-( # XXX-XDG I think it is. When reading and writing files, we ought # to be locking whenever possible. People (foolishly) use YAML # files for things like session storage, which has race issues. my $HAS_FLOCK; sub _can_flock { if ( defined $HAS_FLOCK ) { return $HAS_FLOCK; } else { require Config; my $c = \%Config::Config; $HAS_FLOCK = grep { $c->{$_} } qw/d_flock d_fcntl_can_lock d_lockf/; require Fcntl if $HAS_FLOCK; return $HAS_FLOCK; } } # XXX-INGY Is this core in 5.8.1? Can we remove this? # XXX-XDG Scalar::Util 1.18 didn't land until 5.8.8, so we need this ##################################################################### # Use Scalar::Util if possible, otherwise emulate it BEGIN { local $@; if ( eval { require Scalar::Util; Scalar::Util->VERSION(1.18); } ) { *refaddr = *Scalar::Util::refaddr; } else { eval <<'END_PERL'; # Scalar::Util failed to load or too old sub refaddr { my $pkg = ref($_[0]) or return undef; if ( !! UNIVERSAL::can($_[0], 'can') ) { bless $_[0], 'Scalar::Util::Fake'; } else { $pkg = undef; } "$_[0]" =~ /0x(\w+)/; my $i = do { no warnings 'portable'; hex $1 }; bless $_[0], $pkg if defined $pkg; $i; } END_PERL } } 1; # XXX-INGY Doc notes I'm putting up here. Changing the doc when it's wrong # but leaving grey area stuff up here. # # I would like to change Read/Write to Load/Dump below without # changing the actual API names. # # It might be better to put Load/Dump API in the SYNOPSIS instead of the # dubious OO API. # # null and bool explanations may be outdated. __END__ #line 1488 RTx-Calendar-1.00/inc/unicore/0000755000175000017500000000000012443706064015111 5ustar chmrrchmrrRTx-Calendar-1.00/inc/unicore/Name.pm0000644000175000017500000002137012443706032016325 0ustar chmrrchmrr#line 1 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! # This file is machine-generated by lib/unicore/mktables from the Unicode # database, Version 6.3.0. Any changes made here will be lost! # !!!!!!! INTERNAL PERL USE ONLY !!!!!!! # This file is for internal use by core Perl only. The format and even the # name or existence of this file are subject to change without notice. Don't # use it directly. Use Unicode::UCD to access the Unicode character data # base. package charnames; # This module contains machine-generated tables and code for the # algorithmically-determinable Unicode character names. The following # routines can be used to translate between name and code point and vice versa { # Closure # Matches legal code point. 4-6 hex numbers, If there are 6, the first # two must be 10; if there are 5, the first must not be a 0. Written this # way to decrease backtracking. The first regex allows the code point to # be at the end of a word, but to work properly, the word shouldn't end # with a valid hex character. The second one won't match a code point at # the end of a word, and doesn't have the run-on issue my $run_on_code_point_re = qr/(?^aax: (?: 10[0-9A-F]{4} | [1-9A-F][0-9A-F]{4} | [0-9A-F]{4} ) \b)/; my $code_point_re = qr/(?^aa:\b(?^aax: (?: 10[0-9A-F]{4} | [1-9A-F][0-9A-F]{4} | [0-9A-F]{4} ) \b))/; # In the following hash, the keys are the bases of names which include # the code point in the name, like CJK UNIFIED IDEOGRAPH-4E01. The value # of each key is another hash which is used to get the low and high ends # for each range of code points that apply to the name. my %names_ending_in_code_point = ( 'CJK COMPATIBILITY IDEOGRAPH' => { 'high' => [ 64109, 64217, 195101, ], 'low' => [ 63744, 64112, 194560, ], }, 'CJK UNIFIED IDEOGRAPH' => { 'high' => [ 19893, 40908, 173782, 177972, 178205, ], 'low' => [ 13312, 19968, 131072, 173824, 177984, ], }, ); # The following hash is a copy of the previous one, except is for loose # matching, so each name has blanks and dashes squeezed out my %loose_names_ending_in_code_point = ( 'CJKCOMPATIBILITYIDEOGRAPH' => { 'high' => [ 64109, 64217, 195101, ], 'low' => [ 63744, 64112, 194560, ], }, 'CJKUNIFIEDIDEOGRAPH' => { 'high' => [ 19893, 40908, 173782, 177972, 178205, ], 'low' => [ 13312, 19968, 131072, 173824, 177984, ], }, ); # And the following array gives the inverse mapping from code points to # names. Lowest code points are first my @code_points_ending_in_code_point = ( { 'high' => 19893, 'low' => 13312, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 40908, 'low' => 19968, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 64109, 'low' => 63744, 'name' => 'CJK COMPATIBILITY IDEOGRAPH', }, { 'high' => 64217, 'low' => 64112, 'name' => 'CJK COMPATIBILITY IDEOGRAPH', }, { 'high' => 173782, 'low' => 131072, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 177972, 'low' => 173824, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 178205, 'low' => 177984, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 195101, 'low' => 194560, 'name' => 'CJK COMPATIBILITY IDEOGRAPH', }, , ); # Convert from code point to Jamo short name for use in composing Hangul # syllable names my %Jamo = ( 4352 => 'G', 4353 => 'GG', 4354 => 'N', 4355 => 'D', 4356 => 'DD', 4357 => 'R', 4358 => 'M', 4359 => 'B', 4360 => 'BB', 4361 => 'S', 4362 => 'SS', 4363 => '', 4364 => 'J', 4365 => 'JJ', 4366 => 'C', 4367 => 'K', 4368 => 'T', 4369 => 'P', 4370 => 'H', 4449 => 'A', 4450 => 'AE', 4451 => 'YA', 4452 => 'YAE', 4453 => 'EO', 4454 => 'E', 4455 => 'YEO', 4456 => 'YE', 4457 => 'O', 4458 => 'WA', 4459 => 'WAE', 4460 => 'OE', 4461 => 'YO', 4462 => 'U', 4463 => 'WEO', 4464 => 'WE', 4465 => 'WI', 4466 => 'YU', 4467 => 'EU', 4468 => 'YI', 4469 => 'I', 4520 => 'G', 4521 => 'GG', 4522 => 'GS', 4523 => 'N', 4524 => 'NJ', 4525 => 'NH', 4526 => 'D', 4527 => 'L', 4528 => 'LG', 4529 => 'LM', 4530 => 'LB', 4531 => 'LS', 4532 => 'LT', 4533 => 'LP', 4534 => 'LH', 4535 => 'M', 4536 => 'B', 4537 => 'BS', 4538 => 'S', 4539 => 'SS', 4540 => 'NG', 4541 => 'J', 4542 => 'C', 4543 => 'K', 4544 => 'T', 4545 => 'P', 4546 => 'H', ); # Leading consonant (can be null) my %Jamo_L = ( '' => 11, 'B' => 7, 'BB' => 8, 'C' => 14, 'D' => 3, 'DD' => 4, 'G' => 0, 'GG' => 1, 'H' => 18, 'J' => 12, 'JJ' => 13, 'K' => 15, 'M' => 6, 'N' => 2, 'P' => 17, 'R' => 5, 'S' => 9, 'SS' => 10, 'T' => 16, ); # Vowel my %Jamo_V = ( 'A' => 0, 'AE' => 1, 'E' => 5, 'EO' => 4, 'EU' => 18, 'I' => 20, 'O' => 8, 'OE' => 11, 'U' => 13, 'WA' => 9, 'WAE' => 10, 'WE' => 15, 'WEO' => 14, 'WI' => 16, 'YA' => 2, 'YAE' => 3, 'YE' => 7, 'YEO' => 6, 'YI' => 19, 'YO' => 12, 'YU' => 17, ); # Optional trailing consonant my %Jamo_T = ( 'B' => 17, 'BS' => 18, 'C' => 23, 'D' => 7, 'G' => 1, 'GG' => 2, 'GS' => 3, 'H' => 27, 'J' => 22, 'K' => 24, 'L' => 8, 'LB' => 11, 'LG' => 9, 'LH' => 15, 'LM' => 10, 'LP' => 14, 'LS' => 12, 'LT' => 13, 'M' => 16, 'N' => 4, 'NG' => 21, 'NH' => 6, 'NJ' => 5, 'P' => 26, 'S' => 19, 'SS' => 20, 'T' => 25, ); # Computed re that splits up a Hangul name into LVT or LV syllables my $syllable_re = qr/(|B|BB|C|D|DD|G|GG|H|J|JJ|K|M|N|P|R|S|SS|T)(A|AE|E|EO|EU|I|O|OE|U|WA|WAE|WE|WEO|WI|YA|YAE|YE|YEO|YI|YO|YU)(B|BS|C|D|G|GG|GS|H|J|K|L|LB|LG|LH|LM|LP|LS|LT|M|N|NG|NH|NJ|P|S|SS|T)?/; my $HANGUL_SYLLABLE = "HANGUL SYLLABLE "; my $loose_HANGUL_SYLLABLE = "HANGULSYLLABLE"; # These constants names and values were taken from the Unicode standard, # version 5.1, section 3.12. They are used in conjunction with Hangul # syllables my $SBase = 0xAC00; my $LBase = 0x1100; my $VBase = 0x1161; my $TBase = 0x11A7; my $SCount = 11172; my $LCount = 19; my $VCount = 21; my $TCount = 28; my $NCount = $VCount * $TCount; sub name_to_code_point_special { my ($name, $loose) = @_; # Returns undef if not one of the specially handled names; otherwise # returns the code point equivalent to the input name # $loose is non-zero if to use loose matching, 'name' in that case # must be input as upper case with all blanks and dashes squeezed out. if ((! $loose && $name =~ s/$HANGUL_SYLLABLE//) || ($loose && $name =~ s/$loose_HANGUL_SYLLABLE//)) { return if $name !~ qr/^$syllable_re$/; my $L = $Jamo_L{$1}; my $V = $Jamo_V{$2}; my $T = (defined $3) ? $Jamo_T{$3} : 0; return ($L * $VCount + $V) * $TCount + $T + $SBase; } # Name must end in 'code_point' for this to handle. return if (($loose && $name !~ /^ (.*?) ($run_on_code_point_re) $/x) || (! $loose && $name !~ /^ (.*) ($code_point_re) $/x)); my $base = $1; my $code_point = CORE::hex $2; my $names_ref; if ($loose) { $names_ref = \%loose_names_ending_in_code_point; } else { return if $base !~ s/-$//; $names_ref = \%names_ending_in_code_point; } # Name must be one of the ones which has the code point in it. return if ! $names_ref->{$base}; # Look through the list of ranges that apply to this name to see if # the code point is in one of them. for (my $i = 0; $i < scalar @{$names_ref->{$base}{'low'}}; $i++) { return if $names_ref->{$base}{'low'}->[$i] > $code_point; next if $names_ref->{$base}{'high'}->[$i] < $code_point; # Here, the code point is in the range. return $code_point; } # Here, looked like the name had a code point number in it, but # did not match one of the valid ones. return; } sub code_point_to_name_special { my $code_point = shift; # Returns the name of a code point if algorithmically determinable; # undef if not # If in the Hangul range, calculate the name based on Unicode's # algorithm if ($code_point >= $SBase && $code_point <= $SBase + $SCount -1) { use integer; my $SIndex = $code_point - $SBase; my $L = $LBase + $SIndex / $NCount; my $V = $VBase + ($SIndex % $NCount) / $TCount; my $T = $TBase + $SIndex % $TCount; $name = "$HANGUL_SYLLABLE$Jamo{$L}$Jamo{$V}"; $name .= $Jamo{$T} if $T != $TBase; return $name; } # Look through list of these code points for one in range. foreach my $hash (@code_points_ending_in_code_point) { return if $code_point < $hash->{'low'}; if ($code_point <= $hash->{'high'}) { return sprintf("%s-%04X", $hash->{'name'}, $code_point); } } return; # None found } } # End closure 1; RTx-Calendar-1.00/inc/Module/0000755000175000017500000000000012443706064014672 5ustar chmrrchmrrRTx-Calendar-1.00/inc/Module/Install.pm0000644000175000017500000003013312443706031016630 0ustar chmrrchmrr#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.006; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.12'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::getcwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::getcwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split /\n/, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. RTx-Calendar-1.00/inc/Module/Install/0000755000175000017500000000000012443706064016300 5ustar chmrrchmrrRTx-Calendar-1.00/inc/Module/Install/Can.pm0000644000175000017500000000615712443706032017343 0ustar chmrrchmrr#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 RTx-Calendar-1.00/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612443706032020364 0ustar chmrrchmrr#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; RTx-Calendar-1.00/inc/Module/Install/RTx/0000755000175000017500000000000012443706064017015 5ustar chmrrchmrrRTx-Calendar-1.00/inc/Module/Install/RTx/Runtime.pm0000644000175000017500000000425212443706031020773 0ustar chmrrchmrr#line 1 package Module::Install::RTx::Runtime; use base 'Exporter'; our @EXPORT = qw/RTxDatabase RTxPlugin/; use strict; use File::Basename (); sub _rt_runtime_load { require RT; eval { RT::LoadConfig(); }; if (my $err = $@) { die $err unless $err =~ /^RT couldn't load RT config file/m; my $warn = <can('AddUpgradeHistory'); my $lib_path = File::Basename::dirname($INC{'RT.pm'}); my @args = ( "-Ilib", "-I$RT::LocalLibPath", "-I$lib_path", "$RT::SbinPath/rt-setup-database", "--action" => $action, ($action eq 'upgrade' ? () : ("--datadir" => "etc")), (($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()), "--dba" => $RT::DatabaseAdmin || $RT::DatabaseUser, "--prompt-for-dba-password" => '', ($has_upgrade ? ("--package" => $name, "--ext-version" => $version) : ()), ); # If we're upgrading against an RT which isn't at least 4.2 (has # AddUpgradeHistory) then pass --package. Upgrades against later RT # releases will pick up --package from AddUpgradeHistory. if ($action eq 'upgrade' and not $has_upgrade) { push @args, "--package" => $name; } print "$^X @args\n"; (system($^X, @args) == 0) or die "...returned with error: $?\n"; } sub RTxPlugin { my ($name) = @_; _rt_runtime_load(); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); my $name = $data->{name}; my @enabled = RT->Config->Get('Plugins'); for my $required (@{$data->{x_requires_rt_plugins} || []}) { next if grep {$required eq $_} @enabled; warn <<"EOT"; **** Warning: $name requires that the $required plugin be installed and enabled; it is not currently in \@Plugins. EOT } } 1; RTx-Calendar-1.00/inc/Module/Install/Base.pm0000644000175000017500000000214712443706031017506 0ustar chmrrchmrr#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.12'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 RTx-Calendar-1.00/inc/Module/Install/Metadata.pm0000644000175000017500000004330212443706031020352 0ustar chmrrchmrr#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) [\s|;]* /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashes delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; RTx-Calendar-1.00/inc/Module/Install/Win32.pm0000644000175000017500000000340312443706032017533 0ustar chmrrchmrr#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; RTx-Calendar-1.00/inc/Module/Install/ReadmeFromPod.pm0000644000175000017500000000631112443706031021315 0ustar chmrrchmrr#line 1 package Module::Install::ReadmeFromPod; use 5.006; use strict; use warnings; use base qw(Module::Install::Base); use vars qw($VERSION); $VERSION = '0.22'; sub readme_from { my $self = shift; return unless $self->is_admin; # Input file my $in_file = shift || $self->_all_from or die "Can't determine file to make readme_from"; # Get optional arguments my ($clean, $format, $out_file, $options); my $args = shift; if ( ref $args ) { # Arguments are in a hashref if ( ref($args) ne 'HASH' ) { die "Expected a hashref but got a ".ref($args)."\n"; } else { $clean = $args->{'clean'}; $format = $args->{'format'}; $out_file = $args->{'output_file'}; $options = $args->{'options'}; } } else { # Arguments are in a list $clean = $args; $format = shift; $out_file = shift; $options = \@_; } # Default values; $clean ||= 0; $format ||= 'txt'; # Generate README print "readme_from $in_file to $format\n"; if ($format =~ m/te?xt/) { $out_file = $self->_readme_txt($in_file, $out_file, $options); } elsif ($format =~ m/html?/) { $out_file = $self->_readme_htm($in_file, $out_file, $options); } elsif ($format eq 'man') { $out_file = $self->_readme_man($in_file, $out_file, $options); } elsif ($format eq 'pdf') { $out_file = $self->_readme_pdf($in_file, $out_file, $options); } if ($clean) { $self->clean_files($out_file); } return 1; } sub _readme_txt { my ($self, $in_file, $out_file, $options) = @_; $out_file ||= 'README'; require Pod::Text; my $parser = Pod::Text->new( @$options ); open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n"; $parser->output_fh( *$out_fh ); $parser->parse_file( $in_file ); close $out_fh; return $out_file; } sub _readme_htm { my ($self, $in_file, $out_file, $options) = @_; $out_file ||= 'README.htm'; require Pod::Html; Pod::Html::pod2html( "--infile=$in_file", "--outfile=$out_file", @$options, ); # Remove temporary files if needed for my $file ('pod2htmd.tmp', 'pod2htmi.tmp') { if (-e $file) { unlink $file or warn "Warning: Could not remove file '$file'.\n$!\n"; } } return $out_file; } sub _readme_man { my ($self, $in_file, $out_file, $options) = @_; $out_file ||= 'README.1'; require Pod::Man; my $parser = Pod::Man->new( @$options ); $parser->parse_from_file($in_file, $out_file); return $out_file; } sub _readme_pdf { my ($self, $in_file, $out_file, $options) = @_; $out_file ||= 'README.pdf'; eval { require App::pod2pdf; } or die "Could not generate $out_file because pod2pdf could not be found\n"; my $parser = App::pod2pdf->new( @$options ); $parser->parse_from_file($in_file); open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n"; select $out_fh; $parser->output; select STDOUT; close $out_fh; return $out_file; } sub _all_from { my $self = shift; return unless $self->admin->{extensions}; my ($metadata) = grep { ref($_) eq 'Module::Install::Metadata'; } @{$self->admin->{extensions}}; return unless $metadata; return $metadata->{values}{all_from} || ''; } 'Readme!'; __END__ #line 254 RTx-Calendar-1.00/inc/Module/Install/Makefile.pm0000644000175000017500000002743712443706031020362 0ustar chmrrchmrr#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 RTx-Calendar-1.00/inc/Module/Install/RTx.pm0000644000175000017500000002061612443706031017352 0ustar chmrrchmrr#line 1 package Module::Install::RTx; use 5.008; use strict; use warnings; no warnings 'once'; use Module::Install::Base; use base 'Module::Install::Base'; our $VERSION = '0.36'; use FindBin; use File::Glob (); use File::Basename (); my @DIRS = qw(etc lib html static bin sbin po var); my @INDEX_DIRS = qw(lib bin sbin); sub RTx { my ( $self, $name, $extra_args ) = @_; $extra_args ||= {}; # Set up names my $fname = $name; $fname =~ s!-!/!g; $self->name( $name ) unless $self->name; $self->all_from( "lib/$fname.pm" ) unless $self->version; $self->abstract("$name Extension") unless $self->abstract; unless ( $extra_args->{no_readme_generation} ) { $self->readme_from( "lib/$fname.pm", { options => [ quotes => "none" ] } ); } $self->add_metadata("x_module_install_rtx_version", $VERSION ); # Try to find RT.pm my @prefixes = qw( /opt /usr/local /home /usr /sw /usr/share/request-tracker4); $ENV{RTHOME} =~ s{/RT\.pm$}{} if defined $ENV{RTHOME}; $ENV{RTHOME} =~ s{/lib/?$}{} if defined $ENV{RTHOME}; my @try = $ENV{RTHOME} ? ($ENV{RTHOME}, "$ENV{RTHOME}/lib") : (); while (1) { my @look = @INC; unshift @look, grep {defined and -d $_} @try; push @look, grep {defined and -d $_} map { ( "$_/rt4/lib", "$_/lib/rt4", "$_/lib" ) } @prefixes; last if eval {local @INC = @look; require RT; $RT::LocalLibPath}; warn "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @look\n"; my $given = $self->prompt("Path to directory containing your RT.pm:") or exit; $given =~ s{/RT\.pm$}{}; $given =~ s{/lib/?$}{}; @try = ($given, "$given/lib"); } print "Using RT configuration from $INC{'RT.pm'}:\n"; my $local_lib_path = $RT::LocalLibPath; unshift @INC, $local_lib_path; my $lib_path = File::Basename::dirname( $INC{'RT.pm'} ); unshift @INC, $lib_path; # Set a baseline minimum version unless ( $extra_args->{deprecated_rt} ) { $self->requires_rt('4.0.0'); } # Installation locations my %path; $path{$_} = $RT::LocalPluginPath . "/$name/$_" foreach @DIRS; # Copy RT 4.2.0 static files into NoAuth; insufficient for # images, but good enough for css and js. $path{static} = "$path{html}/NoAuth/" unless $RT::StaticPath; # Delete the ones we don't need delete $path{$_} for grep {not -d "$FindBin::Bin/$_"} keys %path; my %index = map { $_ => 1 } @INDEX_DIRS; $self->no_index( directory => $_ ) foreach grep !$index{$_}, @DIRS; my $args = join ', ', map "q($_)", map { ($_, $path{$_}) } sort keys %path; printf "%-10s => %s\n", $_, $path{$_} for sort keys %path; if ( my @dirs = map { ( -D => $_ ) } grep $path{$_}, qw(bin html sbin etc) ) { my @po = map { ( -o => $_ ) } grep -f, File::Glob::bsd_glob("po/*.po"); $self->postamble(<< ".") if @po; lexicons :: \t\$(NOECHO) \$(PERL) -MLocale::Maketext::Extract::Run=xgettext -e \"xgettext(qw(@dirs @po))\" . } $self->include('Module::Install::RTx::Runtime') if $self->admin; $self->include_deps( 'YAML::Tiny', 0 ) if $self->admin; my $postamble = << "."; install :: \t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxPlugin()" \t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\" . if ( $path{var} and -d $RT::MasonDataDir ) { my ( $uid, $gid ) = ( stat($RT::MasonDataDir) )[ 4, 5 ]; $postamble .= << "."; \t\$(NOECHO) chown -R $uid:$gid $path{var} . } my %has_etc; if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) { $has_etc{schema}++; } if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) { $has_etc{acl}++; } if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; } if ( grep { /\d+\.\d+(\.\d+)?.*$/ } glob('etc/upgrade/*.*') ) { $has_etc{upgrade}++; } $self->postamble("$postamble\n"); if ( $path{lib} ) { $self->makemaker_args( INSTALLSITELIB => $path{'lib'} ); $self->makemaker_args( INSTALLARCHLIB => $path{'lib'} ); } else { $self->makemaker_args( PM => { "" => "" }, ); } $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" ); $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" ); $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" ); if (%has_etc) { print "For first-time installation, type 'make initdb'.\n"; my $initdb = ''; $initdb .= <<"." if $has_etc{schema}; \t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(schema \$(NAME) \$(VERSION)))" . $initdb .= <<"." if $has_etc{acl}; \t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(acl \$(NAME) \$(VERSION)))" . $initdb .= <<"." if $has_etc{initialdata}; \t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(insert \$(NAME) \$(VERSION)))" . $self->postamble("initdb ::\n$initdb\n"); $self->postamble("initialize-database ::\n$initdb\n"); if ($has_etc{upgrade}) { print "To upgrade from a previous version of this extension, use 'make upgrade-database'\n"; my $upgradedb = qq|\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(upgrade \$(NAME) \$(VERSION)))"\n|; $self->postamble("upgrade-database ::\n$upgradedb\n"); $self->postamble("upgradedb ::\n$upgradedb\n"); } } } sub requires_rt { my ($self,$version) = @_; _load_rt_handle(); if ($self->is_admin) { $self->add_metadata("x_requires_rt", $version); my @sorted = sort RT::Handle::cmp_version $version,'4.0.0'; $self->perl_version('5.008003') if $sorted[0] eq '4.0.0' and (not $self->perl_version or '5.008003' > $self->perl_version); @sorted = sort RT::Handle::cmp_version $version,'4.2.0'; $self->perl_version('5.010001') if $sorted[0] eq '4.2.0' and (not $self->perl_version or '5.010001' > $self->perl_version); } # if we're exactly the same version as what we want, silently return return if ($version eq $RT::VERSION); my @sorted = sort RT::Handle::cmp_version $version,$RT::VERSION; if ($sorted[-1] eq $version) { die <<"EOT"; **** Error: This extension requires RT $version. Your installed version of RT ($RT::VERSION) is too old. EOT } } sub requires_rt_plugin { my $self = shift; my ( $plugin ) = @_; if ($self->is_admin) { my $plugins = $self->Meta->{values}{"x_requires_rt_plugins"} || []; push @{$plugins}, $plugin; $self->add_metadata("x_requires_rt_plugins", $plugins); } my $path = $plugin; $path =~ s{\:\:}{-}g; $path = "$RT::LocalPluginPath/$path/lib"; if ( -e $path ) { unshift @INC, $path; } else { my $name = $self->name; warn <<"EOT"; **** Warning: $name requires that the $plugin plugin be installed and enabled; it does not appear to be installed. EOT } $self->requires(@_); } sub rt_too_new { my ($self,$version,$msg) = @_; my $name = $self->name; $msg ||= <add_metadata("x_rt_too_new", $version) if $self->is_admin; _load_rt_handle(); my @sorted = sort RT::Handle::cmp_version $version,$RT::VERSION; if ($sorted[0] eq $version) { die sprintf($msg,$RT::VERSION,$version); } } # RT::Handle runs FinalizeDatabaseType which calls RT->Config->Get # On 3.8, this dies. On 4.0/4.2 ->Config transparently runs LoadConfig. # LoadConfig requires being able to read RT_SiteConfig.pm (root) so we'd # like to avoid pushing that on users. # Fake up just enough Config to let FinalizeDatabaseType finish, and # anyone later calling LoadConfig will overwrite our shenanigans. sub _load_rt_handle { unless ($RT::Config) { require RT::Config; $RT::Config = RT::Config->new; RT->Config->Set('DatabaseType','mysql'); } require RT::Handle; } 1; __END__ #line 390 RTx-Calendar-1.00/inc/Module/Install/Include.pm0000644000175000017500000000101512443706031020210 0ustar chmrrchmrr#line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; RTx-Calendar-1.00/inc/Module/Install/Fetch.pm0000644000175000017500000000462712443706032017673 0ustar chmrrchmrr#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.12'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; RTx-Calendar-1.00/MANIFEST0000644000175000017500000000167312443706064014034 0ustar chmrrchmrrCHANGES html/Callbacks/RTx-Calendar/Elements/Tabs/Privileged html/Elements/CalendarEvent html/Elements/MyCalendar html/Search/Calendar.html inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/ReadmeFromPod.pm inc/Module/Install/RTx.pm inc/Module/Install/RTx/Runtime.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm inc/unicore/Name.pm inc/YAML/Tiny.pm lib/RTx/Calendar.pm Makefile.PL MANIFEST This list of files META.yml README static/css/calendar.css static/images/created.png static/images/created_due.png static/images/due.png static/images/reminder.png static/images/resolved.png static/images/started.png static/images/starts.png static/images/starts_due.png static/images/updated.png TODO SIGNATURE Public-key signature (added by MakeMaker) RTx-Calendar-1.00/SIGNATURE0000664000175000017500000000615012443706064014164 0ustar chmrrchmrrThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.73. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 93b5edfdbc96aaee55700e78655e4bdb28f4a08d CHANGES SHA1 069fb1d0efaa32ea73dde062044517d70f6b329f MANIFEST SHA1 a1193dbfbe36ed50f262c026646ab88e91b6b62e META.yml SHA1 ec583a4b786f31a5339836bd5cd89b948d5bfd8c Makefile.PL SHA1 e591584e85f8ca5539df93b048c6a3b74ec9dd68 README SHA1 4259a8cc84588a6c02d448172e281f74c29cfca9 TODO SHA1 c4c2273ca8a65f5f23689f5425d2cf00fcb7d718 html/Callbacks/RTx-Calendar/Elements/Tabs/Privileged SHA1 550731466ec0dfafb7da6aa92381acda57f353ae html/Elements/CalendarEvent SHA1 cba245b1e12d22745770f9c020f4cb0923915f2a html/Elements/MyCalendar SHA1 3f2989981d24accd86c199540ef27fc0df0eefcd html/Search/Calendar.html SHA1 9b5001bfa9cf8607b3b3935284d9253e0391c9f1 inc/Module/Install.pm SHA1 cab0e564f9bdf658535f683aa197157e06d0dcea inc/Module/Install/Base.pm SHA1 a1559b5b3b40f68efbbd256f4fef85970891b3ae inc/Module/Install/Can.pm SHA1 f15c1ba85f6d52e70c48c64bf0752c90a4ad66f9 inc/Module/Install/Fetch.pm SHA1 d44d96acd20793306dd201030c688e2a7d3083ee inc/Module/Install/Include.pm SHA1 eb48df8bafd07c6a862126d9b274df42b4395742 inc/Module/Install/Makefile.pm SHA1 95c73873c6c3cb7024614c225c53863e1e90c134 inc/Module/Install/Metadata.pm SHA1 6e010ba20a9d0ae23d8d0ff516868c1e571c2d44 inc/Module/Install/RTx.pm SHA1 3fdf4c0cffdb1a2e23e5cd26bf95be553f1f9590 inc/Module/Install/RTx/Runtime.pm SHA1 79f5b4199f622e8b05aac266b0c39f6a85bb303f inc/Module/Install/ReadmeFromPod.pm SHA1 f8b2ae3386f6ba26c33408968a953d450842eade inc/Module/Install/Win32.pm SHA1 f302bc703d76299cff243e5b44cecd61aac27b76 inc/Module/Install/WriteAll.pm SHA1 4e09b598c2626e08cec2bed5e981492fa9e90967 inc/YAML/Tiny.pm SHA1 034d0f3a7401dae4be3eee279258181f51a4ad81 inc/unicore/Name.pm SHA1 6e4ad3f34fd64e02ad62d51719b6860204c63476 lib/RTx/Calendar.pm SHA1 b2d9bba7a2668c1406eae6ab2c10d6aecf4f6e30 static/css/calendar.css SHA1 bd37038a23410e1b33f52bc47c26760ead317962 static/images/created.png SHA1 0e33b8c5c7b5f141301edbec9983fd0d727d650d static/images/created_due.png SHA1 7b320f37a1253b7e0fd90abf84f5740150f3c8e9 static/images/due.png SHA1 e34a63899ecdf6c49fc3fdb59a9769dc7ef04427 static/images/reminder.png SHA1 c11078b7f675e1af5dd9237840bcf5e3fa05df9d static/images/resolved.png SHA1 de6e66e9dfe0f780b8a28790264835727217cca5 static/images/started.png SHA1 0ad059771e0d96eaaa96e90883f4a375d67bcabd static/images/starts.png SHA1 b23cfcce3427f706f0dc6f5ff5909ee8a1c41658 static/images/starts_due.png SHA1 d123dfa126e3a8535175c273419aaa38398c9b7b static/images/updated.png -----BEGIN PGP SIGNATURE----- Version: GnuPG v1 iEYEARECAAYFAlSPjDQACgkQMflWJZZAbqAilACdG6njy+zYe/+L2VvYtOdiFUCV 0cQAnRPtIeUbgIAZJN2Sf5zVSXZYsjY8 =i6tC -----END PGP SIGNATURE----- RTx-Calendar-1.00/lib/0000755000175000017500000000000012443706064013442 5ustar chmrrchmrrRTx-Calendar-1.00/lib/RTx/0000755000175000017500000000000012443706064014157 5ustar chmrrchmrrRTx-Calendar-1.00/lib/RTx/Calendar.pm0000644000175000017500000001130012443705714016222 0ustar chmrrchmrrpackage RTx::Calendar; use strict; use DateTime; use DateTime::Set; our $VERSION = "1.00"; RT->AddStyleSheets('calendar.css'); sub FirstDay { my ($year, $month, $matchday) = @_; my $set = DateTime::Set->from_recurrence( next => sub { $_[0]->truncate( to => 'day' )->subtract( days => 1 ) } ); my $day = DateTime->new( year => $year, month => $month ); $day = $set->next($day) while $day->day_of_week != $matchday; $day; } sub LastDay { my ($year, $month, $matchday) = @_; my $set = DateTime::Set->from_recurrence( next => sub { $_[0]->truncate( to => 'day' )->add( days => 1 ) } ); my $day = DateTime->last_day_of_month( year => $year, month => $month ); $day = $set->next($day) while $day->day_of_week != $matchday; $day; } # we can't use RT::Date::Date because it uses gmtime # and we need localtime sub LocalDate { my $ts = shift; my ($d,$m,$y) = (localtime($ts))[3..5]; sprintf "%4d-%02d-%02d", ($y + 1900), ++$m, $d; } sub DatesClauses { my ($Dates, $begin, $end) = @_; my $clauses = ""; my @DateClauses = map { "($_ >= '" . $begin . " 00:00:00' AND $_ <= '" . $end . " 23:59:59')" } @$Dates; $clauses .= " AND " . " ( " . join(" OR ", @DateClauses) . " ) " if @DateClauses; return $clauses } sub FindTickets { my ($CurrentUser, $Query, $Dates, $begin, $end) = @_; $Query .= DatesClauses($Dates, $begin, $end) if $begin and $end; my $Tickets = RT::Tickets->new($CurrentUser); $Tickets->FromSQL($Query); my %Tickets; my %AlreadySeen; while ( my $Ticket = $Tickets->Next()) { # How to find the LastContacted date ? for my $Date (@$Dates) { my $DateObj = $Date . "Obj"; push @{ $Tickets{ LocalDate($Ticket->$DateObj->Unix) } }, $Ticket # if reminder, check it's refering to a ticket unless ($Ticket->Type eq 'reminder' and not $Ticket->RefersTo->First) or $AlreadySeen{ LocalDate($Ticket->$DateObj->Unix) }{ $Ticket }++; } } return %Tickets; } # # Take a user object and return the search with Description "calendar" if it exists # sub SearchDefaultCalendar { my $CurrentUser = shift; my $Description = "calendar"; # I'm quite sure the loop isn't usefull but... my @Objects = $CurrentUser->UserObj; for my $object (@Objects) { next unless ref($object) eq 'RT::User' && $object->id == $CurrentUser->Id; my @searches = $object->Attributes->Named('SavedSearch'); for my $search (@searches) { next if ($search->SubValue('SearchType') && $search->SubValue('SearchType') ne 'Ticket'); return $search if "calendar" eq $search->Description; } } } 1; __END__ =head1 NAME RTx::Calendar - Calendar for RT due dates =head1 DESCRIPTION This RT extension provides a calendar view for your tickets and your reminders so you see when is your next due ticket. You can find it in the menu Search->Calendar. There's a portlet to put on your home page (see Prefs/MyRT.html) =head1 INSTALLATION =over =item C =item C =item C May need root permissions =item Edit your F If you are using RT 4.2 or greater, add this line: Plugin('RTx::Calendar'); For RT 4.0, add this line: Set(@Plugins, qw(RTx::Calendar)); or add C to your existing C<@Plugins> line. =item Clear your mason cache rm -rf /opt/rt4/var/mason_data/obj =item Restart your webserver =back =head1 CONFIGURATION =head2 Base configuration To use the C portlet, you must add C to C<$HomepageComponents> in F: Set($HomepageComponents, [qw(QuickCreate Quicksearch MyCalendar MyAdminQueues MySupportQueues MyReminders RefreshHomepage)]); =head2 Display configuration You can show the owner in each day box by adding this line to your F: Set($CalendarDisplayOwner, 1); You can change which fields show up in the popup display when you mouse over a date in F: Set(@CalendarPopupFields, ('Status', 'OwnerObj->Name', 'DueObj->ISO')); =head1 USAGE A small help section is available in /Prefs/Calendar.html =head1 AUTHOR Best Practical Solutions, LLC Emodules@bestpractical.comE Originally written by Nicolas Chuche Enchuche@barna.beE =head1 BUGS All bugs should be reported via email to L or via the web at L. =head1 LICENSE AND COPYRIGHT This software is Copyright (c) 2010-2014 by Best Practical Solutions Copyright 2007-2009 by Nicolas Chuche This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut RTx-Calendar-1.00/html/0000755000175000017500000000000012443706064013640 5ustar chmrrchmrrRTx-Calendar-1.00/html/Elements/0000755000175000017500000000000012443706064015414 5ustar chmrrchmrrRTx-Calendar-1.00/html/Elements/MyCalendar0000644000175000017500000000445712345405555017372 0ustar chmrrchmrr<&|/Widgets/TitleBox, title => loc("Calendar"), title_href => "Search/Calendar.html" &> % my $date = $begin->clone; % while ( $date <= $end ) { % $date = $set->next($date); % } % $date = $begin->clone; % while ($date <= $end) { % my @classes = (); % push @classes, "today" if (DateTime->compare($today, $date) == 0); % push @classes, "yesterday" if (DateTime->compare($yesterday, $date) == 0); % $date = $set->next($date); % }
<%$rtdate->GetWeekday($date->day_of_week % 7)%>
<%$date->day%>
% for my $t ( @{ $Tickets{$date->strftime("%F")} } ) { <& /Elements/CalendarEvent, Object => $t, Date => $date, DateTypes => \%DateTypes &> % }
<%INIT> use RTx::Calendar; my $title = loc("Calendar"); my $rtdate = RT::Date->new($session{'CurrentUser'}); my @DateTypes = qw/Created Starts Started Due LastUpdated Resolved/; my $today = DateTime->today; my $yesterday = $today->clone->subtract( days=>1 ); # this line is used to debug MyCalendar # $today = DateTime->new(year => 2007, month => 4, day => 11); my $begin = $today->clone->subtract( days => 3); my $end = $today->clone->add( days => 3); # use this to loop over days until $end my $set = DateTime::Set->from_recurrence( next => sub { $_[0]->truncate( to => 'day' )->add( days => 1 ) } ); my $Query = "( Status = 'new' OR Status = 'open' OR Status = 'stalled') AND ( Owner = '" . $session{CurrentUser}->Id ."' OR Owner = 'Nobody' ) AND ( Type = 'reminder' OR 'Type' = 'ticket' )"; my $Format = "__Starts__ __Due__"; if ( my $Search = RTx::Calendar::SearchDefaultCalendar($session{CurrentUser}) ) { $Format = $Search->SubValue('Format'); $Query = $Search->SubValue('Query'); } # we search all date types in Format string my @Dates = grep { $Format =~ m/__${_}(Relative)?__/ } @DateTypes; # used to display or not a date in Element/CalendarEvent my %DateTypes = map { $_ => 1 } @Dates; $Query .= RTx::Calendar::DatesClauses(\@Dates, $begin->strftime("%F"), $end->strftime("%F")); # print STDERR $Query, "\n"; my %Tickets = RTx::Calendar::FindTickets($session{'CurrentUser'}, $Query, \@Dates); RTx-Calendar-1.00/html/Elements/CalendarEvent0000644000175000017500000001014711233667605020060 0ustar chmrrchmrr<%args> $Date => undef $Object => undef $DateTypes => undef
% if ($IsReminder and RTx::Calendar::LocalDate($Object->DueObj->Unix) eq $today) { % } elsif ($DateTypes->{Resolved} % and RTx::Calendar::LocalDate($Object->ResolvedObj->Unix) eq $today) { % } elsif ($DateTypes->{Starts} and $DateTypes->{Due} % and RTx::Calendar::LocalDate($Object->StartsObj->Unix) eq $today and RTx::Calendar::LocalDate($Object->DueObj->Unix) eq $today ) { % } elsif ($DateTypes->{Due} and $DateTypes->{Created} % and RTx::Calendar::LocalDate($Object->DueObj->Unix) eq $today and RTx::Calendar::LocalDate($Object->CreatedObj->Unix) eq $today ) { % } elsif ($DateTypes->{Starts} % and RTx::Calendar::LocalDate($Object->StartsObj->Unix) eq $today) { % } elsif ($DateTypes->{Due} % and RTx::Calendar::LocalDate($Object->DueObj->Unix) eq $today) { % } elsif ($DateTypes->{Created} % and RTx::Calendar::LocalDate($Object->CreatedObj->Unix) eq $today) { % } elsif ($DateTypes->{Started} % and RTx::Calendar::LocalDate($Object->StartedObj->Unix) eq $today) { % } elsif ($DateTypes->{LastUpdated} % and RTx::Calendar::LocalDate($Object->LastUpdatedObj->Unix) eq $today) { % } <% $Object->QueueObj->Name %> #<% $TicketId %> <% $display_owner ? 'by ' . $Object->OwnerObj->Name : '' %> <% length($Object->Subject) > 80 ? substr($Object->Subject, 0, 77) . "..." : $Object->Subject %>
<% $Object->QueueObj->Name %> #<% $TicketId %> : <% $subject%>

%# logic taken from Ticket/Search/Results.tsv % foreach my $attr (@display_fields) { % my $value; % % if ($attr =~ /(.*)->ISO$/ and $Object->$1->Unix <= 0) { % $value = '-'; % } else { % my $method = '$Object->'.$attr.'()'; % $method =~ s/->ISO\(\)$/->ISO( Timezone => 'user' )/; % $value = eval $method; % if ($@) {die "Check your CalendarPopupFields config in etc/RT_SiteConfig.pm.

Failed to find \"$attr\" - ". $@}; % } <&|/l&><% $label_of{$attr} %>: <% $value %>
% }
<%init> use RTx::Calendar; my $today = $Date->strftime("%F"); my $TicketId; my $ticket; my $subject; my $IsReminder; if ($Object->Type eq 'reminder') { $IsReminder = 1; if ($Object->RefersTo->First) { $ticket = $Object->RefersTo->First->TargetObj; $TicketId = $ticket->Id; $subject = $Object->Subject . " (" . $ticket->Subject . ")"; } } else { $TicketId = $Object->Id; $subject = $Object->Subject; } my $display_owner = $RT::CalendarDisplayOwner; $display_owner ||= RT->Config->Get('CalendarDisplayOwner') if RT->can('Config'); # 3.6 config my @display_fields = @RT::CalendarPopupFields; # 3.8 config # the if condition is weird but it doesn't work with 3.8.0 without the last part @display_fields = RT->Config->Get('CalendarPopupFields') if 0 == @display_fields and RT->can('Config') and RT->Config->Get('CalendarPopupFields'); # default if (0 == @display_fields) { @display_fields = qw(OwnerObj->Name CreatedObj->ISO StartsObj->ISO StartedObj->ISO LastUpdatedObj->ISO DueObj->ISO ResolvedObj->ISO Status Priority Requestors->MemberEmailAddressesAsString); } my %label_of; for my $field (@display_fields) { my $label = $field; $label =~ s'Obj-.(?:AsString|Name|ISO)''g; $label =~ s'-\>MemberEmailAddressesAsString''g; $label_of{$field} = $label; } RTx-Calendar-1.00/html/Callbacks/0000755000175000017500000000000012443706064015517 5ustar chmrrchmrrRTx-Calendar-1.00/html/Callbacks/RTx-Calendar/0000755000175000017500000000000012443706064017743 5ustar chmrrchmrrRTx-Calendar-1.00/html/Callbacks/RTx-Calendar/Elements/0000755000175000017500000000000012443706064021517 5ustar chmrrchmrrRTx-Calendar-1.00/html/Callbacks/RTx-Calendar/Elements/Tabs/0000755000175000017500000000000012443706064022410 5ustar chmrrchmrrRTx-Calendar-1.00/html/Callbacks/RTx-Calendar/Elements/Tabs/Privileged0000644000175000017500000000474412443674324024441 0ustar chmrrchmrr%# BEGIN BPS TAGGED BLOCK {{{ %# %# COPYRIGHT: %# %# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC %# %# %# (Except where explicitly superseded by other copyright notices) %# %# %# LICENSE: %# %# This work is made available to you under the terms of Version 2 of %# the GNU General Public License. A copy of that license should have %# been provided with this software, but in any event can be snarfed %# from www.gnu.org. %# %# This work is distributed in the hope that it will be useful, but %# WITHOUT ANY WARRANTY; without even the implied warranty of %# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU %# General Public License for more details. %# %# You should have received a copy of the GNU General Public License %# along with this program; if not, write to the Free Software %# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA %# 02110-1301 or visit their web page on the internet at %# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. %# %# %# CONTRIBUTION SUBMISSION POLICY: %# %# (The following paragraph is not intended to limit the rights granted %# to you to modify and distribute this software under the terms of %# the GNU General Public License and is only of importance to you if %# you choose to contribute your changes and enhancements to the %# community by submitting them to Best Practical Solutions, LLC.) %# %# By intentionally submitting any modifications, corrections or %# derivatives to this work, or any other work intended for use with %# Request Tracker, to Best Practical Solutions, LLC, you confirm that %# you are the copyright holder for those contributions and you grant %# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, %# royalty-free, perpetual, license to use, copy, create derivative %# works based on those contributions, and sublicense and distribute %# those contributions and any derivatives thereof. %# %# END BPS TAGGED BLOCK }}} <%INIT> my $request_path = $HTML::Mason::Commands::r->path_info; my $query_string = sub { my %args = @_; my $u = URI->new(); $u->query_form(%args); return $u->query; }; if ( $request_path =~ qr{^/Search/} && $m->request_args->{Query} ) { my $tabs = PageMenu; my $chart = $tabs->child('chart'); $chart->add_after( 'calendar' => title => loc('Calendar'), path => '/Search/Calendar.html?' . $query_string->( %{$m->request_args} ) ); } RTx-Calendar-1.00/html/Search/0000755000175000017500000000000012443706064015045 5ustar chmrrchmrrRTx-Calendar-1.00/html/Search/Calendar.html0000644000175000017500000001564712423732273017460 0ustar chmrrchmrr<%args> $Month => (localtime)[4] $Year => (localtime)[5] + 1900 $Query => undef $Format => undef $Order => undef $OrderBy => undef $RowsPerPage => undef $NewQuery => 0 <& /Elements/Header, Title => $title &> % if ( $m->comp_exists( '/Ticket/Elements/Tabs' ) ) { <& /Ticket/Elements/Tabs, current_tab => "Search/Calendar.html?$QueryString", Title => $title &> % } else { <& /Elements/Tabs &> % } <&| /Widgets/TitleBox, title => loc('Calendar for [_1] [_2]', $rtdate->GetMonth($Month), $Year) &>
% my ($PMonth, $PYear) = ($Month - 1, $Year); % if ($PMonth < 0) { % $PYear--; % $PMonth = 11; % } « <%$rtdate->GetMonth($PMonth)%> <% $rtdate->GetMonth($Month). " $Year" %> % my ($NMonth, $NYear) = ($Month + 1, $Year); % if ($NMonth > 11) { % $NYear++; % $NMonth = 0; % } <%$rtdate->GetMonth($NMonth)%> »
% for ( @{$week{$weekstart}} ) { % } % while ($date <= $end) { % my @classes = (); % push @classes, "offmonth" if $date->month != ($Month + 1); % push @classes, "today" if (DateTime->compare($today, $date) == 0); % push @classes, "yesterday" if (DateTime->compare($yesterday, $date) == 0); % push @classes, "aweekago" if (DateTime->compare($aweekago, $date) == 0); % $date = $set->next($date); % if ( $date->day_of_week == $startday_of_week ) { % } % }
<%$rtdate->GetWeekday($_)%>
<%$date->day%>
% for my $t ( @{ $Tickets{$date->strftime("%F")} } ) { <& /Elements/CalendarEvent, Object => $t, Date => $date, DateTypes => \%DateTypes &> % }
« <%$rtdate->GetMonth($PMonth)%>
% my $year = (localtime)[5] + 1900;
<%$rtdate->GetMonth($NMonth)%> »
% foreach my $legend (sort keys %legend) { % }
% my $more = 0; % foreach ( @{$legend{$legend}} ) { <% $more++ ? ', ' : '' %> <&|/l&><% $_ %> % }
<&| /Widgets/TitleBox, title => loc('Help') &>

<&|/l&>displaying reminders:

<&|/l_unsafe, qq{} . loc("Advanced") . '' &> If you want to have reminders in a search you need to go to [_1] tab and add something to the Query like that:

   AND ( Type = 'ticket' OR Type = 'reminder' )

<&|/l&>displaying other kind of dates:

<&|/l_unsafe, qq{} . loc("Query Builder") . ''&> By default RTx::Calendar display Due and Starts dates. You can select other kind of events you want with the Display Columns section in the [_1]. The following one will display the two latter and LastUpdated dates:

  '<small>__Due__</small>',
  '<small>__Starts__</small>',
  '<small>__LastUpdated__</small>'

<&|/l&>changing the default query:

<&|/l_unsafe, qq{} . loc("Query Builder") . ''&> You can change the default Query of Calendar.html and MyCalendar portlet by saving a query with the name calendar in the [_1].

<%ONCE> my %legend = ( 'created' => ['Created'], 'due' => ['Due'], 'resolved' => ['Resolved'], 'updated' => ['Last Updated'], 'created_due' => ['Created','Due'], 'reminder' => ['Reminders'], 'started' => ['Started'], 'starts_due' => ['Starts','Due'], ); <%INIT> my $title = loc("Calendar"); my @DateTypes = qw/Created Starts Started Due LastUpdated Resolved/; my $rtdate = RT::Date->new($session{'CurrentUser'}); my $weekstart = 'Sunday'; #RT::SiteConfig? user pref? my %week = ( 'Saturday' => [6,0..5], 'Sunday' => [0..6], 'Monday' => [1..6,0], ); my $startday_of_week = ${$week{$weekstart}}[0] || 7; my $endday_of_week = ${$week{$weekstart}}[-1] || 7; my $today = DateTime->today; my $yesterday = $today->clone->subtract( days=>1 ); my $aweekago = $today->clone->subtract( days=>7 ); my $date = RTx::Calendar::FirstDay($Year, $Month + 1, $startday_of_week ); my $end = RTx::Calendar::LastDay ($Year, $Month + 1, $endday_of_week ); # use this to loop over days until $end my $set = DateTime::Set->from_recurrence( next => sub { $_[0]->truncate( to => 'day' )->add( days => 1 ) } ); my $QueryString = $m->comp( '/Elements/QueryString', Query => $Query, Format => $Format, Order => $Order, OrderBy => $OrderBy, Rows => $RowsPerPage ) if ($Query); $QueryString ||= 'NewQuery=1'; # Default Query and Format my $TempFormat = "__Starts__ __Due__"; my $TempQuery = "( Status = 'new' OR Status = 'open' OR Status = 'stalled') AND ( Owner = '" . $session{CurrentUser}->Id ."' OR Owner = 'Nobody' ) AND ( Type = 'reminder' OR 'Type' = 'ticket' )"; if ( my $Search = RTx::Calendar::SearchDefaultCalendar($session{CurrentUser}) ) { $TempFormat = $Search->SubValue('Format'); $TempQuery = $Search->SubValue('Query'); } # we overide them if needed $TempQuery = $Query if $Query; $TempFormat = $Format if $Format; # we search all date types in Format string my @Dates = grep { $TempFormat =~ m/__${_}(Relative)?__/ } @DateTypes; # used to display or not a date in Element/CalendarEvent my %DateTypes = map { $_ => 1 } @Dates; $TempQuery .= RTx::Calendar::DatesClauses(\@Dates, $date->strftime("%F"), $end->strftime("%F")); # print STDERR ("-" x 30), "\n", $TempQuery, "\n"; my %Tickets = RTx::Calendar::FindTickets($session{'CurrentUser'}, $TempQuery, \@Dates, $date->strftime("%F"), $end->strftime("%F")); RTx-Calendar-1.00/CHANGES0000644000175000017500000000374012443706025013670 0ustar chmrrchmrr1.00 - Packaging and documentation updates - Drop ical support, as it is in core RT - Add documentation to Calendar.html 0.20 - Packaging fixes only (0.19 failed to update CHANGES) 0.19 - Fix double-encoding of previous/next month chevrons 0.18 - RT 4.2 compatibility - UI updates from Ivan Kohler 0.17 - Re-released after resolving PAUSE permissions; no changes since 0.16 0.16 Never indexed by PAUSE - Remove dependency on Date::ICal and use RT::Date's support instead 0.15 - Switch to Digest::SHA from Digest::SHA1 to appease Debian 0.14 - Guard the modern stylesheets call on older RTs 0.13 - Serve CSS the modern way on recent RT's - Namespace our CSS to avoid styling the RT core UI 0.12 - Copyright updates 0.11 - fixes for characters that were breaking 3.8 0.10 - packaging tweak 0.09 - RT 4 compatibility 0.08 - make sure the last date of a search is displayed (Shawn M Moore) [rt.cpan.org #63469] 0.07 - add documentation on how to enable plugin in rt 3.8 and later - add configuration to show owner in calendar (Shawn M Moore) - make the popup display fields configurable (Shawn M Moore) - tickets and reminders types (todo/event) are configurable in ical feed 0.06 - rt 3.8 compatibility 0.05 - fix a bug in ics feeds when showing reminders - use Module::Install::RTx 0.21 0.04 - should work with rt 3.6.0 and seems to work with 3.7.2 - display Starts date by default - you can use Format to display dates you want (Created, Started, Due, Starts, ...) - if a saved search is named "calendar", use it for the default Calendar.html and for the portlet - fix a bug in Prefs 0.03 - now uses Query Builder to find tickets - ics (ICal) feeds available for each personal search with magic number authentication method - default calendars and feeds show reminders - Calendar.html move in Search - MyCalendar links to your own tickets and Nobody's tickets for the current month - fix a problem with localtime and gmtime 0.02 - First release RTx-Calendar-1.00/static/0000755000175000017500000000000012443706064014163 5ustar chmrrchmrrRTx-Calendar-1.00/static/images/0000755000175000017500000000000012443706064015430 5ustar chmrrchmrrRTx-Calendar-1.00/static/images/started.png0000644000175000017500000000164612332546066017614 0ustar chmrrchmrr‰PNG  IHDR r,QgAMAБ ќaPLTEџџџЕџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџšЉџэtRNS@циf pHYs № №BЌ4˜tIMEз  ЙйIDATзc`F8`dDb2B)0@EW Ф-qЛ“IENDЎB`‚RTx-Calendar-1.00/static/images/starts.png0000644000175000017500000000164712332546066017467 0ustar chmrrchmrr‰PNG  IHDR r,QgAMAБ ќaPLTEџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџй$ tRNS@циf pHYs № №BЌ4˜tIMEз 'ЭЎЮAIDATзc`d0&сLF8“ PE‘еB vлT˜'IENDЎB`‚RTx-Calendar-1.00/static/images/created_due.png0000644000175000017500000000174512332546066020412 0ustar chmrrchmrr‰PNG  IHDR r,Q-tEXtCreation Timemar. 7 nov. 2006 19:09:15 +0100{NЎпtIMEж HsЊО pHYs № №BЌ4˜gAMAБ ќaPLTEџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџЃ„fеtRNSџхЗ0J!IDATxкc``ddaF0“‰Щ!Р]U-и'T ФюIENDЎB`‚RTx-Calendar-1.00/static/images/updated.png0000644000175000017500000000027712332546066017573 0ustar chmrrchmrr‰PNG  IHDRЎШNHgAMAБ ќa pHYs № №BЌ4˜tIMEз  'tdІБNIDATз-ЩБ ‚PРг`ќЖВЂz•q†pCчTќ!lрHЏ“†kят”Ъ+nxѕж ЎgŽи№УŽ%•' Љ4|ёЦЇЗўOeТœЪ§ќHŽJ"_ IENDЎB`‚RTx-Calendar-1.00/static/images/starts_due.png0000644000175000017500000000025512332546066020316 0ustar chmrrchmrr‰PNG  IHDRз…'gAMAБ ќa pHYs № №BЌ4˜tIMEз ;Ібžщ8c9ZH‘у€=VИс‰!І?і,6ТгШpIENDЎB`‚RTx-Calendar-1.00/static/images/created.png0000644000175000017500000000174212332546066017552 0ustar chmrrchmrr‰PNG  IHDR r,Q-tEXtCreation Timemar. 7 nov. 2006 19:10:20 +0100šbr‘tIMEж %gж9 pHYs № №BЌ4˜gAMAБ ќaPLTEЕџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџџY„\tRNSџхЗ0JIDATxкc``Щe2 1СEбе1Ч, uQIENDЎB`‚RTx-Calendar-1.00/static/css/0000755000175000017500000000000012443706064014753 5ustar chmrrchmrrRTx-Calendar-1.00/static/css/calendar.css0000644000175000017500000000235712345405555017247 0ustar chmrrchmrr/* Tooltips */ table.rtxcalendar .tooltip { position: relative; z-index: 1; } table.rtxcalendar .tooltip:hover { z-index: 5; color:#000; } table.rtxcalendar .tooltip span.tip { display: none; text-align: left; } table.rtxcalendar div.tooltip:hover span.tip{ display: block; position: absolute; top:12px; left:24px; width:350px; border: 1px solid #555; background-color: #fff; padding: 4px; font-size: 0.8em; color: #505050; } /* For the full calendar */ table.rtxcalendar { width:100%; border-collapse: collapse; border: 1px solid #d0d0d0; margin-bottom: 6px; } table.rtxcalendar td { border: 1px solid #d7d7d7; background: #fff; vertical-align: top; width: 14%; } table.rtxcalendar th { border: 1px solid #d7d7d7; background: #eef; } table.rtxcalendar td .inside-day { min-height: 5em; } table.rtxcalendar td.offmonth { background: #f8f8f8; color: #aaa; } table.rtxcalendar td.today { background: #ffe; border: 1px solid #fc6; } table.rtxcalendar td.today .calendardate { background-color: #fc6; width:100%; } table.rtxcalendar td.yesterday { border-right: none; } table.rtxcalendar td.aweekago { border-bottom: none; }