#  ReminderDaemon.pl
#  Example 8.14:
#  ----------------------------------------
#  From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#  Published by New Riders Publishing.
#  ISBN # 1-57870-215-1
#
#  This script is a Win32 daemon that demonstrates how a Perl service can
#  interact with MS Exchange and send out pages when appointments, tasks and
#  meetings are due.
#
print "From the book 'Win32 Perl Scripting: The Administrator's Handbook' by Dave Roth\n\n";


use Win32::OLE qw( EVENTS HRESULT );
use Win32::OLE::Const 'Microsoft CDO 1.21 Library';
use Win32::Daemon;
use Win32::Console;
use Time::Local;
use Net::Pager;
use Getopt::Long;

$SCRIPT_PATH = Win32::GetFullPathName( $0 );
$VERSION = 20000619;

# How far ahead tdo we look at calendar events?
# In seconds
$TIME_CONSIDERATION_INTERVAL = 60 * 60 * 24;

# How much time do we sleep between polling the service manager?
# In seconds.
$SERVICE_SLEEP_TIME = 2;

# How often do we actually process calendars?
# In seconds.
$CALENDAR_PROCESS_TIME_INTERVAL = 60;

# Default values
%$Config = (
  account   => '',
  password  => '',
  name    => 'Reminder',
  display   => 'Reminder Service',
);

Configure( \%Config );
if( $Config{help} || scalar @ARGV )
{
  Syntax();
  exit();
}
elsif( $Config{install} )
{
  InstallService();
  exit();
}
elsif( $Config{remove} )
{
  RemoveService();
  exit();
}

@FOLDERS = (
  CdoDefaultFolderCalendar,
  CdoDefaultFolderTasks
);

%PROFILES = (
  "Jamie Smith's Mailbox" => {
    pager_service  => '7', # Service value of 7 represents AT&T PCS
    pager_id    => '2069790127',
#        mailbox         =>  'Jamie Smith',
#        server          =>  'ExchangeServer',
mailbox => "Dave Roth",
server => "data"
    },
);

$CLASS = "MAPI.Session";
%PROPERTY = (
  task_reminder_flag => -2147418101,
  task_reminder_date => -2146369472,
  task_due_date    => -2144796608,
);

#my ( $DB_FILE ) = ( $SCRIPT_PATH =~ /(.*?)\..*?$/ )[0] . ".log";
my $DB_FILE = "\\\\.\\pipe\\SysLog";
if( open( LOG, "> $DB_FILE" ) )
{
  my $Handle = select( LOG );
  $| = 1;
  select( $Handle );
  print LOG "Software: $0\n";
  print LOG "Version: $VERSION\n";
  print LOG "Started: " . localtime() . "\n\n";
}

if( ! $Config{console} )
{
  # Start the service...
  if( ! Win32::Daemon::StartService() )
  {
    exit();
  }
  Win32::Daemon::ShowService();

  $Buffer = new Win32::Console();
  $Buffer->Display();
  $Buffer->Title( $Config{display} );
  Write( "Service started\n" );
}

Debug( " With debugging mode turned on.\n" );

$NextTime = time();
$PrevState = SERVICE_STARTING;
$AppState = 0;
while( SERVICE_STOPPED != ( $State = Win32::Daemon::State() ) )
{
  if( $Config{console} )
  {
    # Fake out the service control loop if we are running
    # as a console application instead of a service
    $State = ( $AppState++ )? SERVICE_RUNNING : SERVICE_START_PENDING;
  }
  Debug( "Service State: $State\n" );
  if( SERVICE_START_PENDING == $State )
  {
    # Initialization code
    my $iTotal = 0;
    foreach my $ProfileName ( keys( %PROFILES ) )
    {
      my $Profile = $PROFILES{$ProfileName};
      my $Mapi = Win32::OLE->new( $CLASS, \&Quit );
      if( defined $Mapi )
      {
        $Mapi->Logoff();
        $Mapi->Logon( {
          NoMail => 1,
          ProfileInfo => "$Profile->{server}\n$Profile->{mailbox}",
        } );
        if( Win32::OLE->LastError() != HRESULT( 0x00000000 ) )
        {
          my $ComError = Win32::OLE->LastError();
          Write( "Unable to logon $ProfileName. (Error: $ComError)\n" );
          undef $Mapi;
        }
        else
        {
          $PROFILES{$ProfileName}->{mapi} = $Mapi;
          Write( "$ProfileName has logged on.\n" );
          $iTotal++;
        }
      }
    }
    if( $iTotal )
    {
      Win32::Daemon::State( SERVICE_RUNNING );
      $PrevState = SERVICE_RUNNING;
      Write( "Running\n" );
    }
    else
    {
      Write( "Unable to logon any profiles. Stopping\n" );
      Win32::Daemon::State( SERVICE_STOPPED );
      $PrevState = SERVICE_STOPPED;
    }
  }
  elsif( SERVICE_PAUSE_PENDING == $State )
  {
    # "Pausing...";
    Win32::Daemon::State( SERVICE_PAUSED );
    $PrevState = SERVICE_PAUSED;
    Write( "Paused\n" );
    next;
  }
  elsif( SERVICE_CONTINUE_PENDING == $State )
  {
    # "Resuming...";
    Win32::Daemon::State( SERVICE_RUNNING );
    $PrevState = SERVICE_RUNNING;
    Write( "Resumed\n" );
    next;
  }
  elsif( SERVICE_STOP_PENDING == $State )
  {
    # "Stopping...";
    Win32::Daemon::State( SERVICE_STOPPED );
    $PrevState = SERVICE_STOPPED;
    Write( "Stopped\n" );
    next;
  }
  elsif( SERVICE_PAUSED == $State )
  {
    # The service is paused so don't do anything
    $PrevState = SERVICE_PAUSED;
  }
  elsif( SERVICE_RUNNING == $State )
  {
    # The service is running as normal...
    my $Time = time();
    if( $Time >= $NextTime )
    {
      ProcessEvents( $Time );
      $NextTime = $Time + $CALENDAR_PROCESS_TIME_INTERVAL;
    }
    $PrevState = SERVICE_RUNNING;
  }
  else
  {
    Write( "Recieived unknown state: $State\n" );
    Win32::Daemon::State( $PrevState );
  }
  sleep( $SERVICE_SLEEP_TIME );
}

Win32::Daemon::StopService() unless( $Config{console} );

sub ProcessEvents
{
  my( $Time ) = @_;
  my %TimeLimit = (
    earliest=> GetTimestringFromArray( GetTimeFromStamp( $Time ) ),
    latest => GetTimestringFromArray( 
                GetTimeFromStamp( $Time 
                + $TIME_CONSIDERATION_INTERVAL ) )
  );

  Debug( " Processing events\n" );
  foreach my $Profile ( keys( %PROFILES ) )
  {
    my $Mapi = $PROFILES{$Profile}->{mapi};

    next if( ! defined $Mapi );
    foreach my $FolderType ( @FOLDERS )
    {
      my $Folder = $Mapi->GetDefaultFolder( $FolderType );
      my $Messages = $Folder->Messages();
      my $Filter = $Messages->{Filter};
      my $Fields = $Filter->{Fields};

      # Remove any filters
      $Fields->Delete();
      $Filter->{Not} = 0;
      $Filter->{Or} = 0;

      # Filter only on calendar messages (there are usually many
      # more of them than tasks)
      if( CdoDefaultFolderCalendar == $FolderType )
      {
        # Note: The End and Start dates are backward. CDO bug.
        # Note2: Both dates must be specified. CDO bug.
        # Note3: Only both dates can be set. Setting other filter
        #    properties causes a "Too complex" error. CDO bug.
        #
        # If the beginning time AND the ending time are between
        # these timestamps then the message will be presented to
        # us.

        Debug( " Start date: $TimeLimit{earliest}\n" );
        Debug( " Stop date: $TimeLimit{latest}\n" );

        $Fields->Add( CdoPR_START_DATE, $TimeLimit{latest} );
        $Fields->Add( CdoPR_END_DATE, $TimeLimit{earliest} );
        Debug( " Processing Calendar...\n" );
      }
      elsif( CdoDefaultFolderTasks == $FolderType )
      {
        Debug( " Processing Tasks...\n" );
      }

      # Cycle through and consider each message
      Debug( " Total messages to consider: '" 
             . $Messages->Count() . "'\n" );
      foreach my $Message ( in $Messages )
      {
        my @NotifyDate;
        my $ID = $Message->{ID};
        my $MessageContent;


        # If we have already processed this message then
        # don't bother trying again.
        next if( $PROCESSED{$ID} );

        Debug( " Considering: $Message->{Subject}\n" );
        if( 1 == scalar ( @NotifyDate = GetNotifyDate( $Message ) ) )
        {
          # We could not find a reminder date/time for the message
          next;
        }

        # Figure out when the event is scheduled for
        my $NotifyTime;
        $NotifyTime = timelocal( @NotifyDate );

        Debug( "  Notify on " . localtime( $NotifyTime ) . "'\n" );

        # If the reminder notification time has not yet come
        # then skip to the next message
        next if( $NotifyTime > $Time );

        $MessageContent = GetMessageContent( $Message );
        DisplayMessage( $MessageContent );

        # Send out a page
        if( ( ! $Config{nopage} ) 
                && ( SendMessage($PROFILES{$Profile},
                $MessageContent ) ) )
        {
          # This block is dangerous. It is here to show
          # what can be done but it's commented out to
          # prevent accidental modifications to the
          # scheduled events on the Exchange server.
          # Uncomment at your own risk!

          # Turn off this message's reminder
          # $Message->{ReminderSet} = 0;

          # Update the message with the new reminder state,
          # make it permanent and refresh the message
          # $Message->Update( 1, 1 );

          Write( "   Page was sent on " . localtime() . ".\n" );
        }
        else
        {
          # The page failed so leave the reminder set
          # so we have another chance at it
          Write( "   No page was sent out on" . localtime() . ".\n" );
        }

        # Remember that the message has been successfully processed
        $PROCESSED{$ID} = time();
        Write( "\n" );
      }
    }
  }
  Debug( " End of processing.\n" );
}

sub GetMessageContent
{
  my( $Message ) = @_;
  my %Content = (
    subject => $Message->{Subject},
  );
  ( $Content{type} ) = ( $Message->{Type} =~ /([^.]*)$/ );

  if( $Message->{Type} eq "IPM.Appointment" )
  {
    $Content{location} = $Message->{Location};
    $Content{time} = $Message->{StartTime};

  }
  elsif( $Message->{Type} eq "IPM.Task" )
  {
    my $Date = $Message->{Fields}->Item( $PROPERTY{task_due_date} );
    if( defined $Date )
    {
      $Content{time} = $Date->{Value};
    }
  }
  $Content{name} = $Message->{Session}->{CurrentUser}->{Name};
  $Content{profile} = $Message->{Session}->{Name};
  return( \%Content );
}

# Determine the notify date (in an localtime array format)
# for a message
sub GetNotifyDate
{
  my( $Message ) = @_;
  my( @Date );
  
  if( $Message->{Type} eq "IPM.Appointment" )
  {
    if( $Message->{ReminderSet} )
    {
      Debug( "  Reminder flag is set.\n" );
      @Date = GetTimeFromString( $Message->{StartTime} );
      $Time = timelocal( @Date ) 
              - ( $Message->{ReminderMinutesBeforeStart} * 60 );
      @Date = localtime( $Time );
    }
  }
  elsif( $Message->{Type} eq "IPM.Task" )
  {
    my $ReminderFlag = $Message->{Fields}->Item(
                       $PROPERTY{task_reminder_flag} );
    my $ReminderDate = $Message->{Fields}->Item(
                       $PROPERTY{task_reminder_date} );

    next unless( defined $ReminderDate && defined $ReminderFlag );
    if( $ReminderFlag->{Value} )
    {
      Debug( "  Reminder flag is set.\n" );
      @Date = GetTimeFromString( $ReminderDate->{Value} );
    }
  }
  return( ( scalar @Date )? @Date : undef );
}


# Convert a MAPI date/time stamp into a date array
sub GetTimeFromString
{
  my( $Time ) = @_;
  my @Temp = 
    ( $Time =~ m#(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+)\s+(AM|PM)#i);
  my @Date = (
    0,
    $Temp[4], # Min
    $Temp[3], # Hour
    $Temp[1], # Day
    $Temp[0] - 1, # Month
    $Temp[2] - 1900, # Year
  );
  # Convert from 12 to 24 hour time formats
  $Date[2] -= 12;
  $Date[2] += 12 if( $Date[2] < 0 );
  $Date[2] += 12 if( uc $Temp[6] eq "PM" );

  return( @Date );
}

# Convert from a Perl timestamp to a date array
sub GetTimeFromStamp
{
  my( $Time ) = @_;
  my @Date = localtime( $Time );

  # Month
  $Date[4]++;
  # Year
  $Date[5] += 1900;
  return( @Date );
}

sub GetTimestringFromArray
{
  my( @Date ) = @_;
  return( sprintf( "%2d/%02d/%04d %2d:%02d:00 %s",
           $Date[4],
           $Date[3],
           $Date[5],
           $Date[2],
           $Date[1],
           ( ( $Date[2] < 12)? "AM" : "PM" ) ) );
}

sub DisplayMessage
{
  my( $Message ) = @_;
  Write( " $Message->{type} Reminder: $Message->{time}\n" );
  Write( "   User: $Message->{name}\n" );
  Write( "   Subject: $Message->{subject}\n" );
}

sub SendMessage
{
  my( $Profile, $MessageContent ) = @_;
  my $Result = 0;

  if( my $Pager = new Net::Pager )
  {
    my $Body = "";

    $Body .= "T: $MessageContent->{time}" 
                     if( defined $MessageContent->{time} );
    $Body .= " L: $MessageContent->{location}" 
                     if( defined $MessageContent->{location} );

    $Result = $Pager->sendPage( 
                $Profile->{pager_service},
                $Profile->{pager_id},
                $Config{display},
                $Body,
                undef );
  }
  return( $Result );
}

sub GetServiceConfig
{
  my $ScriptPath = join( "", Win32::GetFullPathName( $0 ) );
  my %Hash = (
    name  =>   $Config{service},
    display =>   $Config{display},
    path  =>   $^X,
    user  =>   $Config{account},
    password  =>  $Config{password},
    parameters =>  "\"$ScriptPath\"",
    description => "Send out pages to remind you of scheduled events.",
  );
  $Hash{parameters} .= " -debug" if( $Config{debug} );
  $Hash{parameters} .= " -console" if( $Config{console} );
  $Hash{parameters} .= " -nopage" if( $Config{nopage} );
  return( \%Hash );
}

sub InstallService
{
  my $ServiceConfig = GetServiceConfig();

  if( Win32::Daemon::CreateService( $ServiceConfig ) )
  {
    print "The $ServiceConfig->{display} was successfully installed.\n";
  }
  else
  {
    print "Failed to add the $ServiceConfig->{display} service.\n";
    print "Error: " . GetError() . "\n";
  }
}

sub RemoveService
{
  my $ServiceConfig = GetServiceConfig();

  if( Win32::Daemon::DeleteService( $ServiceConfig->{name} ) )
  {
    print "The $ServiceConfig->{display} was successfully removed.\n";
  }
  else
  {
    print "Failed to remove the $ServiceConfig->{display} service.\n";
            print "Error: " . GetError() . "\n";
  }
}

sub GetError
{
  return( Win32::FormatMessage( Win32::Daemon::GetLastError() ) );
}

sub Debug
{
  Write( @_ ) if( $Config{debug} );
}

sub Write
{
  my( $Message ) = @_;
  if( defined $Buffer )
  {
    $Buffer->Write( $Message );
  }
  else
  {
    print $Message;
  }
  if( fileno( LOG ) )
  {
    print LOG $Message;
  }
}

sub Configure
{
  my( $Config ) = @_;
  my $WarnSub = $SIG{__WARN__};
  undef $SIG{__WARN__};
  Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
  GetOptions( \%Config,
    qw(
      install
      remove
      account=s
      password=s
      display=s
      name=s
      debug
      console
      nopage
      help
    )
   );
  $SIG{__WARN__} = $WarnSub;
}

sub Syntax
{
  my( $Script ) = ( $0 =~ /([^\\]*?)$/ );
  my $Whitespace = " " x length( $Script );
  print<< "EOT";

Syntax:
  $Script [-install [-account Account] [-password Password]
  $Whitespace [-display DisplayName] [-name ServiceName] ]
  $Whitespace [-remove]
  $Whitespace [-debug]
  $Whitespace [-console]
  $Whitespace [-help]

    -install...........Installs the service.
        -account.......Specifies what account the service runs under.
                       Default: Local System
        -password......Specifies the password the service uses.
        -display.......Specifies the display name of the service.
                       Default: $Config{display_name}
        -name..........Specifies the name of the service.
                       Default: $Config{service_name}
    -remove............Removes the service.
    -debug.............Show debug info. The log file will grow
                       quite large
    -console...........Run as a console application (not as a
                       service).
    -nopage............Do not send out pages.
EOT
}

sub Quit
{
  foreach my $Profile ( keys( %PROFILES ) )
  {
    if( defined $PROFILES{$Profile}->{mapi} )
    {
      my $Mapi = $PROFILES{$Profile}->{mapi};
      Write( "Logging out $Mapi->{Name}\n" );
      $Mapi->Logoff();
      undef $PROFILES{$Profile}->{mapi};
    }
  }
}

END
{
  Quit();
}