File Coverage

blib/lib/Finance/QuoteOptions.pm

Criterion	Covered	Total	%
statement	18	429	4.2
branch	0	194	0.0
condition	0	92	0.0
subroutine	6	26	23.0
pod	18	20	90.0
total	42	761	5.5

#
# Finance::QuoteOptions Module
# Extract options prices and series information from the web.
#
# (C) Copyright 2007-2010 Kirk Bocek
# Version 0.20 Contributions by Dan Dascalescu
#
package Finance::QuoteOptions;

#require 5.6.1;
use 5.006001;
use strict;
use WWW::Mechanize;
#use LWP::UserAgent; #See Changes document
use HTML::TokeParser;

# set the version for version checking
our $VERSION = 0.23;

############################
# Start of class definitions
############################

sub new {
    my $class = shift;
    my $self  = {};
    $self->{source} = 'yahoo';
    $self->{symbol} = undef;
    $self->{proxy} = undef;

    $self->{symbol} = shift if @_; #Set symbol if provided
    $self->{symbol} = uc $self->{symbol} if $self->{symbol};

    bless ($self, $class);
    return $self;
}

sub symbol {
    #Set or return target symbol
    my $self = shift;
    if (not @_) {
        return $self->{symbol};
    }
    $self->{symbol} = shift;
    $self->{data}  = [];
    $self->{success} = undef;
    $self->{status} = undef;
    $self->{response} = undef;
}

sub source {
    #Set or return data source
    #Only 'yahoo' or 'cboe' is accepted
    #Set source to 'yahoo' if anything else is provided
    my $self = shift;

    return $self->{source} unless @_;

    my $param = shift;
    $self->{source} = 'yahoo';
    $self->{source} = 'cboe' if lc($param) eq 'cboe';
    return $self->{source};
}

sub retrieve {
    #get data
    my ($self, $expirations) = @_;
    return 0 unless $self->{symbol};
    if ($self->{source} eq 'cboe') {
        $self->getcboedata();
    } else {
        #Yahoo is the default
        $self->getyahoodata($expirations);
    }
    return $self->{success};
}

sub expirations {
    #Return arrayref of all expiration dates
    my $self = shift;
    my $dates = [];
    push @$dates, $_->{exp} foreach @{$self->{data}};
    return $dates;
}

sub calls {
    #Return arrayref with all calls for a given expiration
    #If param is 6 or 8 characters then it's an expiration date
    #3 or fewer characters and it's number of expirations out
    #Date can be ###, YYYYMM or YYYYMMDD
    my $self = shift;
    my $exp = shift;
    return if not defined $exp or $exp < 0;
    #Check if too many expirations out:
    return if length($exp) < 4 and $exp > $#{$self->{data}};
    #If not number of exp out, then param must be 6 or 8 chars long
    return if length($exp) > 3 and length($exp) !~ /^[68]$/;

    $exp += 0; #Make sure it's numeric
    return $self->{data}->[$exp]->{calls} if length $exp < 4;
    #Param is date
    foreach (@{$self->{data}}) {
        return $_->{calls} if length $exp == 6 and $exp == substr($_->{exp},0,6);
        return $_->{calls} if length $exp == 8 and $exp == $_->{exp};
    }
    return;
}

sub puts {
    #Return all puts for a given expiration
    #See calls() above
    my $self = shift;
    my $exp = shift;
    return if not defined $exp or $exp < 0;
    return if length($exp) < 4 and $exp > $#{$self->{data}};
    return if length($exp) > 3 and length($exp) !~ /^[68]$/;

    $exp += 0; #Make sure it's numeric
    return $self->{data}->[$exp]->{puts} if length $exp < 4;
    foreach (@{$self->{data}}) {
        return $_->{puts} if length $exp == 6 and $exp == substr($_->{exp},0,6);
        return $_->{puts} if length $exp == 8 and $exp == $_->{exp};
    }
    return;
}

sub callsymbols {
    #Return arrayref with all call symbols for a given expiration
    my $self = shift;
    my $exp = shift;
    return if $exp < 0;
    return unless defined $exp and $exp <= $#{$self->data};
    $exp+=0;

    my $ret = [];
    push @$ret, $_->{symbol} foreach @{$self->{data}->[$exp]->{calls}};
    return $ret;
}

sub putsymbols {
    #Return arrayref with all put symbols for a given expiration
    my $self = shift;
    my $exp = shift;
    return if $exp < 0;
    return unless defined $exp and $exp <= $#{$self->data};
    $exp+=0;

    my $ret = [];
    push @$ret, $_->{symbol} foreach @{$self->{data}->[$exp]->{puts}};
    return $ret;
}

sub callstrikes {
    #Return arrayref with all call strike prices for a given expiration
    my $self = shift;
    my $exp = shift;
    return if $exp < 0;
    return unless defined $exp and $exp <= $#{$self->data};
    $exp+=0;

    my $ret = [];
    push @$ret, $_->{strike} foreach @{$self->{data}->[$exp]->{calls}};
    return $ret;
}

sub putstrikes {
    #Return arrayref with all put strike prices for a given expiration
    my $self = shift;
    my $exp = shift;
    return if $exp < 0;
    return unless defined $exp and $exp <= $#{$self->data};
    $exp+=0;

    my $ret = [];
    push @$ret, $_->{strike} foreach @{$self->{data}->[$exp]->{puts}};
    return $ret;
}

#-------------------------------------------------------------------
sub option {
    #Retrieve a single option
    my $self = shift;
    my $sym = shift;
    return unless $sym;

    my $ret = undef;
    my $date = undef;
    my $opt = undef;
    MAIN: for my $exp (@{$self->{data}}) {
        $date = $exp->{exp};
        for my $o (@{$exp->{calls}}) {
            if (lc $o->{symbol} eq lc $sym) {
                $opt = $o;
                last MAIN;
            }
        }
        for my $o (@{$exp->{puts}}) {
            if (lc $o->{symbol} eq lc $sym) {
                $opt = $o;
                last MAIN;
            }
        }
    }
    #Copy the found option to a new annonymous hash
    #Since we need to add the {exp} key
    if ($opt) {
        $ret = {};
        %$ret = %$opt;
        $ret->{exp} = $date;
    }
    return $ret;
}

sub success {
    #Set or retrieve success
    my $self = shift;
    my $stat = shift;
    if (defined $stat) {
        $self->{success} = $stat;
    }
    return $self->{success};
}

sub status {
    #Set or retrieve status
    my $self = shift;
    my $stat = shift;
    $self->{status} = $stat if defined $stat;
    return $self->{status};
}

sub response {
    #Set or retrieve response
    my $self = shift;
    my $stat = shift;
    $self->{response} = $stat if defined $stat;
    return $self->{response};
}

sub proxy {
    #Set or retrieve proxy setting
    my $self = shift;
    my $stat = shift;
    $self->{proxy} = $stat if defined $stat;
    return $self->{proxy};
}

sub data {
    #Return reference to data hash
    my $self = shift;
    return $self->{data};
}

sub version {
    #Return version number
    my $self = shift;
    return $VERSION;
}

#-------------------------------------------------------------------
sub getyahoodata {
    #
    # Main query page:
    # http://finance.yahoo.com/q/op?s=DIA
    # Additional expirations:
    # http://finance.yahoo.com/q/op?s=DIA&m=2007-06
    #
    # The main query page yields options for only the next expiration.
    # At the top of those tables is a list of other expiration months.
    # Generate the URLs for those additional pages and visit them
    # in turn to get all the options data.
    #
    my $self = shift;
    my $expirations = shift || -1;  # how many expirations to retrieve, < 0 means all
    my $q = LWP::UserAgent->new(
        agent => 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.4) Gecko/20030624',
        timeout => 60,
    );

    #Set proxy if user has provided one
    $q->proxy(['http'], $self->proxy) if $self->proxy;

    return unless $self->symbol;
    my $sym = uc $self->symbol;

    my $response = $q->get("http://finance.yahoo.com/q/op?s=$sym");
    #Copy the LWP status to this instance
    $self->{success} = $response && $response->is_success;
    return unless $self->{success};
    $self->{response} = $response;
    $self->{status} = $response->code;
    my $content = $response->content;
    return if $content =~ /there are no all markets results for/i;  # MDER.PK


    my $tnum;
    my $st = HTML::TokeParser->new(\$content);
    my $ret;
    my $text;
    local ($_,$1,$2,$3,$4,$5); #Localizing special variables is recommended under mod_perl

    #
    # First look at the DIV tags to find 'View By Expiration'. Parse out
    # the list of expiration months. Create @optmonths containing expiration
    # months. Main loop will pop these off one by one, retrieve that page
    # and add the data to the data object.
    #

    my %month2num = qw(jan 01 feb 02 mar 03 apr 04 may 05 jun 06
        jul 07 aug 08 sep 09 oct 10 nov 11 dec 12);
    my %lmonth2num = qw(january 01 february 02 march 03 april 04 may 05 june 06
        july 07 august 08 september 09 october 10 november 11 december 12);
    my @optmonths = ('start');
    #Hash to translate Yahoo's column headers to our standard hash keys
    my %xheaders = (
        strike => 'strike',
        symbol => 'symbol',
        bid => 'bid',
        ask => 'ask',
        last => 'last',
        vol => 'volume',
        open_int => 'open',
        chg => 'change'
    );

    my $expdate = '';
    # @{$calldata} and @{$putdata} are arrays of hashes
    my $calldata = [];
    my $putdata = [];

    MAIN: while (@optmonths and $expirations) {  # keeps looping if $expirations was -1
        if ($optmonths[0] eq 'start') {
            #First time here, we're on the main query page. Extract expirations
            #months and populate @optmonths
            $expirations--;
            GETEXP: while ($st->get_tag('div')) {
                $text=$st->get_trimmed_text('/div');
                if ($text =~ /view by expiration/i) {
                    #Get expiration months
                    my ($exp) = $text =~ /view by expiration(.*)call options/i;
                    @optmonths = split(/\|/,$exp);
                    #Convert 'Jan 01' format to 'YYYY-MM'
					#Yahoo uses *both* short 'Jan' and long 'January'
                    for (@optmonths) {
                        last unless /(\w{3,9})\s+(\d{2,4})/;
						if (length($1) == 3) {
							#short month name or May
                        	$_ = ($2 < 100 ? 2000+$2 : $2) . '-' . $month2num{lc $1};
						} else {
							#long month name
                        	$_ = ($2 < 100 ? 2000+$2 : $2) . '-' . $lmonth2num{lc $1};
						}
                    };
                    shift @optmonths; #The first month is the page we're already at
                    last GETEXP;
                }
            }
        } else {
            #@optmonths has been populated, shift off the next month
            #and retrieve that page. When @optmonths is empty, we're done.
            #Additional months are at http://finance.yahoo.com/q/op?s=DIA&m=2007-06
            my $month = shift @optmonths;
            $expirations--;
            $response = $q->get("http://finance.yahoo.com/q/op?s=$sym&m=$month");
            $expdate = '';
            #Copy the LWP status to this instance
            $self->{success} = $response->is_success;
            $self->{status} = $response->code;
            $self->{response} = $response;
            next MAIN unless $self->{success};
        }

        # There's something like 25 or 26 tables present. We're only looking for
        # four of them: the Calls header and data tables and the Puts header
        # and data tables.
        #
        # We'll use HTML::TokeParser's ability to go from
        # even though the rows might be in different tables.
        # This requires a specific order of tables: calls header then
        # calls data then puts header then puts data.
        #
        # Look at the first TD cell in a table to determine if it's one we want:
        # 'Call Options' is the header table for calls and
        # 'Put Options' is the header table for puts. The *next* table after the
        # header table that starts with 'Strike' is the data table for that
        # category. Use $mode to tell which table we're currently looking for.

        #Reset the TokeParser object so we can scan by tables
        $content = $response->content;
        $st = HTML::TokeParser->new(\$content);
        my ($tag,$newrow,$colcnt) = ('',0,0);
        my @callheaders = ();
        my @putheaders = ();
        $calldata = [];
        $putdata = [];

        $st->get_tag('table'); #Jump to first table
        my $mode='start';
        ROW: while ($tag=$st->get_tag('tr','/table','/html')) {
            #TokeParser returns arrayref if found, undef if no more tags
            $tag = $tag->[0];
            last MAIN if $tag =~ /\/html/i or not $tag;
            #Finished when getting put data but found end of table
            #Some options pages (e.g. CENTA) have no Puts, just the header line
            last ROW if $tag =~ /\/table/i and $mode =~ /gputdata/;
            #First loop: Getting Rows
            $newrow=1;
            CELL: while ($tag=$st->get_tag('th', 'td','/tr','/html')) {
                #Second loop: getting table cells
				#As of 2010-08-31 Yahoo using
                my $in_the_money = 0+ (ref $tag->[1] &&
					exists $tag->[1]->{class} && $tag->[1]->{class} eq 'yfnc_h');
                $tag = $tag->[0];

                last MAIN if $tag =~ /\/html/i; #No data returned
                last CELL if $tag =~ /\/tr/i; #last cell in row
                $text=$st->get_trimmed_text('/th', '/td');

                #Perform cleanup & set mode between new rows
                if ($newrow) {
                    if ($mode =~ /start|gcalldata/ and
                            $text =~ /call options|put options/i) {
                        #Found Header Table
                        $mode='gcalldate' if $text =~ /call options/i;
                        $mode='gputdate' if $text =~ /put options/i;
                        $newrow=0;
                        next CELL;
                    } elsif ($mode eq 'gcalldate') {
                        #Got the expiration date in the call header
                        $mode = 'gcallheaders';
                        next ROW;
                    } elsif ($mode eq 'gputdate') {
                        #Got the expiration date in the put header
                        $mode = 'gputheaders';
                        next ROW;
                    } elsif (($mode eq 'gcallheaders' and not @callheaders) or
                            ($mode eq 'gputheaders' and not @putheaders)) {
                        #Haven't found column headers yet
                        next ROW unless $text =~ /strike/i;
                    } elsif ($mode eq 'gcalldata' or
                            ($mode eq 'gcallheaders' and @callheaders)) {
                        #Have column headers
                        next ROW unless $text; #Nothing in first cell
                        #Add a new row to @{$calldata}
                        push @{$calldata}, {in_the_money => $in_the_money};

                        $mode='gcalldata';
                        $colcnt=0;
                    } elsif ($mode eq 'gputdata' or
                            ($mode eq 'gputheaders' and @putheaders)) {
                        #Have column headers
                        #Add a new row to @{$putdata}
                        push @{$putdata}, {in_the_money => $in_the_money};
                        $mode = 'gputdata';
                        $colcnt=0;
                    } else {
                        #Nothing we want in this row
                        next ROW;
                    }
                }
                $newrow = 0;

                #Extract the data
                if ($mode =~ /gcalldate|gputdate/) {
                    if ($text and not $expdate) {
                        #Extract expiration date, convert to YYYYMMDD
						#Text Looks like Expire at close Friday, September 17, 2010
                        #$text =~ /(\w{3})\s+(\d{1,2}),\s+(\d{4})/;
                        $text =~ /(\w{3,9})\s+(\d{1,2}),\s+(\d{4})/;
						if (length($1) == 3) {
							#short month name or May
                        	$expdate = $3 . $month2num{lc $1} . $2;
						} else {
							#long month name
                        	$expdate = $3 . $lmonth2num{lc $1} . $2;
						}
                    }
                    $mode = 'gcallheaders' if $mode eq 'gcalldate';
                    $mode = 'gputheaders' if $mode eq 'gputdate';
                } elsif ($mode =~ /gcallheaders|gputheaders/) {
                    #Extract table headers
                    #Use %xheaders to translate to our standard headers
                    $text =~ s/ /_/g; #Spaces to underscores
                    push @callheaders, $xheaders{lc($text)}
                        if $mode eq 'gcallheaders';
                    push @putheaders, $xheaders{lc($text)}
                        if $mode eq 'gputheaders';
                } elsif ($mode =~ /gcalldata|gputdata/) {
                    #cleanup $text
                    $text =~ s/,//g; #Remove commas
                    if ($text =~ /(up|down)\s+(\d*.?\d*)/i) {
                        #This is the Chg column
                        #Convert 'Up/Down' to + or -
                        $text = $2;
                        $text*=-1 if $1=~/down/i;
                    }
                    #Insert the data
                    #Remove the '.X' Yahoo appends to symbol
                    if ($mode eq 'gcalldata') {
                        $calldata->[-1]->{$callheaders[$colcnt]} = $text;
                    #    $calldata->[-1]->{symbol} =~ s/\.X$//i
                    #        if $callheaders[$colcnt] eq 'symbol';
                    } else {
                        $putdata->[-1]->{$putheaders[$colcnt]} = $text;
                    #    $putdata->[-1]->{symbol} =~ s/\.X$//i
                    #        if $putheaders[$colcnt] eq 'symbol';
                    }
                    $colcnt++;
                }
            } #Getting TD
        } #Getting TR

        #Sort calls and puts by strike price
        if (not exists $calldata->[0]->{symbol}) {
            # if the option has no calls, empty the array
            $calldata = [];
        }
        if (not exists $putdata->[0]->{symbol}) {
            # if the option has no puts (e.g. CENTA as of 2009-Feb-15), empty the array
            $putdata = [];
        }
        @{$calldata} = sort { $a->{strike} <=> $b->{strike} } @{$calldata};
        @{$putdata} = sort { $a->{strike} <=> $b->{strike} } @{$putdata};

        #If this expiration already exists in $self->{data}, append
        #new data and resort, otherwise create new expiration
        CHECKDUP: {
            foreach (@{$self->{data}}) {
                if ($_->{exp} == $expdate) {
                    #Duplicate present
                    @{$_->{calls}} = sort { $a->{strike} <=> $b->{strike} }
                        (@{$_->{calls}}, @{$calldata});
                    @{$_->{puts}} = sort { $a->{strike} <=> $b->{strike} }
                        (@{$_->{puts}}, @{$putdata});
                    last CHECKDUP; #Don't add new expiration
                } #Duplicate expiration already present
            }
            #Add new expiration
            #Only executed if no duplicates expirations present
            push @{$self->{data}}, {
                exp => $expdate,
                calls => $calldata,
                puts => $putdata
            };
        }

        #Sort data by expirations
        @{$self->{data}} = sort { $a->{exp} <=> $b->{exp} } @{$self->{data}};

    } #End MAIN loop

} #End getyahoodata

#-------------------------------------------------------------------
sub getcboedata {
    require WWW::Mechanize;
    #
    # Main query page:
    # http://www.cboe.com/DelayedQuote/QuoteTable.aspx
    #
    # Get expirations from
    # http://www.cboe.com/DelayedQuote/SimpleQuote.aspx?ticker=BQQ+OH-E
    #
    # Unlike Yahoo, the main query page has *all* the options available.
    # Alas, it is lacking the expiration dates for those options.
    # We'll drill down into the individual option page to get the date.
    #
    # Right now we only do this once for each 'YY MMM' format date found
    # in the option description on the first page. We *assume* that all
    # subsequent dates of the same format have the *same* full date.
    #
    my $self = shift;
    my $q = WWW::Mechanize->new(autocheck => 0);
    $q->agent_alias('Linux Mozilla');
    $q->quiet(1);
    $q->timeout(60);
    #Set proxy if user has provided one
    $q->proxy(['http', 'ftp'], $self->proxy) if $self->proxy;

    return unless $self->symbol;
    my $sym = uc $self->symbol;

    #Hash to translate CBOE column headers to our standard hash keys
    my %xheaders = (
        bid => 'bid',
        ask => 'ask',
        last_sale => 'last',
        vol => 'volume',
        open_int => 'open',
        net => 'change'
    );

    $q->get("http://www.cboe.com/DelayedQuote/QuoteTable.aspx");
    return unless $q->success;
    $q->submit_form(
        fields    => { 'ucQuoteTableCtl:txtSymbol'  => $sym,
                'ucQuoteTableCtl:ALL' => 2 },
        button    => 'ucQuoteTableCtl:btnSubmit'
    );
    #Copy the WWW::Mechanize status to this instance
    $self->{success} = $q->success;
    $self->{status} = $q->status;
    $self->{response} = $q->response;

    return unless $q->success;

    # Output from mech-dump to get labels above:
    #  ucQuoteTableCtl:txtSymbol=     (text)
    #  ucQuoteTableCtl:chkAllExchange= (checkbox)
    #    [*/off|on/All exchange option quotes (if multiply listed)]
    #  ucQuoteTableCtl:ALL=0          (radio)
    #    [*0/List near term at-the-money options & Weeklys if avail.|
    #    2/List all options, LEAPS & Weeklys if avail. (Single page)]
    #  ucQuoteTableCtl:btnSubmit=Submit (submit)

    my $tnum;
    my $st = HTML::TokeParser->new(\$q->{content});
    my $ret;
    my ($tag,$text,$colcnt) = ('','',0);
    local ($_,$1,$2,$3,$4,$5); #Localizing special variables is recommended under mod_perl

    my @optmonths = ();
    my %months2num = qw(jan 01 feb 02 mar 03 apr 04 may 05 jun 06
        jul 07 aug 08 sep 09 oct 10 nov 11 dec 12);
    my @callheaders = ();
    my @putheaders = ();
    my $putscol = 0; #Column where puts data starts

    $st->get_tag('table'); #Jump to first table
    #Find start of data:
    HEADER: while ($st->get_tag('tr')) {
        $st->get_tag('td');
        if ($st->get_trimmed_text('/td') =~ /calls/i) {
            #Parse out the column headers
            my $mode='calls';
            while (my $tag=$st->get_tag('td','/tr')) {
                #get_tag returns undef when no more tags
                $tag=@{$tag}[0];
                last HEADER if $tag =~ /\/tr/i;
                my $text = $st->get_trimmed_text('/td');
                $text =~ s/ /_/g; #spaces to underscores
                if ($text =~ /puts/i) {
                    $mode = 'puts';
                    next;
                }
                if ($mode eq 'calls') {
                    push @callheaders,$xheaders{lc $text};
                } else {
                    push @putheaders,$xheaders{lc $text};
                }
            }
            last HEADER;
        }
    }

    #Unlike Yahoo, the main page does not have the actual
    #expiration date on it, just the YYMMM version. We are
    #going to *assume* that all YYMMM expirations are the
    #*same* actual date. The first time we hit a YYMMM date,
    #drill down into the details for that option to extract
    #the actual date and then use it for all subsequent
    #YYMMM options.
    #So, there might be a problem if there are weeklys,
    #monthlies or quarterlies present...
    #http://www.cboe.com/micro/weeklys/introduction.aspx
    my %expirations = ();
    my %tempdata = ();

    no warnings;
    ROW: while ($tag=$st->get_tag('tr','/table')) {
        #get_tag returns undef when no more tags
        $tag=@{$tag}[0];
        last ROW if $tag =~ /\/table/;
        my $mode = 'start';
        my @tmpheaders = @callheaders;
        my $call = {};
        my $put = {};
        my $exp = '';
        CELL: while ($tag=$st->get_tag('td','/tr')) {
            $tag=@{$tag}[0];
            last CELL if $tag =~ /\/tr/i;
            $text=$st->get_trimmed_text('/td');
            next ROW if $text =~ /\[img\]/i; #There's an IMG after the column headers

            #Description looks like "07 May 57.00 (IWT EE-E)"
            if ($mode eq 'start' and
                $text =~ /(\d{2} \w{3}) (\d{1,5}\.\d{2}) \((\w{1,4}) (\w{2})-(\w)\)/) {
                #Found call description
                $exp = $1;
                $call->{strike} = $2;
                $call->{symbol} = "$3$4";
                my $linksym = "$3+$4";
                my $type = $5;
                $exp =~ s/ //g; #Back-referencing variables reset on any regex

                #Check if expiration date has already been found, if not
                #drill down to option detail page to get it
                unless ($expirations{$exp}) {
                    my $det = WWW::Mechanize->new();
                    $det->agent_alias('Linux Mozilla');
                    $det->quiet(1);
                    $det->get("http://www.cboe.com/DelayedQuote/SimpleQuote.aspx?ticker=$linksym-$type");
                    #Copy the WWW::Mechanize status to this instance
                    $self->{success} = $det->success;
                    $self->{status} = $det->status;
                    $self->{response} = $det->response;
                    my $dat = HTML::TokeParser->new(\$det->{content});
                    unless ($self->{success}) {
                        #Detail lookup failed. IP address probably blacklisted
                        #Manually calc 3rd Friday of month
                        my ($tyear,$tmon) = $exp =~ /(\d{2})(\w{3})/;
                        $tyear += 2000;
                        $tmon = lc $tmon;
                        my %mon2digit = qw/jan 01 feb 02 mar 03 apr 04 may 05
                            jun 06 jul 07 aug 08 sep 09 oct 10 nov 11 dec 12/;
                        use Date::Calc;
                        #DOW is 5 for Friday, 3rd occurance
                        my ($year,$month,$day) =
                            Date::Calc::Nth_Weekday_of_Month_Year($tyear,$mon2digit{$tmon},5,3);
                        #Pad zeros to month and day
                        $month = substr(100+$month,-2);
                        $day = substr(100+$day,-2);
                        $expirations{$exp} = "$year$month$day";
                    } else {
                        #Extract date from option detail page
                        DATETABLE: while (my $tag=$dat->get_tag('table', '/table')) {
                            $tag=@{$tag}[0];
                            next DATETABLE if $tag =~ /\/table/i;
                            my $text=$dat->get_trimmed_text('/table');
                            if ($text =~ /expiration date\s*(\d{2})\/(\d{2})\/(\d{4})/i) {
                                $expirations{$exp} = "$3$1$2";
                                last DATETABLE;
                            }
                        }
                    }
                }

                $mode = 'call';
            } elsif ($mode eq 'call' and
                $text =~ /(\d{2} \w{3}) (\d{1,5}\.\d{2}) \((\w{1,4}) (\w{2})-\w\)/) {
                #Found put description
                $exp = $1 unless $exp; #Should have found it with call
                $put->{strike} = $2;
                $put->{symbol} = "$3$4";
                $exp =~ s/ //g; #Back-referencing variables reset on any regex

                $mode = 'put';
                @tmpheaders = @putheaders;
            } elsif ($mode eq 'call') {
                $call->{shift @tmpheaders} = $text;
            } elsif ($mode eq 'put') {
                $put->{shift @tmpheaders} = $text;
            } else {
                #This should never happen
                #print "ERROR parsing CBOE data!!!!\nText: $text\n";
            }
        } #Get TD

        #Move put and call to proper location using $exp
        unless ($tempdata{$exp}->{exp}) {
            #Create new expiration in %tempdata
            $tempdata{$exp}->{exp} = $expirations{$exp};
            $tempdata{$exp}->{calls} = [];
            $tempdata{$exp}->{puts} = [];
        }
        #Move hashrefs into %tempdata
        push @{$tempdata{$exp}->{calls}},$call;
        push @{$tempdata{$exp}->{puts}},$put;

    } #Get TR

    #Sort %tempdata by expiration dates and move into @{$self->{data}}
    push @{$self->{data}}, $tempdata{$_} for
        sort { $tempdata{$a}->{exp} <=> $tempdata{$b}->{exp} }
        keys %tempdata;

    #Sort puts and calls at each expiration by strike price
    for (@{$self->{data}}) {
        @{$_->{calls}} =
            sort { $a->{strike} <=> $b->{strike} }  @{$_->{calls}};
        @{$_->{puts}} =
            sort { $a->{strike} <=> $b->{strike} }  @{$_->{puts}};
    }

} #End getcboedata

1;
__END__