#!/usr/bin/perl -w # Copyright © 2000-2012 Jamie Zawinski . # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation. No representations are made about the suitability of this # software for any purpose. It is provided "as is" without express or # implied warranty. # # Generates DNA Lounge calendar pages. # Created: 29-Nov-2000. ############################################################################ # # Syntax of the calendar.txt file: # # Every DOTW from START-DATE to END-DATE # DESCRIPTION # # Every NTH DOTW from START-DATE to END-DATE # DESCRIPTION # # e.g., "every first,third friday" of each month. # "first", "second", and "third" mean the obvious thing. # "fourth" is always the 4th in the month, even if there are 5. # "last" is always the last one in the month (4th or 5th.) # "fifth" is the second-to-last one, in months that have # 5 of them (it is the "extra friday".) # # DOTM-MONTH-YEAR # DESCRIPTION # # If there is an entry for a specific date, it overrides any "Every" # entries that might also apply. If multiple "every" entries apply # to a given date, the later one in the file wins. # # Descriptions are "Markdown" (see below). Each line of a # description must be indented at least one space. # # Holiday DOTM-MONTH[-YEAR] DESCRIPTION # # Holidays whose text begins with an asterisk are assumed to be federal # holidays, meaning if it falls on a sunday or monday, we note Sunday # events as being on a 3-day weekend. # # Holiday descriptions show up over in the "Date" box. (Really # this ought to be done more automatically, but I don't know of a # command-line program that will compute those dates for me.) # # Awards EVENT-NAME # HTML # # If an event of that name exists, the "awards" HTML will be displayed # in the left column. # # Groups EVENT-NAME # HTML # # If an event of that name exists, the "groups" HTML will be appended # to it's blurb (e.g., "join the Facebook group"). # ############################################################################ # # More precisely: # # file := [ entry ]* # entry := static_event | recurring_event | holiday | # awards | groups # # static_event := day_of_month_line event_data # day_of_month_line := dotm month year '(' dotw ')' '\n' event_data # event_data := [ hspace text '\n' ]* # # recurring_event := recurrence_line [ recurring_event_data ]* range # recurrence_line := 'every' [ repeat_words ]? day_words '\n' # day_words := day_word [ ',' day_word ]* # repeat_words := nth_of_month_words | alternating_word # nth_of_month_words := nth_of_month_word [ ',' nth_of_month_word ]* # nth_of_month_word := 'first' | 'second' | 'third' | 'fourth' | # 'fifth' | 'last' # alternating_word := 'other' # (note that there is no way to express # "every 3 weeks"; one can only express # "every 3rd week of the month".) # range := 'from' range_date [ 'to' range_date ]? # range_date := dotm '-' month '-' year # recurring_event_data := hspace text '\n' # # awards := 'awards' event_name awards_data # awards_data := [ hspace text '\n' ]* # # groups := 'groups' event_name groups_data # groups_data := [ hspace text '\n' ]* # # static_event := day_of_month_line event_data # # month := 'january' | 'february' | ... | 'december' | # 'jan' | 'feb' | ... | 'dec' # dotm := '1' | '2' | ... | '31' # year := '2000' | '2001' | ... # hspace := [ ' ' | '\t' ]+ # ############################################################################ # # Examples: # # 2 January 2001 (tue) # blah blah blah # 18 January 2001 (thu) # All work and no play makes Jack a dull boy. # All work and no play makes Jack a dull boy. # # 27 feb 2001 (tue) # something else # # Every tuesday from 3-Jan-2001 # blah blah blah # # Every other friday from 3-Jan-2001 -- NOT YET IMPLEMENTED # blah blah blah # # Every first,third wednesday from 3-Jan-2001 # blah blah blah # blah blah blah # # Every fifth saturday from 3-Jan-2001 to 3-March-2001 # blah blah blah # # Holiday 02-Feb Groundhog Day # # Awards BOOTIE # Blah Blah

# Blah Blah

# # Groups BOOTIE # Join the Bootie group on Facebook. # # # Note that, in a month that has 5 Saturdays, they are numbered "first", # "second", "third", "fourth/fifth", "last", because the 5th, "extra" # Saturday goes before the "last" saturday. I think this is a pretty # stupid way to go about it, but I'm told that's how it's done. # # Specifying the day of the week on the line for static entries isn't # strictly necessary, but it functions as a checksum (we can error if # the dotm and dotw don't match.) # ############################################################################ # # Markdown in event descriptions: # # The event descriptions use an even-more-abbreviated variant of Markdown, # (http://daringfireball.net/projects/markdown/) to save typing and make # it easier to cut-and-paste things into the calendar with a minimum of # editing. Example syntax: # # [anchor](url) -- The usual Markdown way. # anchor url -- The anchor is all of the text between the URL # and the beginning of the line, except that # punctuation is left outside of the link. # [anchor] url -- The URL is placed on the bracketed text, even # if it contains punctuation. There can be other # text between the ] and the URL. # # Paragraphs are separated by blank lines. # # A paragraph of one line ending with a colon is a heading. # # A paragraph following a heading has hard line breaks. # If a line ends in a colon, it is a subheading. # Backslashes at end of line mean "no break after this line". # # Lines in such a paragraph are assumed to be "performers", # unless they are italic. Line beginning with * are bands,+ are DJs, # and - are "other". # # If the line does not begin with one of those characters, we guess # based on the heading. If the heading contains "main room", "lounge" # or "dj", the default is DJ. If it contains "performing live", the # default is band. Otherwise the default is "other". # # A paragraph not directly following a heading is not assumed to # contain "performers", and any links in it are simple A links. # Such paragraphs are also filled. # # If there are different performers with the same name, they can # be written as "Foo", "Foo|2", and "Foo|3". The part after "|" will # not be displayed, but stats will be kept separately for them. # ############################################################################ require 5; use diagnostics; use strict; use bytes; use LWP::Simple qw($ua); use LWP::UserAgent; use Text::Wrap; BEGIN { push @INC, ("utils/", "calendar/"); } use Menuify; use Markdown; # Utter foulness! Without this, [:upper:] doesn't work on Latin1 characters. use locale; use POSIX qw(locale_h mktime strftime); setlocale(LC_ALL, "en_US"); ############################################################################## # # Configuration and stuff # ############################################################################## my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.762 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; my $exec_dir = $0; $exec_dir =~ s@/[^/]*$@@; my $exec_dir2 = "$exec_dir/../utils/"; my $data_dir = $exec_dir; my $verbose = 1; my $debug_p = 0; # this means "don't alter any files, print diffs instead" my $calendar_data_file = "$data_dir/calendar.txt"; my $calendar_eventid_file = "$data_dir/ids.txt"; my $calendar_store_file = "$data_dir/tickets.txt"; my $calendar_upcoming_file = "upcoming.html"; my $calendar_overview_file = "overview.html"; my $calendar_rss_file = "dnalounge.rss"; my $calendar_ical_file = "dnalounge.ics"; my $calendar_crontab_file = "crontab.txt"; my $calendar_weekly_file = "weekly.txt"; my $calendar_weekly_prolog = "prolog.txt"; my $calendar_topten_file = "topten.txt"; my $calendar_infoline_file = "infoline.txt"; my $calendar_ledger_file = "ledger.html"; my $calendar_names_file = "names.txt"; my $calendar_eighties_file = "1985-1999.txt"; my $calendar_tickets_file = "../tickets/index.html"; my $store_file = "../store/index.html"; my $gallery_file = "../gallery/names.txt"; my $suspension_file = "suspension.html"; my $calendar_date_block_bg = "#004400"; # for the box with the date in it my $calendar_grid_dim_fg = "#666"; # de-emphasized dotms in cal overview my $fill_column = 70; # no plain-text lines longer than this # For the calendar html pages. my $page_title = "DNA Lounge Calendar"; my $url_base = "http://www.dnalounge.com/"; my $ticket_form_url = "https://cart.dnalounge.com/order/"; my $ticket_url_base = "$ticket_form_url?item="; my $vip_price = '$295'; my $age_text = '+ with ID.'; my $age_aa_text = 'all ages.'; my $xml_link_tag = " \n"; my $tickets_vip_blurb = ("Having a birthday party?\n" . "VIP table service is" . " available every night!\n" . "

\n"); my $eighties_top_blurb = ("The list of bands who have performed at DNA Lounge since we re-opened\n" . "in 2001 is well documented on our\n" . "calendar. However, DNA Lounge has existed since\n" . "1985, and I've been making an effort to document the bands that played\n" . "here before I was running things. This is the list I've been able\n" . "to construct so far.\n" . "

Clickable links below go to images of the shows'\n" . "flyers, when we have them.\n" . "(The originals of many of these flyers adorn the walls of\n" . "DNA Pizza, our restaurant\n" . "next door.)\n" . "

If you have any updates or corrections, please let\n" . "me know!\n" ); my $rss_channel_title = "DNA Lounge"; my $rss_channel_url = $url_base; my $rss_channel_desc = "Upcoming events at DNA Lounge, San Francisco."; my $rss_channel_desc2 = ("Upcoming events at DNA Lounge:\n" . "375 Eleventh Street, San Francisco.\n"); my $rss_channel_loc = "DNA Lounge: 375 Eleventh Street, San Francisco."; my $rss_latlong = "37.771007;-122.412694"; my $rss_channel_lang = "en"; my $rss_channel_tz = "US/Pacific"; my $rss_logo_url = "${url_base}logo2.gif"; my $rss_logo_width = 100; my $rss_logo_height = 33; my $rss_max_links = 200; my $overview_max_links = 10; ############################################################################## # # Data structures and stuff # ############################################################################## my %calendar = (); # keys are "YYYY-MM-DD", values are references to lists # (since there can be either one or two events per day). # elements of the lists are hashes with these keys: # # key YYYY-MM-DD or -DDb # date "dotw, dd-mmm-yy" # time as plain text # times (yyyy mm dd dotw # start_min end_min webcast_end_min) # event_ord overall event number, from start # title short title, without "presents" # title_url external URL for this event # pres the "presents" part (markdown) # repeat "Every first Monday" # holiday "Halloween" # vacationp 1 if tomorrow is a day off # flyer "flyers/YYYY/MM/DDa.html" # photos "photos-url" of this event # galleries "photos-url" of previous event # ogalleries saved copy to reset 'galleries' # age "21", "18", or "AA" # price text # genre text # tickets ("url" "desc" price onsale offsale # vip-p) # webcast "main", "lounge", "off" # video "youtube-url" # videoname "title caption for video" # markdown "raw markdown from calendar.txt" # html_out "formatted html" # text_out "formatted text" # meta_desc "For the tag" # performers ("name" "type" dup "url" ["lounge"]) # live_p marked as live: 1. # has a live band: 2. # both: 3. # hype_p whether marked for extra hype. # next_event ref to chronologically next event. # prev_event ref to chronologically prev event. # next_similar refs to next/prev events with same # prev_similar name or promoter. my @repeaters = (); # elements are lists: # # (dotw, repeat_code, repeat_desc_string, early_p, # from_year, from_month, from_dotm, # to_year, to_month, to_dotm, # lineno, event-hash) # dotw: 0-6 # repeat: 0, 1-5, -1, or -666. # the event-hash is as in %calendar my %shared_flyers = (); # keys and values are "YYYY-MM-DD" or "YYYY-MM-DDb". # for when one event re-uses the flyer of another. my %awards = (); # keys: event/promoter names, values: ("html" "text") my %groups = (); # ditto. my @future_events; # list of event hashes that lie in the future. my $yesterday_event; # the last event that didn't go on @future_events. my @event_ords; # index of events by overall event number. my %genres; # count of event genres. my %event_ids; # Links to event URLs on social network sites. # Keys are "YYYY-MM-DDb", values are "sitename=url". my %all_galleries; # title -> listref of photo galleries of past events. my %title_images; # pre-built branded event title images my %portal_dirs; # Which /tickets/TITLE/ directories exist my $total_event_count; # how many events are listed in the calendar. my $total_live_count; # how many of those were live shows. my $event_count_12mo; # how many events in the last 12 months. my $live_count_12mo; # how many of those were live shows. my $event_count_6mo; # how many events in the last 6 months. my $live_count_6mo; # how many of those were live shows. my $one_year_ago; my $six_months_ago; my $stats_cutoff; my $body_template = undef; ############################################################################## # # Date parsing and manipulation utilities # ############################################################################## my @months = ("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"); my @days = ("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"); my @days_per_month = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); # matches various forms of month names (in lower case.) # my $month_re = ('\b(?:jan(?:uary)?|feb(?:ruary)?|mar(?:ch)?|apr(?:il)?|' . 'may|june?|july?|aug(?:ust)?|sep(?:tember)?|sept|' . 'oct(?:ober)?|nov(?:ember)?|dec(?:ember)?)\b'); # matches various forms of day-of-the-week names (in lower case.) # my $days_re = ('\b(?:sun(?:day)?|mon(?:day)?|tue(?:sday)?|tues|' . 'wed(?:nesday)?|thu(?:rsday)?|thurs?|fri(?:day)?|' . 'sat(?:urday)?)\b'); # maps lower cased month names to numbers (1-12). # my %monthvals = ( 'jan' => 1, 'january' => 1, 'february' => 2, 'feb' => 2, 'march' => 3, 'mar' => 3, 'april' => 4, 'apr' => 4, 'may' => 5, 'jun' => 6, 'june' => 6, 'jul' => 7, 'july' => 7, 'august' => 8, 'aug' => 8, 'sep' => 9, 'sept' => 9, 'september' => 9, 'oct' => 10, 'october' => 10, 'nov' => 11, 'november' => 11, 'dec' => 12, 'december' => 12 ); # maps lower cased day names to numbers (0-6, sun-sat). # my %dayvals = ( 'sun' => 0, 'sunday' => 0, 'mon' => 1, 'monday' => 1, 'tue' => 2, 'tues' => 2, 'tuesday' => 2, 'wed' => 3, 'wednesday' => 3, 'thu' => 4, 'thur' => 4, 'thurs' => 4, 'thursday' => 4, 'fri' => 5, 'friday' => 5, 'sat' => 6, 'saturday' => 6 ); # Given a date, returns the day of the week on which it falls (0-6, sun-sat) # sub dotw($$$) { my ($dotm, $month, $year) = @_; # From the sci.math FAQ: # # The following formula, which is for the Gregorian calendar only, may be # more convenient for computer programming. Note that in some programming # languages the remainder operation can yield a negative result if given # a negative operand, so "mod 7" may not translate to a simple remainder. # # W == (k + [2.6m - 0.2] - 2C + Y + [Y/4] + [C/4]) mod 7 # where [] denotes the integer floor function (round down), # k is day (1 to 31) # m is month (1 = March, ..., 10 = December, 11 = Jan, 12 = Feb) # Treat Jan & Feb as months of the preceding year # C is century (1987 has C = 19) # Y is year (1987 has Y = 87 except Y = 86 for Jan & Feb) # W is week day (0 = Sunday, ..., 6 = Saturday) # # Here the century & 400 year corrections are built into the formula. # The [2.6m-0.2] term relates to the repetitive pattern that the 30-day # months show when March is taken as the first month. my $k = $dotm; my $m = 1 + (($month + 9) % 12); # (1-12) => (11, 12, 1-10) my $y = $year - ($m >= 11 ? 1 : 0); # subtract a year for jan/feb my $C = int ($y/100); my $Y = int ($y%100); my $W = (($k + int ((2.6 * $m) - 0.2) - (2 * $C) + $Y + int ($Y / 4) + int ($C / 4) + 7) % 7); return $W; } # Returns info describing a day's position in the month. # For the given date, tells you that it is, e.g., the 2nd wednesday; # and that this month contains 5 wednesdays. # sub dotw_count($$$) { my ($year, $month, $dotm) = @_; my $days = days_per_month ($month, $year); my $dotw = dotw ($dotm, $month, $year); my $index = undef; my $total = 0; my $idotw = dotw (1, $month, $year); for (my $i = 1; $i <= $days; $i++) { if ($idotw == $dotw) { $total++; $index = $total if ($i == $dotm); } $idotw = ($idotw + 1) % 7; } error ("$dotm does not occur in $month-$year?") unless ($index); error ("only $total $days[$dotw]s in $month-$year?") if ($total < 4); return ($index, $total); } # Whether the given 4-digit year is a leap year. # sub leap_year_p($) { my ($year) = @_; return ((($year % 4 == 0) && # divisible by 4 (($year % 100) || # ...unless divisble by 100 ($year % 400 == 0))) # ...and not divisible by 400 ? 1 : 0); } # Returns the number of days in the given month, considering leap years. # sub days_per_month($$) { my ($month, $year) = @_; my $days = $days_per_month[$month-1]; $days++ if ($month == 2 && leap_year_p($year)); # feb leapday return $days; } # Converts a day number to "Saturday", "Saturday Afternoon", etc. # $event_count is how many events there are on this day; # $event_number is which of those events this is. # The "evening" suffix is only used if there are multiple events, # but the "morning" and "afternoon" suffixes are used even if # there is only one event on this day. # sub describe_day($$$$) { my ($dotw, $start_minute, $event_count, $event_number) = @_; my $afternoon_threshold = (12 * 60); # noon my $evening_threshold = (17 * 60); # 5 PM my $day = $days[$dotw]; if ($event_count > 1 || $start_minute < $evening_threshold) { my $suffix = undef; if ($start_minute < $afternoon_threshold) { $suffix = "Morning"; } elsif ($start_minute < $evening_threshold) { $suffix = "Afternoon"; } elsif ($event_number > 0) { # no "Night" suffix if it's the first event (so we don't get two) $suffix = "Night"; } $day .= " $suffix" if (defined ($suffix)); } return $day; } ############################################################################## # # HTML utilities # ############################################################################## my %entity_table = ( "quot" => '"', "amp" => '&', "lt" => '<', "gt" => '>', "nbsp" => ' ', "iexcl" => '¡', "cent" => '¢', "pound" => '£', "curren" => '¤', "yen" => '¥', "brvbar" => '¦', "sect" => '§', "uml" => '¨', "copy" => '©', "ordf" => 'ª', "laquo" => '«', "not" => '¬', "shy" => '­', "reg" => '®', "macr" => '¯', "deg" => '°', "plusmn" => '±', "sup2" => '²', "sup3" => '³', "acute" => '´', "micro" => 'µ', "para" => '¶', "middot" => '·', "cedil" => '¸', "sup1" => '¹', "ordm" => 'º', "raquo" => '»', "frac14" => '¼', "frac12" => '½', "frac34" => '¾', "iquest" => '¿', "Agrave" => 'À', "Aacute" => 'Á', "Acirc" => 'Â', "Atilde" => 'Ã', "Auml" => 'Ä', "Aring" => 'Å', "AElig" => 'Æ', "Ccedil" => 'Ç', "Egrave" => 'È', "Eacute" => 'É', "Ecirc" => 'Ê', "Euml" => 'Ë', "Igrave" => 'Ì', "Iacute" => 'Í', "Icirc" => 'Î', "Iuml" => 'Ï', "ETH" => 'Ð', "Ntilde" => 'Ñ', "Ograve" => 'Ò', "Oacute" => 'Ó', "Ocirc" => 'Ô', "Otilde" => 'Õ', "Ouml" => 'Ö', "times" => '×', "Oslash" => 'Ø', "Ugrave" => 'Ù', "Uacute" => 'Ú', "Ucirc" => 'Û', "Uuml" => 'Ü', "Yacute" => 'Ý', "THORN" => 'Þ', "szlig" => 'ß', "agrave" => 'à', "aacute" => 'á', "acirc" => 'â', "atilde" => 'ã', "auml" => 'ä', "aring" => 'å', "aelig" => 'æ', "ccedil" => 'ç', "egrave" => 'è', "eacute" => 'é', "ecirc" => 'ê', "euml" => 'ë', "igrave" => 'ì', "iacute" => 'í', "icirc" => 'î', "iuml" => 'ï', "eth" => 'ð', "ntilde" => 'ñ', "ograve" => 'ò', "oacute" => 'ó', "ocirc" => 'ô', "otilde" => 'õ', "ouml" => 'ö', "divide" => '÷', "oslash" => 'ø', "ugrave" => 'ù', "uacute" => 'ú', "ucirc" => 'û', "uuml" => 'ü', "yacute" => 'ý', "thorn" => 'þ', "yuml" => 'ÿ', # HTML 4 entities that do not have 1:1 Latin1 mappings. # "bull" => "*", "hellip"=> "...", "prime" => "'", "Prime" => "\"", # "frasl" => "/", "trade" => "[tm]", "larr" => "<-", "rarr" => "->", # "harr" => "<->", "lArr" => "<=", "rArr" => "=>", "hArr" => "<=>", # "empty" => "Ø", "minus" => "-", "lowast"=> "*", "sim" => "~", # "cong" => "=~", "asymp" => "~", "ne" => "!=", "equiv" => "==", # "le" => "<=", "ge" => ">=", "lang" => "<", "rang" => ">", # "loz" => "<>", "OElig" => "OE", "oelig" => "oe", "Yuml" => "Y", # "circ" => "^", "tilde" => "~", "ensp" => " ", "emsp" => " ", # "thinsp"=> " ", "ndash" => "-", "mdash" => "--", "lsquo" => "`", # "rsquo" => "'", "sbquo" => "'", "ldquo" => "\"", "rdquo" => "\"", # "bdquo" => "\"", "lsaquo"=> "<", "rsaquo"=> ">", ); my %entity_table2; # maps Latin1 back to Entities foreach (keys (%entity_table)) { $entity_table2{$entity_table{$_}} = $_; } my %asciify_table = ( '¡' => '!', '¢' => '[c]', '£' => '#', '¤' => '#', '¥' => 'Y', '¦' => '|', '§' => 'SS', '¨' => '_', '©' => '(c)', 'ª' => '?', '«' => '<<', '¬' => '=', '­' => '-', '®' => '(r)', '¯' => '_', '°' => '[?]','±' => '+/-', '²' => '[2]', '³' => '[3]', '´' => '\'', 'µ' => 'u', '¶' => 'PP', '·' => '.', '¸' => ',', '¹' => '[1]', 'º' => '[o]','»' => '>>', '¼' => ' 1/4 ', '½' => ' 1/2 ', '¾' => ' 3/4 ', '¿' => '?', 'À' => 'A', 'Á' => 'A', 'Â' => 'A', 'Ã' => 'A', 'Ä' => 'A', 'Å' => 'A', 'Æ' => 'AE', 'Ç' => 'C', 'È' => 'E', 'É' => 'E', 'Ê' => 'E', 'Ë' => 'E', 'Ì' => 'I', 'Í' => 'I', 'Î' => 'I', 'Ï' => 'I', 'Ð' => 'D', 'Ñ' => 'N', 'Ò' => 'O', 'Ó' => 'O', 'Ô' => 'O', 'Õ' => 'O', 'Ö' => 'O', '×' => 'x', 'Ø' => '0', 'Ù' => 'U', 'Ú' => 'U', 'Û' => 'U', 'Ü' => 'U', 'Ý' => 'Y', 'Þ' => 'p', 'ß' => 'S', 'à' => 'a', 'á' => 'a', 'â' => 'a', 'ã' => 'a', 'ä' => 'a', 'å' => 'a', 'æ' => 'ae', 'ç' => 'c', 'è' => 'e', 'é' => 'e', 'ê' => 'e', 'ë' => 'e', 'ì' => 'i', 'í' => 'i', 'î' => 'i', 'ï' => 'i', 'ð' => 'o', 'ñ' => 'n', 'ò' => 'o', 'ó' => 'o', 'ô' => 'o', 'õ' => 'o', 'ö' => 'o', '÷' => '/', 'ø' => 'o', 'ù' => 'u', 'ú' => 'u', 'û' => 'u', 'ü' => 'u', 'ý' => 'y', 'þ' => 'p', 'ÿ' => 'y' ); # Converts any Latin1 characters to HTML entities. # Also converts &, < and > to entities. # sub entitify($) { my ($s) = @_; $s =~ s/([&<>\"\177-\377])/ { my $ent = $entity_table2{$1}; error ("no entity for character: $1\n") unless (defined ($ent)); print STDERR "$progname: $1 -> $ent\n" if ($verbose > 4); "&$ent;"; }/xegs; return $s; } # Convert any HTML entities to Latin1 characters. # sub de_entify($) { my ($text) = @_; $text =~ s@&(\#)?([a-z\d]+);?@{ my ($n, $c) = ($1, $2); if ($n) { $c = hex($c) if ($c =~ s/^x//s); ($c > 255 ? "[$c]" : chr($c)); } else { $c = $entity_table{$2}; print STDERR "$progname: warning: unknown HTML entity \"$1\"\n" unless $c; ($c ? $c : "[$2]"); } }@gsexi; return $text; } # Converts any Latin1 characters to the closest ASCII equivalent. # Note that you probably also need to convert & to & # sub asciify($) { my ($s) = @_; $s =~ s/([\177-\377])/ { my $asc = $asciify_table{$1}; error ("no ASCII for character: $1\n") unless (defined ($asc)); print STDERR "$progname: $1 -> $asc\n" if ($verbose > 4); $asc; }/xegs; return $s; } # Upcase the *text* in the HTML string, being careful not to touch # tags and to do the right thing with character entities. # sub upcase_html($) { my ($str) = @_; $str =~ s/( <[^<>]*> | &[\#a-z\d]+; )/\001$1\001/gsix; my @segs = split (/\001/, $str); foreach my $s (@segs) { if ($s =~ m/^[ \t]*\n?//gs; $html =~ s/^\s+|\s+$//gs; # leading/trailing whitespace in document $html =~ s/^[ \t]+|[ \t]+$//gm; # leading/trailing whitespace on line $html =~ s/[ \t]+/ /gm; # horizontal to single space # convert

and

to simply

1 while ($html =~ s@\s*( to simply # convert
to simply 1 while ($html =~ s@\s*(,
,

or ; sometimes SPC renders. $html =~ s@\s*(]*>)\s*@$1@igs; # This is perhaps risky. However, it looks like Hotmail converts #

to
, so let's use

instead. $html =~ s@

@

@gsi; return $html; } ############################################################################## # # Parsing the calendar.txt file # ############################################################################## sub parse_calendar_entry($$@) { my ($lineno, $fast_p, @lines) = @_; $_ = $lines[0]; if (m/^(\d\d?)[-\s]+($month_re)[-\s]/io) { # "3-Jan-2001" parse_static_entry ($lineno, $fast_p, @lines); } elsif ( m/^EVERY\s+/io ) { # "Every Nth X" parse_repeating_entry ($lineno, $fast_p, @lines); } elsif ( m/^HOLIDAY\s+/io ) { # "Holiday 2-Feb" parse_holiday_entry ($lineno, @lines); } elsif ( m/^AWARDS\s+/io ) { # "Awards NAME" parse_awards_entry ($lineno, 0, @lines); } elsif ( m/^GROUPS\s+/io ) { # "Groups NAME" parse_awards_entry ($lineno, 1, @lines); } else { error ("$lineno: unparsable calendar entry heading: $_"); } } my $prev_year = 0; # for detecting misordered entries when parsing my $prev_month = 0; # (which usually means cut-and-paste went wrong.) my $prev_dotm = 0; sub parse_static_entry($$@) { my ($lineno, $fast_p, @lines) = @_; my $slineno = $lineno; $_ = shift @lines; if (! m/^(\d\d?) [-\s]+ ($month_re) [-\s]+ (\d{4}) \s* \(?($days_re)?\)? \s* (\bEARLY)? \s* $/iox ) { error ("$lineno: unparsable DD-MMM-YYYY line: $_\n"); } my $dotm = 0 + $1; my $month = $2; my $year = 0 + $3; my $dotw = $4; my $early_p = (defined($5) && $5 =~ m/^early$/si); $month = $monthvals{lc($month)}; $dotw = $dayvals{lc($dotw)} if defined($dotw); error ("$lineno: year $prev_year preceeds $year!\n") if ($prev_year > $year); error ("$lineno: $months[$prev_month-1] $prev_year preceeds " . "$months[$month-1] $year!\n") if ($prev_year == $year && $prev_month > $month); error ("$lineno: $prev_dotm-$months[$prev_month-1]-$prev_year preceeds " . "$dotm-$months[$month-1]-$year!\n") if ($prev_year == $year && $prev_month == $month && $prev_dotm > $dotm); my $real_dotw = dotw ($dotm, $month, $year); if (defined ($dotw)) { error ("$lineno: $dotm-$months[$month-1]-$year is a " . "$days[$real_dotw], not a $days[$dotw]") if ($real_dotw != $dotw); } else { $dotw = $real_dotw; my $m = $months[$month-1]; $m =~ s/^(...).*$/$1/; my $d = $days[$dotw]; $d =~ s/^(...).*$/$1/; print STDERR ("$progname: $lineno: $dotm-$m-$year: " . "dotw unspecified (should be $d)\n"); } $lineno++; $prev_year = $year; $prev_month = $month; $prev_dotm = $dotm; my $entry = ""; while ($#lines >= 0) { my $line = shift @lines; $line =~ s/^\s+//; $entry .= "\n$line"; } my $event = parse_calendar_html ($dotm, $month, $year, $early_p, $slineno, $entry, $fast_p); my $key = $event->{key}; error ("$lineno: duplicate event: $key") if (defined($calendar{$key})); $calendar{$key} = $event; # Now that the start and end times are filled in, check to see if # events are correctly marked as daytime / nighttime. # if (! $fast_p) { my ($year, $month, $dotm, $dotw, $start_minute, $end_minute) = @{$event->{times}}; my $start_hour = int($start_minute / 60); my $end_hour = int($end_minute / 60); # If the event is over by 11pm, then it counts as a "daytime" event, # because we could conceivably have a second event after it. my $e_early_p = ($end_hour <= 23); if ($early_p ne $e_early_p && $event->{title} !~ m/^CLOSED$/si) { my $t = $event->{title}; my $mm = $months[$month-1]; $mm =~ s/^(...).*$/$1/s; print STDERR "$lineno: $dotm-$mm-$year ($t)" . ($e_early_p ? " should be an early event but isn't!" : " is marked as an early event but isn't!") . "\n"; } } if ($verbose > 3) { $_ = $entry; s/\\/\\\\/g; s/\"/\\\"/g; s/\n/\\n/g; s/^(.{20}).*$/$1.../; print STDERR "$progname: $slineno: stored $key = \"$_\"\n"; } } sub parse_repeating_entry($$@) { my ($lineno, $fast_p, @lines) = @_; my $desc = shift @lines; my $entry_html = ""; foreach (@lines) { s/^\s+//; $entry_html .= "$_\n"; } my $repeat_words = "(?:first|second|third|fourth|fifth|last|" . "1st|2nd|3rd|4th|5th)"; my $alter_words = "(?:other)"; if ($desc =~ m/^every\s+ ($alter_words)?\s* ($repeat_words(?:\s*,\s*$repeat_words)*)?\s* ((?:$days_re)(?:\s*,\s*(?:$days_re))*)\s* (early)?\s* (?:from\s+(.*?))?\s* (?:to\s+(.*?))?\s* $/xio) { my $alts = $1 || ''; my $reps = $2 || ''; my $days = $3; my $early_p = $4 ? 1 : 0; my $from = $5; my $to = $6; my $from_year = -1; my $from_month = -1; my $from_day = -1; my $to_year = 9999; my $to_month = 99; my $to_day = 99; if ($alts ne '' && $reps ne '') { error ("$lineno: can't specify 'other' along with repetition: $desc\n"); } if ($from) { if ($from =~ m/^(\d\d?)\s*[-\s]\s*($month_re)\s*[-\s]\s*(\d\d\d\d)/io) { $from_day = 0 + $1; $from_month = $monthvals{lc($2)}; $from_year = 0 + $3; } else { error ("$lineno: unparsable from date: \"$from\"" . " (should be DD-MMM-YYYY)\n"); } } if ($to) { if ($to =~ m/^(\d\d?)\s*[-\s]\s*($month_re)\s*[-\s]\s*(\d\d\d\d)/io) { $to_day = 0 + $1; $to_year = 0 + $3; $_ = $2; tr/A-Z/a-z/; $to_month = $monthvals{$_}; } else { error ("$lineno: unparsable to date: \"$to\"" . " (should be DD-MMM-YYYY)\n"); } } $from_year = 0 unless defined($from_year); $from_month = 0 unless defined($from_month); $from_day = 0 unless defined($from_day); $to_year = 9999 unless defined($to_year); $to_month = 13 unless defined($to_month); $to_day = 32 unless defined($to_day); my $rdesc = "Every"; my @values = (); if ($alts ne '') { # this can only be "every other DOTW". push @values, -666; $rdesc .= " Other"; } else { my @rdescs = (); foreach my $rep (split(/,/, $reps)) { $rep =~ s/^\s+//; $rep =~ s/\s+$//; if ($rep =~ m/^(first|1st)$/i) { push @values, 1; push @rdescs, "1st"; } elsif ($rep =~ m/^(second|2nd)$/i) { push @values, 2; push @rdescs, "2nd"; } elsif ($rep =~ m/^(third|3rd)$/i) { push @values, 3; push @rdescs, "3rd"; } elsif ($rep =~ m/^(fourth|4th)$/i) { push @values, 4; push @rdescs, "4th"; } elsif ($rep =~ m/^(fifth|5th)$/i) { push @values, 5; push @rdescs, "5th"; } elsif ($rep =~ m/^last$/i) { push @values, -1; push @rdescs, "Last"; } else { error ("$lineno: INTERNAL ERROR: unknown repeater: $rep\n"); } } $_ = join (", ", @rdescs); s/^(.*), ([^,]+)$/$1 and $2/; $rdesc .= " $_"; } push (@values, 0) if ($#values < 0); { my @rdescs = (); foreach (split(/,/, $days)) { s/^\s+//; s/\s+$//; tr/A-Z/a-z/; push @rdescs, $days[$dayvals{$_}]; } $_ = join (", ", @rdescs); s/^(.*), ([^,]+)$/$1 and $2/; $rdesc .= " $_"; } $rdesc =~ s/\s+/ /gs; foreach (split(/,/, $days)) { s/^\s+//; s/\s+$//; tr/A-Z/a-z/; my $day = $dayvals{$_}; foreach my $code (@values) { my $entry_hash = parse_calendar_html (undef, undef, undef, 0, $lineno, $entry_html, $fast_p); my @val = ($day, $code, $rdesc, $early_p, $from_year, $from_month, $from_day, $to_year, $to_month, $to_day, $lineno, $entry_hash); push @repeaters, \@val; if ($verbose > 3) { $_ = $entry_html; s/\\/\\\\/g; s/\"/\\\"/g; s/\n/\\n/g; my $d = $days[$day]; my $w = ($code == 0 ? "" : $code == 1 ? "1st " : $code == 2 ? "2nd " : $code == 3 ? "3rd " : $code == 4 ? "4th " : $code == 5 ? "5th " : $code == -1 ? "Last " : $code == -666 ? "Other " : "<>"); $d =~ s/^(...).*/$1/; s/^(.{20}).*$/$1.../; print STDERR "$progname: $lineno: stored ". sprintf ("%04d-%02d-%02d%s - %04d-%02d-%02d%s", $from_year, $from_month, $from_day, ($early_p ? 'a' : ''), $to_year, $to_month, $to_day, ($early_p ? 'a' : '')) . " Every $w$d = \"$_\" (\"$rdesc\")\n" } } } } else { error ("$lineno: unparsable repeating entry: $desc\n"); } } sub parse_holiday_entry($@) { my ($lineno, @lines) = @_; my $entry = shift @lines; shift @lines while ($#lines != -1 && $lines[0] eq ''); error ("$lineno: multi-line holiday?") if ($#lines != -1); $entry =~ s/\s*\#.*$//s; if (! ($entry =~ m/^[a-z]+\s+(\d\d?)[-\s]+($month_re)([-\s]+(\d{4}))?\s*(.*)$/i)) { error ("$lineno: unparsable holiday line: $entry\n"); } my $dotm = 0 + $1; my $month = $2; my $year = defined($4) ? (0 + $4) : 0; my $desc = $5; $month =~ tr/A-Z/a-z/; $month = $monthvals{$month}; my $key = sprintf ("%04d-%02d-%02d-H", $year, $month, $dotm); $calendar{$key} = $desc; print STDERR "$progname: $lineno: stored $key = \"$desc\"\n" if ($verbose > 3); } sub parse_awards_entry($$@) { my ($lineno, $groups_p, @lines) = @_; my $tag = ($groups_p ? "GROUPS" : "AWARDS"); my ($name) = ($lines[0] =~ m/^\s*${tag}\s+(.*?)\s*$/si); error ("unparsable $tag line: $lines[0]") unless $name; $name = lc($name); shift @lines; my $entry = join("\n", @lines); $entry =~ s/[ \t]*\#.*$//m; my ($html, $text) = DNA::Markdown::markdown_to_html ($lineno, $entry, 1, 1); # Fix punctuation around URLs, bleh. $text =~ s@(\s+https?://[^\s\[\]()<>\"\']+[a-z\d/])([!:])@$2$1@gsi; $text =~ s@[!]( https?:)@:$1@gsi; my @p = ($html, $text); if ($groups_p) { $groups{$name} = \@p; } else { $awards{$name} = \@p; } print STDERR "$progname: $lineno: $tag $name = $text\n" if ($verbose > 3); } sub find_awards($$$$) { my ($pres, $title, $html_p, $groups_p) = @_; $title =~ s/<[^<>]*>/ /gsi; $title =~ s/:\s+.*$//s; $title =~ s/^\s+|\s+$//gsi; $title = lc($title); my $result = $groups_p ? $groups{$title} : $awards{$title}; if (! $result) { $pres = '' unless $pres; $pres =~ s/<[^<>]*>/ /gsi; $pres =~ s/\s+presents?:?\s*$//si; $pres =~ s/&/&/gsi; $pres =~ s/,?\s*(\band\b|&)/,/gsi; $pres = lc($pres); foreach my $p (split (/,/, $pres)) { $p =~ s/^\s+|\s+$//gsi; $result = $groups_p ? $groups{$p} : $awards{$p}; last if $result; } } if ($result) { my ($html, $text) = @$result; return ($html_p ? $html : $text); } return undef; } # The old style of naming event IDs was: # # early event, no late event: YYYY-MM-DD # late event, no early event: YYYY-MM-DD # both: YYYY-MM-DD early, YYYY-MM-DDb late. # # That caused the event IDs to change if we booked a late event, then # later added an early event. (But not vice versa). # # So the new style, which results in stable event IDs, is: # # early event, no late event: YYYY-MM-DDa # late event, no early event: YYYY-MM-DD # both: YYYY-MM-DDa early, YYYY-MM-DD late. # # So early events end in "a" even if there is no late event, and late # events never end in "b" even if there is an early event. Adding them # in either order doesn't affect either URL. # # But, to avoid renaming a whole bunch of files and breaking old URLs, # there's a flag day. Events before the flag day use the old style URLs, # and new events use the new style URLs. That flag day is 6-Mar-2011, # which is the date of the latest extant flyer that used the old-style # naming scheme. # sub new_style_anchors_p($) { my ($key) = @_; my ($yyyy, $mm, $dd) = ($key =~ m/^(\d{4})-(\d{2})-(\d{2})[ab]?$/s); my $flagday = 20110306; # 6-Mar-2011 return ($yyyy * 10000 + $mm * 100 + $dd > $flagday); } # Parse the HTML into the various fields in the event hash; # returns a hash describing this event. # sub parse_calendar_html($$$$$$$) { my ($dotm, $month, $year, $early_p, $lineno, $body, $fast_p) = @_; $body =~ s/^\s*//s; my $key; if (defined($dotm)) { $key = sprintf ("%04d-%02d-%02d", $year, $month, $dotm); if (new_style_anchors_p($key)) { $key .= "a" if $early_p; } else { if (defined($calendar{$key})) { # If the target date has two entries, aim the at early or late one. $key .= "b"; # already an event on this day error ("$key: three events") if defined($calendar{$key}); } } } error ("$lineno: non-ASCII character ($1)") if ($body =~ m/([^\s -}])/s); my $static_p = defined ($dotm); my $markdown = $body; my $title = $1 if ($markdown =~ s/^(.+?)\n\n//s); if (! $title) { $title = $markdown; $markdown = ''; } my $headers = $1 if ($markdown =~ s/^(.+?)\n(\n|$)//s); $headers = '' unless $headers; if ($headers && !$markdown && $headers !~ m/^\s*(<|[A-Z]+:)/s) { $markdown = $headers; $headers = ''; } ($title) = DNA::Markdown::markdown_to_html ($lineno, $title, 1, 0); $title =~ s/\s+/ /gs; my $pres = $1 if ($title =~ s@^(.* \b presents? ) \b \s+ @@six); my $title_url = $1 if ($title =~ s@\s*(.*?)\s*@$2@si); $title =~ s/\s+/ /gsi; $title = de_entify($title); { my $h2 = ''; foreach my $line (split(/\n/, $headers)) { if ($line =~ m/^[A-Z][A-Z][A-Z]+:[ \t]/s) { $h2 .= "\n$line"; } else { $h2 .= " $line"; } } $headers = $h2; } my ($time) = ($headers =~ m@^\s* TIME: \s* (.*?) \s* $@mix); my ($age) = ($headers =~ m@^\s* AGE: \s* (.*?) \s* $@mix); my ($genre) = ($headers =~ m@^\s* GENRE: \s* (.*?) \s* $@mix); my ($price) = ($headers =~ m@^\s* PRICE: \s* (.*?) \s* $@mix); my ($flyer) = ($headers =~ m@^\s* FLYER: \s* (.*?) \s* $@mix); my ($video) = ($headers =~ m@^\s* VIDEO: \s* (.*?) \s* $@mix); my ($live_p) = ($headers =~ m@^\s* LIVE: \s* (.*?) \s* $@mix); my ($webcast) = ($headers =~ m@^\s* WEBCAST: \s* (.*?) \s* $@mix); my ($hype_p) = ($live_p && $live_p =~ m/^HYPE$/s); $live_p = ($live_p ? 1 : 0); # it's a bit-field, kinda. foreach my $val ($time, $genre, $price) { ($val) = DNA::Markdown::markdown_to_html ($lineno, $val, 1, 0) if $val; } my ($html_out, $text_out, $performers) = DNA::Markdown::markdown_to_html ($lineno, $markdown, 0, 0) if $markdown; $html_out = '' unless $html_out; update_performer_stats ($lineno, $key, $performers) if ($static_p && !$fast_p); if ($static_p && $flyer) { parse_shared_flyer ($key, $lineno, $flyer); $flyer = undef unless ($flyer =~ m/^NONE$/si); } if ($genre) { my $gg = $genre; $gg =~ s/<[^<>]+>/ /gs; $gg =~ s/\s+/ /gs; $gg =~ s/\s*\.*\s*$//gs; $gg = de_entify($gg); my @g = split (m/\. +/, $gg); # normalize the nine billion names of house. my %gg; foreach my $g (@g) { $g =~ s/^.* (house)$/$1/i unless ($g =~ m/\bacid\b/i); $g = "breaks" if ($g =~ m/break|broken/i); $g = "gothic" if ($g =~ m/deathrock|dark retro/i); $g = "industrial" if ($g =~ m/\bebm\b|industrialize/i); $g = "mashups" if ($g =~ m/bastard pop|remix|mashup|mash-?up/i); $g = "80s" if ($g =~ m/^80s/i); $gg{$g} = 1; } @g = keys (%gg); foreach my $g (@g) { $genres{$g} = 1 + ($genres{$g} || 0); } } if (!$webcast) { $webcast = 'main'; } elsif ($webcast =~ m/^(main|lounge|off)$/si) { $webcast = lc($webcast); } else { error ("$lineno: unknown WEBCAST: $webcast"); } my $video_url; if ($video) { $video = DNA::Markdown::fix_naked_ampersand($video); $video_url = $1 if ($video =~ s@\s*\b(https?:[^\s]+[a-z\d/])\s*@@gsi); error ("no URL in VIDEO: $video") unless $video_url; error ("no title in VIDEO: $video") unless ($video =~ m/[a-z]/i); } foreach my $p (@$performers) { my ($name, $type) = @$p; if ($type eq 'BAND') { $live_p |= 2; last; } } $headers =~ s/^(TIME|AGE|GENRE|PRICE|FLYER|VIDEO|LIVE|WEBCAST|HYPE) :[^\n]*(\n|$)//gmx; error ("$lineno: junk in headers: $headers") if ($headers =~ m/[^\s]/s); my %hash = (); $hash{key} = $key; $hash{title} = $title; $hash{title_url} = $title_url; $hash{pres} = $pres; #$hash{repeat} = $repeat; # computed in parse_calendar_event_final #$hash{holiday} = $holiday; # computed in parse_calendar_event_final #$hash{vacationp} = $vacationp; # computed in parse_calendar_event_final $hash{time} = $time; $hash{age} = $age; $hash{price} = $price; $hash{genre} = $genre; $hash{webcast} = $webcast; $hash{video} = $video_url; $hash{videoname} = $video; $hash{markdown} = $markdown; $hash{html_out} = $html_out; $hash{text_out} = $text_out; $hash{performers}= $performers; $hash{hype_p} = $hype_p; $hash{live_p} = $live_p; $hash{flyer} = $flyer; # fill in some more fields now, if we can. parse_calendar_html_2 (\%hash, $dotm, $month, $year) if (defined ($dotm)); return \%hash; } # Some parsing we can only do once we're sure of the exact date of the # event. We know this right away for static events, but only later for # repeating events. # sub parse_calendar_html_2($$$$) { my ($eventref, $dotm, $month, $year) = @_; my $dotw = dotw ($dotm, $month, $year); my $monstr = $months[$month-1]; $monstr =~ s/^(...).*$/$1/; my $date = "$days[$dotw], $dotm $monstr $year"; my $time = $eventref->{time} || ''; my ($start_minute, $end_minute, $webcast_end_minute) = extract_hours ($time, $dotw); my @time_list = ($year, $month, $dotm, $dotw, $start_minute, $end_minute, $webcast_end_minute); $eventref->{date} = $date; # altered in parse_calendar_event_final $eventref->{times} = \@time_list; return $eventref; } # After the whole calendar has been parsed, fill in some fields in the # event hashes that we can't know until we've seen everything. # E.g., we can't know if there are multiple events on the given day # until after we've seen all of them. # sub parse_calendar_event_final($$$$) { my ($event, $known_repeater, $early_p, $real_event_p) = @_; my $key = $event->{key}; my $title = $event->{title}; my $times = $event->{times}; my $date = $event->{date}; my ($year, $month, $dotm, $dotw, $start_minute) = @$times; if (! defined($key)) { # This is a repeating event. $key = sprintf ("%04d-%02d-%02d", $year, $month, $dotm); if (new_style_anchors_p($key)) { $key .= 'a' if $early_p; } else { if (defined ($calendar{$key}) || defined ($calendar{$key . "a"})) { # there is already a daytime event $key .= "b"; } } $event->{key} = $key; } my $nevents = 1; my $event_number = 0; if (new_style_anchors_p($key)) { if ($key =~ m/^(\d{4}-\d\d-\d\d)a$/s && defined($calendar{$1})) { $early_p = 1; $event_number = 0; $nevents = 2; } elsif ($key =~ m/^(\d{4}-\d\d-\d\d)$/s && defined($calendar{$1 . "a"})) { $early_p = 0; $event_number = 1; $nevents = 2; } } else { if ($key =~ m/^\d{4}-\d\d-\d\da$/s || defined($calendar{$key . "b"})) { $early_p = 1; $event_number = 0; $nevents = 2; } elsif ($key =~ m/^\d{4}-\d\d-\d\db$/s || defined($calendar{$key . "a"})) { $early_p = 0; $event_number = 1; $nevents = 2; } } $event->{flyer} = find_flyer ($event); $event->{photos} = find_photo ($event); $event->{photos} = find_photo ($event); { my $g = find_galleries ($event); my @g = ($g ? @$g : ()); $event->{galleries} = $g; $event->{ogalleries} = \@g; # ref to copy of list } ####################################################################### # Update the day of the week to, e.g., "Sunday Morning" if appropriate. ####################################################################### # Compute the appropriate description of this (time of) day... my $day = describe_day ($dotw, $start_minute, $nevents, $event_number); # Splice it back in, and store the result back in the hash. $date =~ s/($days_re)/$day/i; $event->{date} = $date; ####################################################################### # Decide whether this event is a holiday, or just before a holiday. ####################################################################### my $holiday = lookup_holiday ($year, $month, $dotm); my $monday_off_p = (defined($holiday) && $holiday =~ m/^\*/); # Mark the sunday of 3 day weekends as holidays, too, if the # holiday on the sunday or adjascent monday are federal. # if ($dotw == 0 && # today is sunday !($month == 12 && $dotm == 30) # not day-before-NYE ) { if (!defined ($holiday)) { $holiday = lookup_holiday_tomorrow ($year, $month, $dotm); $monday_off_p = (defined($holiday) && $holiday =~ m/^\*/); # Tomorrow is a holiday, but not a federal holiday. Darn. $holiday = undef unless ($monday_off_p); } # Only mention "3 day weekend" on the last event of the day. $holiday = undef unless ($event_number == $nevents-1); if (defined ($holiday)) { $holiday =~ s/^\*//s; if ($monday_off_p) { $holiday = "3 Day Weekend: $holiday"; $event->{vacationp} = 1; } } } if (defined ($holiday)) { $holiday =~ s/^\*//sx; # take off Fed marker $event->{holiday} = $holiday; } ####################################################################### # determine whether this is a repeating event. ####################################################################### if ($known_repeater) { $event->{repeat} = $known_repeater; } else { my ($dotw_number, $total_dotws) = dotw_count ($year, $month, $dotm); # my $early_p = ($nevents > 1 && $event_number == 0); my $repeater = lookup_repeating_entry ($year, $month, $dotm, $early_p, $dotw, $dotw_number, $total_dotws); if (defined ($repeater)) { my $rtitle = $repeater->{title}; my $etitle = $title; $etitle =~ s/: +.*$//s; # lose subtitle after colon error ("unparsable event name in repeater: $repeater") unless ($rtitle); if ($rtitle eq $etitle) { print STDERR "$progname: $title repeats: $title\n" if ($verbose > 3); $event->{repeat} = $repeater->{repeat}; } } } ####################################################################### # What event number is this, and how many events are there? # # Note that this does not see "repeating" events that are visible # in the calendar, but do not yet have "real" data filled in. # So the event ordinals will change as those get filled in. ####################################################################### if ($real_event_p && !($event->{title} =~ m/^\(?CLOSED|CANCELL?ED|SUSPENDED\)?$/si)) { $event->{event_ord} = $total_event_count; $event_ords[$total_event_count] = $event; my $dd = $year * 10000 + $month * 100 + $dotm; $total_event_count++; $event_count_12mo++ if ($dd > $one_year_ago && $dd <= $stats_cutoff); $event_count_6mo++ if ($dd > $six_months_ago && $dd <= $stats_cutoff); if ($event->{live_p}) { $total_live_count++; $live_count_12mo++ if ($dd > $one_year_ago && $dd <= $stats_cutoff); $live_count_6mo++ if ($dd > $six_months_ago && $dd <= $stats_cutoff); } } } # Sort the two calendar IDs chronologically. # This is tricky because of the event-id Flag Day. # sub calendar_id_cmp($$) { my ($a, $b) = @_; foreach ($a, $b) { $_ .= (new_style_anchors_p($_) ? 'b' : 'a') if (m/\d$/s); } return ($a cmp $b); } # After everything has been parsed, populate next_event, next_similar, etc. # sub link_event_lists() { my $prev = undef; my %prev_names; foreach my $key (sort calendar_id_cmp (keys %calendar)) { next unless ($key =~ m/^\d{4}-\d\d-\d\d([ab])?$/); my $event = $calendar{$key}; my $title = $event->{title}; next if ($title =~ m/^\(?CLOSED|CANCELL?ED|SUSPENDED\)?$/si); # Bidirectional chronological links. # $event->{prev_event} = $prev; $prev->{next_event} = $event if $prev; $prev = $event; # Bidirectional topical links. # $title = lc (asciify (de_entify ($title))); $title =~ s/<[^<>]*>/ /gsi; $title =~ s/:\s+.*$//s; $title =~ s/^\s+|\s+$//gsi; my $pres = $event->{pres} || ''; $pres = lc (asciify (de_entify ($pres))); $pres =~ s/<[^<>]*>/ /gsi; $pres =~ s/\s+presents?:?\s*$//si; $pres = "$title,$pres"; $pres =~ s/,?\s*(\band\b|&|\+)\s+/,/gsi; my @names = (); foreach my $p (split (/,/, $pres)) { $pres = lc (asciify ($pres)); $p =~ s/\s+/ /gsi; $p =~ s/^\s+|\s+$//gsi; push @names, $p; } foreach my $name (@names) { my $p = $prev_names{$name}; $prev_names{$name} = $event; next unless $p; next if ($p eq $event); my $op = $event->{next_similar}; # If this event already has a next_similar, replace it if this # one is chronologically earlier. # next if ($op && calendar_id_cmp ($op->{key}, $p->{key}) >= 0); $p->{next_similar} = $event if $p; $event->{prev_similar} = $p; } } } # Extracts and returns the starting and ending time of the event from # its textual description, measured in minutes past midnight. Handles # "after hours", and adds heuristic slop based on the day of the week. # sub extract_hours($$$) { my ($text, $dotw) = @_; my ($start, $end); $text =~ s@<[^<>]*>@ @gsi; my $otext = $text; # Correct typo. error ("missing AM/PM: \"$1\"") if ($text =~ m@(\d\d?(:\d\d)?\s+(door|show))@si); # first look for something of these forms: # # 8pm - 2am # midnight - 1AM # 10 pm - after hours # while ($text =~ m/ (.*?) \b\s* ((\d\d?(:\d\d)?)? \s* ([AP]\.?M\.?|noon|midnight|midnite)) \s*-\s* ([[:alnum:]:.]+) \b(.*) $/xsi) { my $start1 = $2; my $end1 = $6; $text = "$1; $7"; $start1 = parse_hour ($start1, 0); next unless defined ($start1); $end1 = parse_hour ($end1, 1); next unless defined ($end1); if (defined($start1) && defined($end1)) { $start = $start1; $end = $end1; last; } } # Override the start time by looking for something like this: # # doors @ 7pm; show @ 8pm; # doors at 7pm; show at 8pm; # doors: 7pm; show: 8pm; # # If all we have is this "doors" form, assume end time is 2AM. # $text = $otext; while ($text =~ m/ (.*?) \b\s* doors:? \s+ (\@|at)? \s* ((\d\d?(:\d\d)?)? \s* ([AP]\.?M\.?|noon|midnight|midnite)) \b(.*) $/xsi) { my $start1 = $3; $text = "$1; $7"; $start1 = parse_hour ($start1, 0); next unless defined ($start1); $start = $start1; if (!defined($end)) { if ($start < (60 * 18)) { # starts before 6pm... $end = (60 * 23); # guess end time of 11pm. } else { # starts after 6PM... $end = (60 * 2); # guess end time of 2am. } last; } } # if that didn't work, at least try to find a start time... # if (!defined ($start)) { $text = $otext; while ($text =~ m/ \b\s* ((\d\d?(:\d\d)?)? \s* ([AP]\.?M\.?|noon|midnight|midnite)) \b(.*) $/xsi) { my $start1 = $1; $text = $5; $start1 = parse_hour ($start1, 0); next unless defined ($start1); if (defined($start1)) { $start = $start1; last; } } } $start = (60 * 22) unless defined($start); # default to 10pm $end = (60 * 3) unless defined($end); # default to 3am my $webcast_end = $end; my $weekend_p = ($dotw == 5 || # fri $dotw == 6 || # sat $dotw == 0 # sun (treat sunday as a weekend, since we # are usually only open on sunday if # it's a three day weekend.) ); if ($end eq 'LATE') { if ($weekend_p) { $end = (60 * 5) + 30; # on weekends, "after hours" means 5:30 AM } else { $end = (60 * 4) + 30; # on week nights, "after hours" means 4:30 AM } $webcast_end = $end; } else { # # If an explicit end time was listed in the calendar, add some slack onto # that for the webcast. Add half and hour on weeknights, and an hour on # the weekend. Or an hour and a half if it's a weekend set to end at 3am # or earlier. if (!$weekend_p) { # weeknight $webcast_end += 30; } elsif ($end <= (60 * 3)) { # <= 3AM on weekend $webcast_end += 90; } else { # > 3AM on weekend $webcast_end += 60; } } $end += (60 * 24) if ($end < $start); # end is "tomorrow" $webcast_end += (60 * 24) if ($webcast_end < $start); error("INTERNAL ERROR: end>webcast_end: $end, $webcast_end") if ($end > $webcast_end); error("INTERNAL ERROR: start>=end, $start, $end") if ($start >= $webcast_end); return ($start, $end, $webcast_end); } sub parse_hour($$) { my ($h, $endp) = @_; if ($h =~ m/\b(\d\d?)(:(\d\d))?\s*(A\.?M\.?)/i) { return undef if ($1 < 1 || $1 > 12); return undef if (defined($3) && ($3 < 0 || $3 > 60)); $h = 60 * $1; $h += $3 if (defined($3)); return $h; } elsif ($h =~ m/\b(\d\d?)(:(\d\d))?\s*(P\.?M\.?)/i) { return undef if ($1 < 1 || $1 > 12); return undef if (defined($3) && ($3 < 0 || $3 > 60)); $h = 60 * ($1 == 12 ? 12 : (12 + $1)); $h += $3 if (defined($3)); return $h; } elsif ($h =~ m/(\b12\s*)?\s*noon\b/i) { return 60 * 12; } elsif ($h =~ m/(\b12\s*)?\s*mid\s*-?\s*(nite|night)\b\b/i) { return 0; } elsif ($endp && $h =~ m/\b(after\b|after\s*-?\s*hours\b)/i) { return 'LATE'; } else { return undef; } } ############################################################################## # # , , and tags # ############################################################################## # Compares current time to start-date and end-date (time_t). # Either date can be undef, meaning unspecified. # Returns 0 if ticket is between dates (on sale). # Returns -1 if not on sale yet, and 1 if off sale already. # sub ticket_off_sale_p($$$) { my ($event, $on, $off) = @_; my $times = $event->{times}; my ($yyyy, $mm, $dd, $dotw, $start_minute) = @$times; my $hh = int($start_minute / 60); my $min = int($start_minute % 60); $hh--; # off sale an hour before doors. my $start = mktime(0, $min, $hh, $dd, $mm-1, $yyyy-1900, 0,0,-1); my $now = time(); return -1 if ($on && $now < $on); # early: before on-date return 1 if ($off && $now >= $off); # late: after off-date return 1 if ($now >= $start); # late: event already started return 0; # just right } # Whether the time_t is more than N days ago. # sub ticket_on_sale_this_week_p($$) { my ($onsale, $days) = @_; my $now = time(); my $cutoff = $now - ($days * 24 * 60 * 60); return ($onsale > $cutoff && $onsale <= $now); } my %performers = (); # keys are the name of the band/dj, munged. # values are references to lists: # "name" # type ('DJ' | 'BAND' | 'OTHER') # url # ordinal (e.g., Nth dj to play here) # reference to a list of dates: # each element is an int, YYYYMMDD my $performers_band_tick = 0; my $performers_dj_tick = 0; my $performers_other_tick = 0; # Populate the %performers table with stats about the given performers # on this date. # sub update_performer_stats($$$) { my ($lineno, $id, $eperformers) = @_; # Separate the bands and DJs into two lists, main room and lounge. # Build up those lists in reverse order so that we get the "Nth" # numbers right (the first band listed on the calendar goes on last, # so the ordinals count backwards within a given day.) # # Lounge comes after Main Room so that the main room DJs are # considered to be "earlier" than the lounge DJs (first DJ on in the # main room has a lower ordinal than the first or last DJ in the # lounge.) my @main; my @lounge; foreach my $p (@$eperformers) { my ($name, $type, $dup, $url, $room) = @$p; if ($room && $room eq 'LOUNGE') { unshift @lounge, $p; } else { unshift @main, $p; } } foreach my $p (@main, @lounge) { my ($name, $type, $dup, $url, $room) = @$p; update_performer_stats_1 ($lineno, $id, 1, $name, $type, $dup, $url); } } sub update_performer_stats_1($$$$$$$) { my ($lineno, $id, $tick_p, $name, $type, $dup, $url) = @_; my ($year, $mm, $dd) = ($id =~ m/^(\d{4})-(\d{2})-(\d{2}[ab]?)$/s); my ($dotm) = ($dd =~ m/^(\d+)[ab]?$/s); my $key = $name; $key = asciify (de_entify ($key)); # simplify accented characters $key = lc($key); # downcase $key =~ s/\b(the|and|dj|mc|mr)\b//g; # noise words $key =~ s/\s//g; # lose whitespace $key =~ s/^!$/shift1/s; # kludge for stupid "DJ !" $key =~ s/[^a-z\d]//g; # lose non-alphanumeric $key =~ s/([^aeiouy])\1+/$1/g; # merge consecutive consonants error ("$lineno: can't canonicalize $name") if ($key eq ''); $key .= "|$dup" if $dup; $key .= "|$type"; my $listref = $performers{$key}; my @list = (defined($listref) ? @$listref : ()); my @dates = (); my $ord = undef; my $noisewords = '^(DJ|MC|The) '; my $name2 = $name; $name2 =~ s/$noisewords//si; if (defined($listref)) { # there was an entry already my ($oname, $otype, $ourl, $oord, $odatesref) = @list; $oname =~ s/$noisewords//si; if ($oname ne $name2 && # warn about name spelling change length($name2) > 2 && $verbose) { my $m = $months[$mm-1]; $m =~ s/^(...).*$/$1/; print STDERR "$progname: $dotm $m $year: \"$oname\" " . "changed to \"$name2\"\n"; } $ourl = '' unless $ourl; $url = '' unless $url; if (!$tick_p) { # don't let the 1985-1999 bands override the URL. $url = $ourl if $ourl; } if ($ourl ne $url && $verbose && $tick_p) { # warn about URL change my $m = $months[$mm-1]; $m =~ s/^(...).*$/$1/; print STDERR "$progname: $dotm $m $year: $name: " . "\"$ourl\" changed to \"$url\"\n"; } $ord = $oord; @dates = @$odatesref; error ("$lineno: $key: no dates?") if ($#dates < 0); } my $d = "$year$mm$dd"; if ($#dates == -1 || $dates[$#dates] ne $d) { # avoid dups push @dates, $d; } my $datesref = \@dates; $ord = -1 unless $tick_p; if (! defined($ord)) { $ord = ($type eq 'BAND' ? $performers_band_tick++ : $type eq 'DJ' ? $performers_dj_tick++ : $performers_other_tick++); } @list = ($name, $type, $url, $ord, $datesref); $listref = \@list; $performers{$key} = $listref; } sub ledger_sortkey($) { my ($s) = @_; $s = asciify (de_entify (lc ($s))); $s = lc($s); $s =~ s/^(the|dj|mc|mr\.?)\s+//i; # lose leading noise words my $o = $s; $s =~ s/^[^[:alpha:]\d ]+//s; # ignore leading non-alphanumeric $s =~ s/^(the|a|an) //s; # ignore leading small words $s =~ s/[^[:alpha:]\d ]+/ /gs; # punctuation -> space $s =~ s/'//gs; $s = "0 $o" if ($s eq ''); # worst case... # sort leading numbers ordinally, at the bottom $s = sprintf("\277\277 %08d %s", $1, $2) if ($s =~ m/^(\d+)(.*)$/s); $s =~ s/^\s+|\s+$//gs; # compress space $s =~ s/\s+/ /gs; return $s; } # Write the calendar/ledger.html file. # sub generate_ledger_html($$) { my ($dir, $topten_p) = @_; my $bands = ''; # html for the bands/djs themselves my $djs = ''; my $others = ''; my $dj_idx = ''; # html for the A-Z indexes my $band_idx = ''; my $other_idx = ''; my $dj_count = 0; # totals my $band_count = 0; my $other_count = 0; my $dj_letter = ''; # previous first-letter-of-name encountered my $band_letter = ''; my $other_letter = ''; my $ties_p = 1; my %keys; foreach my $key (keys (%performers)) { my ($name, $type, $url, $ord, $datesref) = @{$performers{$key}}; $keys{$key} = ledger_sortkey ($name); } foreach my $key (sort { $keys{$a} cmp $keys{$b} } (keys (%performers))) { my ($name, $type, $url, $ord, $datesref) = @{$performers{$key}}; my @dates = @$datesref; $key = $keys{$key}; my $letter = $key; $letter =~ s/^(.).*$/$1/; $letter = uc($letter); $letter = '#' unless $letter =~ m/[A-Z]/i; my $ccount; if ($type eq 'DJ') { $ccount = ++$dj_count; my $letter2 = $letter; $letter = '' if ($letter eq $dj_letter); $dj_letter = $letter2; } elsif ($type eq 'BAND') { $ccount = ++$band_count; my $letter2 = $letter; $letter = '' if ($letter eq $band_letter); $band_letter = $letter2; } elsif ($type eq 'OTHER') { $ccount = ++$other_count; my $letter2 = $letter; $letter = '' if ($letter eq $other_letter); $other_letter = $letter2; } else { error ("unknown ledger type: $type"); } my ($colorL, $colorR) = (((($ccount-1) / 3) & 1) ? (" CLASS=\"NE\"", " CLASS=\"DE\"") : (" CLASS=\"NO\"", " CLASS=\"DO\"")); $url =~ s/&/&/gs if $url; my $desc = ""; my $n = $name; $n = "$n" if ($url); if ($letter eq '') { $desc .= ""; } else { my $anchor = lc($type) . "_$letter"; $desc .= ("" . "" . "$letter" . "" . ""); my $idx = "$letter "; if ($type eq 'DJ') { $dj_idx .= $idx; } elsif ($type eq 'BAND') { $band_idx .= $idx; } elsif ($type eq 'OTHER') { $other_idx .= $idx; } else { error ("unknown ledger type: $type"); } } $desc .= "$n"; $desc .= ""; my $count = 0; foreach my $d (sort @dates) { my ($year, $month, $dd) = ($d =~ m/^(\d{4})(\d\d)(\d\d[ab]?)$/s); my $u = ($year < 2001 ? "1985-1999.html\#$year" : sprintf("%04d/%02d-%s.html", $year, $month, $dd)); my ($dotm) = ($dd =~ m/^(\d+)[ab]?$/s); $desc .= ",\n" unless ($count == 0); my $m = $months[$month-1]; $m =~ s/^(...).*$/$1/; $desc .= "$dotm-$m-$year"; $count++; } $desc .= " (" . ($#dates+1) . ")" if ($#dates > 9); $desc .= "\n"; if ($type eq 'DJ') { $djs .= $desc; } elsif ($type eq 'BAND') { $bands .= $desc; } elsif ($type eq 'OTHER') { $others .= $desc; } else { error ("unknown ledger type: $type"); } } # Compute the top ten. # if ($topten_p) { my $output = ''; my $n = 25; my $i; my @sorted = sort { my $aa = $performers{$a}->[4]; my $bb = $performers{$b}->[4]; return ($#$bb == $#$aa ? ($performers{$a}->[0] cmp $performers{$b}->[0]) : $#$bb <=> $#$aa); } (keys (%performers)); { my $n1 = $total_event_count; my $n2 = $total_live_count; my ($first, $last) = find_scheduled_range (); $_ = $first; my ($first_year, $first_month) = m/^(\d{4})-(\d{2})$/; $_ = $last; my ($last_year, $last_month) = m/^(\d{4})-(\d{2})$/; my $start = mktime (0,0,0, 1, $first_month-1, $first_year-1900, 0,0,-1); my $end = mktime (0,0,0, 30, $last_month-1, $last_year-1900, 0,0,-1); my $days = ($end - $start) / (60 * 60 * 24); my $weeks = $days / 7; my $months = $days / 30; my $years = $days / 365.25; $output .= sprintf ("\nScheduled range: %s %d - %s %d:\n", $months[$first_month-1], $first_year, $months[$last_month-1], $last_year); $output .= sprintf (" " . "%d days; %d weeks; %.1f months; %.2f years.\n\n", $days, $weeks, $months, $years); $output .= sprintf (" Total events: %4d\n", $n1); $output .= sprintf (" Total live shows: %4d\n", $n2); $output .= sprintf (" Events / month: %4.1f ", ($n1/$months)); $output .= sprintf (" Live shows / month: %4.1f\n", ($n2/$months)); $output .= sprintf (" Events / week: %4.1f ", ($n1/$weeks)); $output .= sprintf (" Live shows / week: %4.1f\n", ($n2/$weeks)); $start = $one_year_ago; $end = $stats_cutoff; $days = 365; $weeks = $days / 7; $months = $days / 30; $n1 = $event_count_12mo; $n2 = $live_count_12mo; $output .= sprintf ("\nLast %d months:\n\n", $months); $output .= sprintf (" Total events: %4d\n", $n1); $output .= sprintf (" Total live shows: %4d\n", $n2); $output .= sprintf (" Events / month: %4.1f ", ($n1/$months)); $output .= sprintf (" Live shows / month: %4.1f\n", ($n2/$months)); $output .= sprintf (" Events / week: %4.1f ", ($n1/$weeks)); $output .= sprintf (" Live shows / week: %4.1f\n", ($n2/$weeks)); $start = $six_months_ago; $end = $stats_cutoff; $days = 365 / 2; $weeks = $days / 7; $months = $days / 30; $n1 = $event_count_6mo; $n2 = $live_count_6mo; $output .= sprintf ("\nLast %d months:\n\n", $months); $output .= sprintf (" Total events: %4d\n", $n1); $output .= sprintf (" Total live shows: %4d\n", $n2); $output .= sprintf (" Events / month: %4.1f ", ($n1/$months)); $output .= sprintf (" Live shows / month: %4.1f\n", ($n2/$months)); $output .= sprintf (" Events / week: %4.1f ", ($n1/$weeks)); $output .= sprintf (" Live shows / week: %4.1f\n", ($n2/$weeks)); } { $output .= "\n"; my $url = 'http://cerebrum.dnalounge.com/usage/slist-stats.txt'; my $lists = LWP::Simple::get($url) || ''; $output .= $lists; } $i = 1; $output .= "\nMost frequent bands:\n\n"; my $last_n = -1; my $last_i = -1; foreach my $key (@sorted) { my $listref = $performers{$key}; my ($name, $type, $url, $ord, $datesref) = @$listref; next unless ($type eq 'BAND'); my $nd = $#$datesref+1; next if ($nd == 1); my $ii = ($ties_p && $nd == $last_n ? $last_i : $i); $last_n = $nd; $last_i = $ii; $output .= sprintf("%5d: %s (%d)\n", $ii, de_entify($name), $nd); last if (++$i > $n && $n != 0); } $last_n = -1; $last_i = -1; $i = 1; $output .= "\nMost frequent DJs:\n\n"; foreach my $key (@sorted) { my $listref = $performers{$key}; my ($name, $type, $url, $ord, $datesref) = @$listref; next unless ($type eq 'DJ'); my $nd = $#$datesref+1; next if ($nd == 1); my $ii = ($ties_p && $nd == $last_n ? $last_i : $i); $last_n = $nd; $last_i = $ii; $output .= sprintf("%5d: %s (%d)\n", $ii, de_entify($name), $nd); last if (++$i > $n && $n != 0); } if (0) { $last_n = -1; $last_i = -1; $i = 1; $output .= "\nMost frequent \"others\":\n\n"; foreach my $key (@sorted) { my $listref = $performers{$key}; my ($name, $type, $url, $ord, $datesref) = @$listref; next unless ($type eq 'OTHER'); my $nd = $#$datesref+1; next if ($nd == 1); my $ii = ($ties_p && $nd == $last_n ? $last_i : $i); $last_n = $nd; $last_i = $ii; $output .= sprintf("%5d: %s (%d)\n", $ii, de_entify($name), $nd); last if (++$i > $n && $n != 0); } } { my $all_genres_p = 0; $last_n = -1; $last_i = -1; $i = 1; $output .= "\n" . ($all_genres_p ? "All genres, by frequency: " . "All genres, alphabetical:" : "Most frequent genres:") . "\n\n"; my @out = (); foreach my $key (sort { my $aa = $genres{$a}; my $bb = $genres{$b}; if ($aa == $bb) { return ($a cmp $b); } else { return ($bb <=> $aa); } } keys (%genres)) { my $val = $genres{$key}; my $ii = ($ties_p && $val == $last_n ? $last_i : $i); $last_n = $val; $last_i = $ii; push @out, sprintf("%5d: %s (%d)\n", $ii, $key, $val); $i++; last if (!$all_genres_p && $i > $n && $n != 0); } if ($all_genres_p) { my @keys = sort (keys (%genres)); foreach my $line (@out) { my $key = shift @keys; my $val = $genres{$key}; $line = sprintf("%-38s %s (%d)\n", $line, $key, $val); } } $output .= join ("", @out); } $output .= "\nInteresting Nths:\n"; my @cool_numbers = (1, 10, 50, 69, 100, 500, 666, 999, 1000, 1024, 1500, 2000, 2048, 2500, 3000, 3500, 4000, 4096, 4500, 5000, 5500, 6000, 6500, 7000, 7500, 8000, 8500, 9000, 9500, 10000); my @cool_numbers_2 = (150, 200, 250, 300, 400, 600, 700, 800, 900); foreach my $type ('DJ', 'BAND') { $output .= "\n"; my @out = (); foreach my $key (@sorted) { my $listref = $performers{$key}; my ($name, $ttype, $url, $ord, $datesref) = @$listref; next unless ($ttype eq $type); my @dates = @$datesref; my $date = $dates[0]; my $cool = 0; my @nums = @cool_numbers; push @nums, @cool_numbers_2 if ($type eq 'BAND'); foreach my $c (sort { $a <=> $b } (@nums)) { if ($c == $ord+1) { $cool = $ord+1; last; } } next unless ($cool); $date =~ s@^(\d{4})(\d\d)(\d\d)$@ my ($y, $m, $d) = ($1, $2, $3); $m = $months[$2-1]; $m =~ s/^(...).*$/$1/; "$d-$m-$y";@gsex; $cool = "$cool" . ($cool == 1 ? "st" : "th"); $cool .= " " . ($type eq 'DJ' ? 'DJ' : lc($type)); $name = de_entify($name); $name =~ s/^(.{35}).*/$1/; push @out, sprintf("%13s: %-35s %s\n", $cool, $name, $date); } @out = sort { my ($aa, $bb) = ($a, $b); $aa =~ s/^\s*(\d+).*$/$1/; $bb =~ s/^\s*(\d+).*$/$1/; return $aa <=> $bb; } @out; $output .= join ("", @out); } $output .= "\n"; foreach my $c (sort { $a <=> $b } (@cool_numbers, @cool_numbers_2)) { next if ($c == 1); my $event = $event_ords[$c-1]; next unless defined ($event); my $title = $event->{title}; my $date = $event->{date}; $date =~ s/^.*, //; $date =~ s/ /-/g; $date = "0$date" unless ($date =~ m/^\d\d/); my $cool = "$c" . ($c == 1 ? "st" : "th") . " event"; $title =~ s/^(.{35}).*/$1/; $output .= sprintf("%13s: %-35s %s\n", $cool, $title, $date); } $output .= "\n"; my $outfile = "$dir/$calendar_topten_file"; DNA::Menuify::write_file ($outfile, $output); return; # don't bother writing ledger.html in topten mode } { my $a = "

"; my $b = "
"; $band_idx = $a . $band_idx . $b; $dj_idx = $a . $dj_idx . $b; } my $output = ''; $output .= "$page_title: Bands and DJs\n"; my $nevents = $total_event_count; $nevents -= ($#future_events + 1); # $band_count =~ s/(\d)(\d\d\d)$/$1,$2/; # $dj_count =~ s/(\d)(\d\d\d)$/$1,$2/; # $nevents =~ s/(\d)(\d\d\d)$/$1,$2/; $output .= ("\n" . "\n" . "\n"); $output .= ("\n" . "
\n" . " $band_count bands
\n" . " $dj_count djs
\n" . " $nevents events
\n" . "
\n" . "\n" . "\n" . "
\n" . "\n" . "Bands and DJs\n" . "\n" . "


\n" . "
\n" . "This is a list of all of the bands and DJs who have\n" . "performed at DNA Lounge since we re-opened in 2001\n" . "(including a very incomplete\n" . "sampling of bands who performed here as far back as\n" . "1985). Clicking on a name will take you to that performer's\n" . "web site (if we know it) and clicking on a date will take\n" . "you to the appropriate entry in the\n" . "calendar.\n" . "From there, you can find the corresponding\n" . "flyers,\n" . "photo galleries,\n" . "etc.\n" . "

\n" . "If you have any corrections to the URLs or names below,\n" . " please \n" . "let us know!\n" . "

\n" . "
\n" . "

\n" . "\n" . " \n" . " \n" . " \n" . $bands . " \n" . " \n" . " \n" . $djs); # $output .= (" \n" . # " \n" . # " \n"); # $output .= $others; # This kludge turns this: Into this: # # ----------------- ----------------- # | X | ABC | | X | ABC | # ----------------- | |---------| # | | DEF | | | DEF | # ----------------- | |---------| # | | GHI | | | GHI | # ----------------- ----------------- { $_ = $output; s@(@i, $chunk); my $count = $#junk; if ($count > 0) { $count++; $chunk =~ s@(ROWSPAN=)(\d+)@$1$count@gsi; $chunk =~ s@@@gsi; } } $output = join ('', @chunks); } $output .= "
\n" . "
\n" . "\n" . "Bands\n" . "\n" . $band_idx . "


\n" . "

\n" . "

\n" . "
\n" . "\n" . "DJs, MCs, etc.\n\n" . $dj_idx . "


\n" . "

\n" . # "

\n" . # "
\n" . # "\n" . # "\"Others\"\n\n" . # $other_idx . # "


\n" . # "

]* ROWSPAN=)@\001$1@gs; my @chunks = split (/\001/, $_); foreach my $chunk (@chunks) { my @junk = split (m@
\n"; $output .= "\n"; my $outfile = "$dir/$calendar_ledger_file"; 1 while $outfile =~ s@[^/]+/\.\./@@g; DNA::Menuify::write_file ($outfile, $output); } # Write the calendar/names.txt file. # Contains a line for each event, "YYYY-MM-DD \t NAME \t FLYER \t TIME_T \t TIX" # The name begins with an asterisk if it's a "live" event. # sub generate_names_file($) { my ($dir) = @_; my %output; foreach my $key (sort calendar_id_cmp (keys %calendar)) { my ($year, $month, $dotm, $suf) = ($key =~ m/^(\d\d\d\d)-(\d\d)-(\d\d)([ab])?$/); next unless defined ($dotm); my $event = $calendar{$key}; my $title = asciify($event->{title}); $title =~ s/,//g; # tickets can't have commas in event name. next if ($title =~ m/^\(?CLOSED|CANCELL?ED|SUSPENDED\)?$/si); $title = "*$title" if ($event->{live_p}); my $pres = $event->{pres} || ''; $pres =~ s@<[^<>]+>@@g; $pres =~ s@\s+@ @gs; $pres =~ s@^\s+|\s+$@@gs; $pres = asciify(de_entify($pres)); my $flyer = $event->{flyer} || ''; $flyer = $url_base . $flyer if ($flyer); my $times = $event->{times}; my ($dotw, $start_minute); ($year, $month, $dotm, $dotw, $start_minute) = @$times; my $start_hour = int($start_minute / 60); $start_minute = int($start_minute % 60); my $date = mktime (0, $start_minute, $start_hour, $dotm, $month-1, $year-1900, 0, 0, -1); my $age = $event->{age} || ''; my @tix; my $tickets = $event->{tickets}; if ($tickets) { foreach my $t (@$tickets) { my ($ticket, $desc, $price, $onsale, $offsale, $vip_p) = @$t; next if $vip_p; next unless ($ticket =~ m@^.*item=(.*)@s); push @tix, $1; } } # Find the Facebook event ID for this event, so that the store can # include an "RSVP" button. # my $rsvp = ''; foreach my $key (@{$event_ids{$key}}) { my ($site, $id) = ($key =~ m/^(.*?)=(.*)$/si); if ($site eq 'facebook') { $rsvp = $id; last; } } my $tix = join (",", @tix); $output{$key} = join ("\t", ($key, $pres, $title, $flyer, $date, $age, $tix, $rsvp)) . "\n"; } my $output = ''; foreach my $key (sort (keys %output)) { $output .= $output{$key}; } my $outfile = "$dir/$calendar_names_file"; DNA::Menuify::write_file ($outfile, $output); } # Write the calendar/1985-1999.html file, based on calendar/1985-1999.txt. # sub generate_eighties_file($) { my ($dir) = @_; my $file = "$dir/$calendar_eighties_file"; open (my $in, '<', $file) || error ("$file unreadable"); print STDERR "$progname: reading $file\n" if ($verbose > 3); my $prev_date = ''; my $prev_year = ''; my $table_top = ("\n" . "" . "" . "" . "\n"); my $output = "
\n"; my $lineno = -1; while (<$in>) { $lineno++; my ($year, $mm, $dd, $bands) = m@^(\d{4})-([\d\?][\d\?])-([\d\?][\d\?])\s+(.*)$@s; error ("$file: unparsable: $_") unless $bands; my $mmm = ($mm eq '??' ? '???' : $months[$mm-1]); $mmm =~ s/^(...).*$/$1/s; my $date = "$dd $mmm"; # if ($dd ne '??') { # my $dotw = $days[dotw($dd, $mm, $year)]; # $dotw =~ s/^(...).*$/$1/s; # $date .= " ($dotw)"; # } error ("$file: dup date: $year-$mm-$dd") if ($date eq $prev_date && $dd !~ m/\?/); $prev_date = $date; my $year_col = ''; if ($year ne $prev_year) { $output .= ("\n" . "

") if ($prev_year); $output .= ("\n" . "" . "

$year
" . "\n" . "\n" . "\n" . $table_top); $prev_year = $year; } $bands =~ s/&/&/gs; $bands =~ s//>/gs; $bands =~ s/\s+/ /gs; my $flyer = "flyers/1985-1999/$year-$mm-$dd.html"; $flyer = "flyers/1985-1999/$year-$mm-$dd-1.html" unless (-f $flyer); $flyer = undef unless (-f $flyer); # Update the $calendar_ledger_file with the early bands/DJs. # { my $bands2 = $bands; $bands2 =~ s/\s*\(.*\)\s*/ /gs; # lose parens $bands2 =~ s/,\s+/\n/gs; # replace comma with linebreak $bands2 =~ s/:\s+/:\n/gs; # linebreak after colon $bands2 =~ s/^ +| +$//gm; foreach my $band (split(/\n/, $bands2)) { next if ($band =~ m/:$/s); # subtitle my $type = ($band =~ s/^\-//s ? 'OTHER' : $band =~ s/^\+//s ? 'DJ' : $band =~ s/^\*//s ? 'BAND' : 'BAND'); my $dup = undef; $dd = 1 if ($dd !~ m/^\d+$/s); $mm = 1 if ($mm !~ m/^\d+$/s); my $id = sprintf("%04d-%02d-%02d", $year, $mm, $dd); update_performer_stats_1 ($lineno, $id, 0, $band, $type, $dup, ($flyer ? "../$flyer" : undef)); } } $bands =~ s/(^|\s)[-+*]([a-z\d])/$1$2/gsi; # lose DJ/BAND tags $bands = "$bands" if ($flyer); $output .= (" " . "$date" . "" . "$bands" . "\n"); } close $in; $output .= "\n"; my $title = "DNA Lounge Calendar: 1985-1999"; $output = ("$title\n" . "\n" . " \n" . "\n" . "\n" . "

\n" . "<< 1984\n" . "2001 >>\n" . "\n" . "\n" . "\n" . "$title\n\n" . "

\n" . $eighties_top_blurb . "


\n" . $output . "\n" ); my $outfile = $file; $outfile =~ s@\.txt$@.html@s; DNA::Menuify::write_file ($outfile, $output); } ############################################################################## # # Flyers, Photos # ############################################################################## # Parse the FLYER: option, which means "this entry shares a flyer with # the entry on the given other date." # sub parse_shared_flyer($$$) { my ($key, $lineno, $val) = @_; return unless $val; if ($val =~ m/^NONE$/i) { print STDERR "$progname: $lineno: skipped flyer $key = NONE\n" if ($verbose > 3); } elsif ($val =~ m/^(\d\d?)([ab]?)[-\s]+($month_re)[-\s]+(\d{4})(\s+EARLY)?\s*$/io) { my $ndotm = 0 + $1; my $ord = $2; my $nmonth = $3; my $nyear = 0 + $4; my $early_p = defined($5); $nmonth = $monthvals{lc($nmonth)}; my $nnumeric = ($nyear * 10000) + ($nmonth * 100) + $ndotm; my $ndate = sprintf ("%04d-%02d-%02d", $nyear, $nmonth, $ndotm); $key =~ m/^(\d{4})-(\d{2})-(\d{2})([ab]?)$/si; my $odotm = 0 + $3; my $omonth = $2; my $oyear = 0 + $1; my $onumeric = ($oyear * 10000) + ($omonth * 100) + $odotm; if (new_style_anchors_p($ndate)) { $ndate .= "a" if $early_p; } else { if (defined($calendar{$ndate . "b"})) { # If the target date has two entries, aim the at early or late one. $ndate .= "b" unless $early_p; } } if ($nnumeric >= $onumeric) { $omonth = $months[$omonth-1]; $omonth =~ s/^(...).*$/$1/; $nmonth = $months[$nmonth-1]; $nmonth =~ s/^(...).*$/$1/; $key = "$odotm-$omonth-$oyear"; error ("$lineno: flyer target ($ndate) >= date ($key)"); } $shared_flyers{$key} = $ndate; print STDERR "$progname: $lineno: stored flyer $key = $ndate\n" if ($verbose > 3); } else { error ("$lineno: unparsable FLYER tag"); } } # Returns the relative HREF to the photo gallery for this date, if any. # sub find_photo($) { my ($event) = @_; my $key = $event->{key}; my ($yyyy, $mm, $dd) = ($key =~ m/^(\d{4})-(\d{2})-(\d{2}[ab]?)$/s); my $dir = sprintf ("gallery/%04d/%02d-%s", $yyyy, $mm, $dd); return "$dir/" if (-d $dir); return undef; } # Parse gallery/names.txt, which was generated by wrap-gallery.pl # to tell us which gallery directories are related to which events. # sub load_galleries($) { my ($file) = @_; open(my $in, '<', $file) || return; print STDERR "$progname: loading $file\n" if ($verbose > 3); my @lines = <$in>; close ($in); foreach my $line (@lines) { my ($title, $dates) = split("\t", $line); my @d = split (" ", $dates); $all_galleries{lc($title)} = \@d; } } # Returns a listref of the gallery directories related to this event. # This is stored in $event->{galleries}. # sub find_galleries($) { my ($event) = @_; my $key = lc(asciify($event->{title})); $key =~ s/: .*$//s; $key =~ s/:, .*$//s; return $all_galleries{$key}; } # Find the list of /tickets/EVENT/ directories that exist. # sub load_portal_dirs($) { my ($dir) = @_; my ($tickets_dir) = ($calendar_tickets_file =~ m@^(.*)/@si); opendir (my $tdir, "$dir/$tickets_dir") || error ("$tickets_dir: $!"); foreach my $f (sort (readdir ($tdir))) { next if ($f =~ m/^\./si); next unless (-d "$dir/$tickets_dir/$f"); $portal_dirs{lc($f)} = 1; } closedir ($tdir); } # Scan through the title and presenters and return the [ name, title ] # of a corresponding ticket-portal subdirectory, if one exists. # sub find_portal_dir($$) { my ($title, $pres) = @_; $title = '' unless defined($title); $pres = '' unless defined($pres); $title =~ s/: .*//gs; $pres =~ s/<[^<>]*>/ /gsi; $pres =~ s/\s+presents?:?\s*$//si; $pres =~ s/&/&/gsi; $pres =~ s/,?\s*(\band\b|&)/,/gsi; $pres = "$title, $pres"; foreach my $p (split (/\s*,\s*/, $pres)) { my $op = $p; $p =~ s/\s+//g; $p = lc($p); if (defined ($portal_dirs{$p})) { $portal_dirs{$p} = $op; return ($op, $p); } } return undef; } # Reset the galleries queue so that --summarize is stable, that is, # the same HTML files are generated regardless of which subset of # HTML files we are generating due to the --summarize argument. # (Except this doesn't really work, since the RSS file doesn't # emit HTML for un-filled-in "repeating" events, so the order of # HTML generation differs anyway. Blah.) # sub reset_galleries_queue($) { my ($event) = @_; my $g = $event->{ogalleries}; my @g = ($g ? ( @$g ) : ()); $event->{galleries} = \@g; # ref to copy of list } # Returns the relative HREF to the flyer for this date, if any. # sub find_flyer($) { my ($event) = @_; my $ff = $event->{flyer}; return undef if ($ff && $ff =~ m/^NONE$/si); my $key = $event->{key}; my $shared = $shared_flyers{$key}; my ($yyyy, $mm, $dd) = ($key =~ m/^(\d{4})-(\d\d)-(\d\d[ab]?)$/s); my $file = sprintf ("flyers/%04d/%02d/%s.html", $yyyy, $mm, $dd); if (defined ($shared)) { ($yyyy, $mm, $dd) = ($shared =~ m/^(\d{4})-(\d\d)-(\d\d[ab]?)$/s); my $file2 = sprintf ("flyers/%04d/%02d/%s.html", $yyyy, $mm, $dd); print STDERR "$progname: WARNING: shared and real flyer for $key\n" if (-f $file); print STDERR "$progname: WARNING: no shared flyer for $key ($shared)\n" unless (-f $file2); $file = $file2; } return undef unless (-f $file); return $file; } ############################################################################## # # Looking up entries in the calendar # ############################################################################## # Returns a string describing the holiday on this date, if any. # sub lookup_holiday($$$) { my ($year, $month, $dotm) = @_; my $key = sprintf ("%04d-%02d-%02d-H", $year, $month, $dotm); my $key2 = sprintf ("%04d-%02d-%02d-H", 0, $month, $dotm); my $val = $calendar{$key}; $val = undef if ($val && $val =~ m/^\s*$/s); if (!defined($val)) { $key = $key2; $val = $calendar{$key}; } $val = undef if ($val && $val =~ m/^\s*$/s); if ($val) { $_ = $val; s/\\/\\\\/g; s/\"/\\\"/g; s/\n/\\n/g; print STDERR "$progname: holiday: $key: \"$_\"\n" if ($verbose > 2); return $val; } else { return undef; } } # Returns a string describing the holiday on the *following* day, if any. # sub lookup_holiday_tomorrow($$$) { my ($year, $month, $dotm) = @_; my $dpm = days_per_month ($month, $year); if (++$dotm > $dpm) { $dotm = 1; if (++$month == 12) { $year++; } } return lookup_holiday ($year, $month, $dotm); } # Returns an entry-hash describing a repeating entry for this day, if any. # # $dotw is the day of the week (0-6) # $dotw_number is the number of that day in this month # (e.g., 2 for "2nd wednesday") # $total_dotws is how many of that dotw this month has # (e.g., 5 for "there are 5 wednesdays"); # sub lookup_repeating_entry($$$$$$$) { my ($year, $month, $dotm, $early_p, $dotw, $dotw_number, $total_dotws) = @_; my $value = undef; my $vlineno = undef; $_ = $days[$dotw]; s/^(...).*/$1/; foreach my $ptr (@repeaters) { my @entry = @$ptr; my ($edotw, $rep, $rdesc, $eearly_p, $from_year, $from_month, $from_dotm, $to_year, $to_month, $to_dotm, $lineno, $entry_hash) = @entry; next unless ($edotw == $dotw); # skip if out of range. my $from_i = ($from_year * 10000 + $from_month * 100 + $from_dotm); my $to_i = ($to_year * 10000 + $to_month * 100 + $to_dotm); my $i = ($year * 10000 + $month * 100 + $dotm); next if ($i < $from_i || $i > $to_i); next if ((!$early_p) != (!$eearly_p)); # today is within the range of this repeater. my @nths = ("1st", "2nd", "3rd", "4th", "5th"); if ($rep == 0) { # an "every week" entry # always matches. } elsif ($rep >= 1 && $rep <= 4) { # an "every [1-4] week" entry next unless ($dotw_number == $rep); } elsif ($rep == 5) { # an "every 5th week" entry # the 4th day in a month with 5 of them. # (note that "4th friday" and "5th friday" indicate the same day # in a month that has 5 fridays.) next unless ($dotw_number == 4 && $total_dotws == 5); } elsif ($rep == -1) { # an "every last week" entry next unless ($dotw_number == $total_dotws); } elsif ($rep == -666) { # an "every other week" entry error ("\"every other week\" not supported yet"); } else { error ("INTERNAL ERROR: unknown repeater $rep\n"); } # If we made it here, this repeater matches this day. if (defined($value)) { print STDERR "$progname: WARNING: duplicate repeating matches: " . "line $lineno and line $vlineno\n"; } elsif ($verbose > 2) { my $key = sprintf ("%04d-%02d-%02d%s", $year, $month, $dotm, ($early_p ? 'a' : '')); $_ = $entry_hash->{title}; print STDERR "$progname: repeater: $key: \"$_\"\n"; } my %new_hash = %$entry_hash; # copy it $value = \%new_hash; $vlineno = $lineno; parse_calendar_html_2 ($value, $dotm, $month, $year); parse_calendar_event_final ($value, $rdesc, $early_p, 0); } return $value; } ############################################################################## # # Event IDs # ############################################################################## sub load_event_ids($) { my ($file) = @_; open (my $in, '<', $file) || error ("$file: $!"); print STDERR "$progname: loading $file\n" if ($verbose > 3); my @lines = <$in>; close($in); my %checkboxes = ( 'marked' => 1, 'sfweekly' => 1, 'sfgate' => 1, 'flavorpill' => 1, 'squidlist' => 1, 'nitevibe' => 1, 'napkinnights' => 1, 'deli' =>1, 'owl' => 1 ); my %site_priority = ( 'marked' => 0, 'sfstation' => 1, 'myspace' => 2, 'facebook' => 3, 'going' => 4, 'upcoming' => 5, 'sonicliving' => 6, 'lastfm' => 7, 'yelp' => 8, 'sfweekly' => 9, 'sfgate' => 10, 'flavorpill' => 11, 'squidlist' => 12, 'nitevibe' => 13, 'napkinnights' => 14, 'deli' => 15, 'owl' => 16, ); foreach (@lines) { my ($key, $val) = m/^([^\t]*)\t(.*)$/s; my %pairs; foreach my $e (split (/\t/, $val)) { $e =~ s/\n$//s; my ($key2, $val2) = ($e =~ m/^([^=]*)=(.*)$/s); print STDERR "$progname: $key $key2 = $val2\n" if ($verbose > 3); $pairs{$key2} = $val2 unless ($checkboxes{$key2}); } # Sort the pairs according to the preferred order in $site_priority; my @L = (); foreach my $key2 (sort { $site_priority{$a} <=> $site_priority{$b} } keys (%pairs)) { my $val2 = $pairs{$key2}; push @L, "$key2=$val2"; } $event_ids{$key} = \@L; } } # Constructs HTML for linking to this event on social networking sites. # sub make_event_id_url($$$) { my ($site, $id, $event_title) = @_; my ($site_name, $url); $site = lc($site); if ($site eq 'upcoming') { $site_name = "Upcoming"; $url = "http://upcoming.yahoo.com/event/$id/"; } elsif ($site eq 'lastfm') { $site_name = "Last.FM"; $url = "http://www.last.fm/event/$id"; } elsif ($site eq 'sonicliving') { $site_name = "SonicLiving"; $url = "http://sonicliving.com/event/$id/"; } elsif ($site eq 'facebook') { $site_name = "Facebook"; # $url = "http://www.facebook.com/event.php?eid=$id"; $url = "https://www.facebook.com/events/$id/"; } elsif ($site eq 'myspace') { $site_name = "MySpace"; if ($id =~ m/^\d+$/s) { $url = "http://events.myspace.com/Event/View/$id/"; # new style } else { $url = ("http://events.myspace.com/index.cfm" . # old style, "?fuseaction=events.detail" . # NNNNNN.NNNNN "&eventID=$id"); } } elsif ($site eq 'yelp') { $site_name = "Yelp"; $url = "http://www.yelp.com/events/$id"; } elsif ($site eq 'sfstation') { # Don't include this one in the calendar. #$site_name = "SFStation"; #$url = "http://www.sfstation.com/$id"; } elsif ($site eq 'sfweekly' || $site eq 'sfgate') { # These aren't real IDs. } elsif ($site eq 'going') { # Defunct. } else { error ("unknown event site: $site ($id)"); } return () unless $url; return ($url, $site_name); } sub make_event_id_links($$) { my ($event, $future_p) = @_; return '' if (!$future_p); my $title = $event->{title}; my $times = $event->{times}; my $eid = $event->{key}; my $eid2 = $eid; $eid2 =~ s/-//gs; if ($title =~ m/\b(CANCELL?ED|POSTPONED|CLOSED|SUSPENDED)\b/i) { return ""; } # Only include the links to export.cgi for future events, because # it works by parsing the .ics file, and that does not contain # historic events. # my $u1 = "

  • "; my $u3 = "
    • \n"; my $html = ("Export:\n". "\n"); return $html; } # Generates the HTML for the Facebook and Google links (Likes, RSVPs, etc.) # sub make_fblike_link($) { my ($event) = @_; my $title = $event->{title}; my $eid = $event->{key}; my $eid2 = $eid; $eid2 =~ s/-//gs; my ($yyyy, $mm, $dd) = ($eid =~ m/^(\d{4})-(\d\d)-(\d\d[ab]?)$/s); my $url = $url_base . "calendar/$yyyy/$mm-$dd.html"; my $html = ''; my $url2 = $url; $url2 =~ s@:@%3A@gs; $url2 =~ s@/@%2F@gs; $html .= ("" . "
    " . "
    " . "
    " . "
    "); my $fbimg = ""; my $twimg = ""; my $fb_event; foreach my $key (@{$event_ids{$eid}}) { my ($site, $id) = ($key =~ m/^(.*?)=(.*)$/si); if ($site eq 'facebook') { ($fb_event) = make_event_id_url ($site, $id, $title); last; } } $html .= "
    " . "RSVP:$fbimg
    \n" if ($fb_event); $html .= ("
    " . "Share:\n" . "" . "$fbimg\n" . "" . "$twimg" . "
    \n"); return $html; } # Parse the names of the files in calendar/images/ # File names are the same as event names, downcased without spaces, # followed by either "_w" or "_b" for white or black backgrounds, # e.g., "battleofthebands_w.png". # # The %title_images hash contains: # "battleofthebands" => [ "battleofthebands_w.png", "battleofthebands_b.png" ] # sub load_title_images($) { my ($dir) = @_; $dir =~ s@/*$@@; $dir = "$dir/images"; opendir (my $idir, "$dir") || error ("$dir: $!"); my @ifiles = sort { $b cmp $a } (readdir ($idir)); closedir $idir; foreach my $img (@ifiles) { next if ($img =~ m/^\./s); next unless ($img =~ m/^([a-z\d]+)_([bw])\.(jpg|gif|png)$/s); my ($name, $type) = ($1, $2); my $L = $title_images{$name}; my @L = ($L ? @$L : ()); my $i = ($type eq 'w' ? 0 : 1); my $j = ($i == 0 ? 1 : 0); $L[$i] = "images/$img"; $L[$j] = "images/$img" unless $L[$j]; $title_images{$name} = \@L; } } # Return a title image for this event name, if one exists. # sub find_title_image($$) { my ($title, $black_background_p) = @_; $title = lc($title); $title =~ s/: .*$//s; $title =~ s/[^a-z\d]+//gs; my $L = $title_images{$title}; return undef unless $L; return $L->[$black_background_p ? 1 : 0]; } ############################################################################## # # Start the parser going # ############################################################################## sub load_calendar($$) { my ($file, $fast_p) = @_; open(my $in, '<', $file) || error ("$file: $!"); my $slineno = 0; my $lineno = 0; my @lines = (); $total_event_count = 0; $total_live_count = 0; $event_count_12mo = 0; $live_count_12mo = 0; $event_count_6mo = 0; $live_count_6mo = 0; { my ($sec, $min, $hour, $dotm, $mon, $year) = localtime (time); $mon++; $year += 1900; $stats_cutoff = $year * 10000 + $mon * 100 + $dotm; $mon -= 6; if ($mon < 1) { $mon += 12; $year--; } $six_months_ago = $year * 10000 + $mon * 100 + $dotm; $mon -= 6; if ($mon < 1) { $mon += 12; $year--; } $one_year_ago = $year * 10000 + $mon * 100 + $dotm; } while (<$in>) { my $line = $_; my $contp = 0; $lineno++; $_ = undef; next if ($line =~ m/^\s*\#/); # skip fully commented lines $line =~ s/\s*\#+\s.*//g; # lose comments at end of line $contp = 1 if ($line =~ m/^\s/ || $line =~ m/^$/); $contp = 0 if ($line =~ m/^HOLIDAY/i); # kludge if (!$contp) { if ($#lines >= 0) { parse_calendar_entry ($slineno, $fast_p, @lines); @lines = (); } $slineno = $lineno; } $line =~ s/\n$//s; if ($#lines >= 0 || !$contp) { push @lines, $line; } } if ($#lines >= 0) { # last entry parse_calendar_entry ($slineno, $fast_p, @lines); } # Second pass, to finish parsing things. # foreach my $key (sort calendar_id_cmp (keys %calendar)) { if ($key =~ m/^\d{4}-\d\d-\d\d([ab])?$/) { # real events, not holidays my $early_p = ($1 ? 1 : 0); my $event = $calendar{$key}; parse_calendar_event_final ($event, 0, $early_p, 1); } } link_event_lists(); close $in; } # returns ("YYYY-MM" "YYYY-MM") of the range that the calendar covers. # sub find_scheduled_range() { my $min = 9999999; my $max = 0; foreach (keys (%calendar)) { if (m/^(\d+)-(\d+)-(\d+)$/) { my ($year, $month, $dotm) = ($1, $2, $3); my $i = $year * 1000 + $month; $min = $i if ($i < $min); $max = $i if ($i > $max); } } error ("no calendar events scheduled at all!") if ($max <= 0); my $first = sprintf ("%04d-%02d", $min/1000, $min%100); my $last = sprintf ("%04d-%02d", $max/1000, $max%100); print STDERR "$progname: scheduled range: $first - $last\n" if ($verbose > 3 && ($first || $last)); return ($first, $last); } ############################################################################## # # Generating calendar overview grids # ############################################################################## # returns a list of five items: # the html for the cal grid header; # the URLs that are in the "prev" and "next" links (or undef). # the pretty names of the "prev" and "next" links (or undef). # sub build_cal_header($$$$) { my ($year, $month, $prev_p, $next_p) = @_; my $output = ""; my ($prev_name, $next_name); my $last_month = $months[($month+10) % 12]; my $this_month = $months[$month-1]; my $next_month = $months[$month % 12]; my $last_month_year = ($month == 1 ? $year-1 : $year); my $next_month_year = ($month == 12 ? $year+1 : $year); my $last_month_href = sprintf("%02d", ((($month+10) % 12) + 1)) . ".html"; my $next_month_href = sprintf("%02d", ((($month) % 12) + 1)) . ".html"; $last_month_href = "../$last_month_year/$last_month_href" if ($year != $last_month_year); $next_month_href = "../$next_month_year/$next_month_href" if ($year != $next_month_year); $last_month_href = undef unless ($prev_p); $next_month_href = undef unless ($next_p); $prev_name = "$last_month $last_month_year" if $prev_p; $next_name = "$next_month $next_month_year" if $next_p; $last_month =~ s/^(...).*$/$1/; $this_month =~ s/^(...).*$/$1/; $next_month =~ s/^(...).*$/$1/; $last_month = "<< $last_month"; $next_month = "$next_month >>"; $output .= (($last_month_href ? "$last_month" : "$last_month") . "\n" . ($next_month_href ? "$next_month" : "$next_month") . "\n" . "
    $this_month
    \n"); $output =~ s/^/ /gm; $output =~ s/^\s+//s; return ($output, $last_month_href, $next_month_href, $prev_name, $next_name); } sub event_cell_title($) { my ($e) = @_; my $t = $e->{title}; my $a = $e->{age}; if ($a) { if ($a eq 'AA') { $a = "all ages"; } else { $a .= "+"; } $t .= "\n$a"; } return $t; } # A given day can have zero, one or two events. # This finds and returns the daytime event, or the nighttime event. # If there is only one event, it is by definition a nighttime event. # sub get_event($$) { my ($key, $night_p) = @_; error ("bad key: $key") unless ($key =~ m/^\d{4}-\d\d-\d\d$/s); my $e0 = $calendar{$key}; my $ea = $calendar{$key . "a"}; # new_style_anchors_p my $eb = $calendar{$key . "b"}; # !new_style_anchors_p my $e; error ("$key: three events") if ($e0 && $ea && $eb); return undef unless ($e0 || $ea || $eb); if (!$night_p && $ea && $e0 && !$eb) { $e = $ea; } # day A+0 110 elsif (!$night_p && $ea && !$e0 && $eb) { $e = $ea; } # day A+B 101 elsif (!$night_p && !$ea && $e0 && $eb) { $e = $e0; } # day 0+B 011 elsif (!$night_p && !$ea && $e0 && !$eb) { $e = undef; } # day 0 010 elsif (!$night_p && $ea && !$e0 && !$eb) { $e = $ea; } # day A 100 elsif ( $night_p && $ea && $e0 && !$eb) { $e = $e0; } # night A+0 110 elsif ( $night_p && $ea && !$e0 && $eb) { $e = $eb; } # night A+B 101 elsif ( $night_p && !$ea && $e0 && $eb) { $e = $eb; } # night 0+B 011 elsif ( $night_p && !$ea && $e0 && !$eb) { $e = $e0; } # night 0 010 elsif ( $night_p && $ea && !$e0 && !$eb) { $e = undef; } # night A 100 else { error ("$key: um what? $night_p/$ea/$e0/$eb"); } return $e; } # Returns a list of zero, one or two events falling on the given day. # They may be real events, or repeaters. # sub get_all_events($$$$) { my ($year, $month, $dotm, $include_closed_p) = @_; my $key = sprintf ("%04d-%02d-%02d", $year, $month, $dotm); my @events = (); my $e0 = get_event($key, 0); my $e1 = get_event($key, 1); # If there is no daytime event, check for a repeating event. # if (!defined($e0)) { my $dotw = dotw ($dotm, $month, $year); my ($dotw_number, $total_dotws) = dotw_count ($year, $month, $dotm); $e0 = lookup_repeating_entry ($year, $month, $dotm, 1, $dotw, $dotw_number, $total_dotws); } # If there is no nighttime event, check for a repeating event. # if (!defined($e1)) { my $dotw = dotw ($dotm, $month, $year); my ($dotw_number, $total_dotws) = dotw_count ($year, $month, $dotm); $e1 = lookup_repeating_entry ($year, $month, $dotm, 0, $dotw, $dotw_number, $total_dotws); } error ("day and night events are the same?") if (defined($e0) && defined($e1) && $e0 eq $e1); if (! $include_closed_p) { # # If an event's title is "closed", then this is just there to # shadow a repeating event that would otherwise show up here. # E.g., when there's an "every thu" event but one specific day # is dark. # $e0 = undef if ($e0 && $e0->{title} =~ m/\bCLOSED\b/i); $e1 = undef if ($e1 && $e1->{title} =~ m/\bCLOSED\b/i); # Also omit cancelled / postponed events from the calendar grid. # $e0 = undef if ($e0 && $e0->{title} =~ m/\bCANCELL?ED|POSTPONED\b/i); $e1 = undef if ($e1 && $e1->{title} =~ m/\bCANCELL?ED|POSTPONED\b/i); } push @events, $e0 if defined($e0); push @events, $e1 if defined($e1); return @events; } # Returns the HTML for a calendar grid, with embedded hrefs. # sub make_calendar_grid_html($$$$$) { my ($dir, $year, $month, $prev, $next) = @_; my ($csec, $cmin, $chour, $cdotm, $cmon, $cyear) = localtime; $cmon++; $cyear += 1900; my $today; { my ($sec, $min, $hh, $dd, $mm, $yyyy) = localtime; $mm++; $yyyy += 1900; $today = ($month == $mm && $year == $yyyy) ? $dd : -1; } my $today_event = undef; my $next_event = undef; my $output = ("
    \n" . "
    \n" . ($prev ? " <<\n" : '') . ($next ? " >>\n" : '') . "
    Sun
    \n" . "
    Mon
    \n" . "
    Tue
    \n" . "
    Wed
    \n" . "
    Thu
    \n" . "
    Fri
    \n" . "
    Sat
    \n" . "
    \n" . "\n"); my $mm = sprintf("%02d", $month); my $days = days_per_month ($month, $year); my $dotm = 1; my $dotw = dotw ($dotm, $month, $year); my $did_suspension_p = 0; my $cdotw = $dotw; for (my $week = 0; $week < 6; $week++) { last if ($dotm > $days); $output .= "
    \n"; for (; $cdotw <= 6; $cdotw++, $dotm++) { my $cyear = $year; my $cmonth = $month; my $cmm = $mm; my $cdotm = $dotm; if ($cdotm > $days) { # Last week of this month, first few days of next. last unless defined($next); # last scheduled month $cdotm = $dotm - $days; $cmonth++; $cmm = sprintf("%02d", $cmonth); if ($cmonth > 12) { $cyear++; $cmonth = 1; $cmm = "../$cyear/01"; } } my $repeat_p = 0; my $suspended_p = 0; my @events = get_all_events($cyear, $cmonth, $cdotm, 0); if ($events[0] && $events[0]->{title} =~ m/SUSPENDED/i) { $suspended_p = 1; } my $class = "ccell ccell$cdotw"; my $id = ($today == $dotm ? " ID=\"today\"" : ""); $class .= " ccellN" if ($month != $cmonth); if ($suspended_p) { my $body = ''; if (! $did_suspension_p) { open (my $in, '<', "$dir/$suspension_file") || error ("$dir/$suspension_file: $!"); print STDERR "$progname: reading $dir/$suspension_file\n" if ($verbose > 2); local $/ = undef; # read entire file my $b2 = <$in>; close $in; $b2 =~ s@^.*]*>(.*).*$@$1@si; $b2 =~ s@\s*@@gs; $b2 =~ s@((HREF|SRC)=\"../)@$1../@gs; $b2 =~ s/\bccell\d\b/ccell$cdotw/s; $did_suspension_p = 1; $body = $b2; } my $id2 = "$id STYLE=\"background:#600\""; $output .= "
    $cdotm
    \n"; $output .= $body; } elsif ($#events >= 0) { my $nn = sprintf("%02d", $cdotm); my $count = 0; foreach my $e (@events) { my $key = $e->{key}; my ($yyyy, $mm, $dd) = ($key =~ m/^(\d{4})-(\d{2})-(\d{2}[ab]?)$/s); if ($#events > 0) { # use "ccella" or "ccellb" to get half-height boxes. $class .= " ccell" . (chr(ord('a') + $count)); } my $title = entitify (event_cell_title ($e)); $title =~ s@\n([^\n]*)$@$1@si; # italicize age line $output .= (" " . "
    " . ($count > 0 ? '' : "$cdotm") . $title . "
    " . "    \n"); $count++; } } else { $output .= "
    $cdotm
    \n"; } if ($today > 0 && $cdotm >= $today && !$today_event) { $today_event = $events[0]; } } $output .= "
    \n\n"; $cdotw = 0; } $output .= "
    \n"; if ($today_event) { my @thisweek_html = (); while ($today_event && @thisweek_html < 5) { my $key = $today_event->{key}; my ($yyyy, $mm, $dd, $suf) = ($key =~ m/^(\d{4})-(\d{2})-(\d{2})([ab]?)$/s); my $dotw = dotw ($dd, $mm, $yyyy); $dotw = $days[$dotw]; my $flyer = $today_event->{flyer} || ''; my $url = "$mm-$dd$suf.html"; my $title = entitify ($today_event->{title}); $title =~ s@: @:
    @si; if ($flyer) { $flyer =~ s@\.html$@-1-thumb.jpg@si; $flyer = ""; $flyer = "$flyer"; } push @thisweek_html, ("
    \n" . "
    \n" . "
    \n" . " $dotw\n" . " $title\n" . "
    \n" . " $flyer\n" . "
    \n" . "
    \n"); $today_event = $today_event->{next_event}; } $output .= ("\n

    \n" . "

    \n" . " \n" . " This Week!\n\n" . "
    \n" . join ("\n", @thisweek_html) . "
    \n" . "
    \n" . "
    \n"); } return $output; } ############################################################################## # # Generating full calendar body text and html # ############################################################################## # Constructs an EMBED tag from a YouTube URL. # sub make_embed_tag($$$$) { my ($url, $title, $w, $h) = @_; my ($id, $url2, $url3); if ($url =~ m@^http://www\.youtube\.com/@) { error ("extra junk in youtube URL: $url") if ($url =~ m/\&|\?.*\?/); $url =~ s@&.*$@@; # lose args $url =~ s@/(watch)?\?v=@/embed/@; # "/watch?v=XXX" => "/embed/XXX" } else { error ("VIDEO URL is not YouTube: $url"); } return ("
    " . # Note: rewritten by DNA::Menuify "
    " . "" . "
    " . "
    \n"); } sub url_quote($) { my ($u) = @_; $u =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge; return $u; } # Given an event returns two listrefs of related events: past and future. # "Future" means "later than the current day", not the day of the event. # "Past" means "earlier than the current day", but prefers events that # are near the given event in time. So this is not a simple list of # the N events that come just before and just after this one. It's more # complicated, but also more useful. # sub find_similar_events($$$) { my ($event, $nfuture, $npast) = @_; my @future = (); my @past = (); my ($sec, $min, $hour, $dotm, $mon, $year) = localtime (time); $mon++; $year += 1900; my $now = sprintf("%04d-%02d-%02d", $year, $mon, $dotm); my $future = undef; my $past = undef; my $past_p = 0; $future = $event; if (calendar_id_cmp ($now, $event->{key}) >= 0) { # The base event is in the past. Find the first event after it # that is at or after today's date. $past_p = 1; while ($future && calendar_id_cmp ($now, $future->{key}) >= 0) { $future = $future->{next_similar}; } } else { # The base event is in the future. Find the last event before it # that is not before today's date. my $prev = undef; while ($future && calendar_id_cmp ($now, $future->{key}) <= 0) { $prev = $future; $future = $future->{prev_similar}; } if ($prev && $future && calendar_id_cmp ($now, $future->{key}) > 0) { $future = $prev; # If we've wandered into the past, step back. } } $past = $future || $event; # Gotta start somewhere # Now we have the first event at or after today in $future, # and the first event at or before today in $past. # Save away N following events. # Remember their IDs so that we don't duplicate them. # This can happen if there are only a few events. # my %mentioned; $mentioned{$event->{key}} = 1; # Always omit the base event while ($future && @future < $nfuture) { push @future, $future unless ($mentioned{$future->{key}}); $mentioned{$future->{key}} = 1; $future = $future->{next_similar}; } # Now we want N events that are near the base event, but are in the past. # We do this by walking both forward and backward from that event, adding # to the beginning and end of the list, until we have enough. We stop # adding future events if we have "today". This results in the window # of N events being centered on the base event, except when that window # would butt up against "today" or "beginning of time". # If the event is in the past, start there. Else, start at $past. $past = $event if ($past_p); $future = $past; while ($future || $past) { if ($future && calendar_id_cmp ($now, $future->{key}) <= 0) { $future = undef; # We've hit the current day. Stop moving forward. } if ($future) { # put it on the front unshift @past, $future unless ($mentioned{$future->{key}}); $future = $future->{next_similar}; last if (@past >= $npast); } if ($past) { # put it on the back push @past, $past unless ($mentioned{$past->{key}}); $past = $past->{prev_similar}; last if (@past >= $npast); } } return (\@future, \@past); } # Returns the HTML for a single calendar event. # sub build_event_html($$$) { my ($event, $future_p, $tickets_form_p) = @_; my $key = $event->{key}; my $date = $event->{date}; my $times = $event->{times}; my $holiday = $event->{holiday} || ''; my $title = $event->{title}; my $otitle = $title; my $title_url = $event->{title_url}; my $repeat = $event->{repeat} || ''; my $flyer = $event->{flyer} || ''; my $photo = $event->{photos} || ''; my $galleries = $event->{galleries}; my $video = $event->{video} || ''; my $pres = $event->{pres} || ''; my $genre = $event->{genre} || ''; my $time = $event->{time} || ''; my $age = $event->{age} || ''; my $price = $event->{price} || ''; my $html = $event->{html_out} || ''; if ($tickets_form_p == 2) { # this means "allow advance ticket sales" $tickets_form_p = 0; } my ($year, $mm, $dotm) = @$times; my $dotw = dotw ($dotm, $mm, $year); my ($dd) = ($key =~ m/^\d{4}-\d{2}-(\d{2}[ab]?)$/s); my $url = sprintf ("%scalendar/%04d/%02d-%s.html", $url_base, $year, $mm, $dd); my $month = $months[$mm-1]; $dotw = $days[$dotw]; my $date_html = sprintf ("%s, %s %0d", $dotw, $month, $dotm); # break the line after day name # $date_html =~ s/, /\n/gs; # break the line before "afternoon". $date_html =~ s/ (Morning|Afternoon|Night)\b/\n$1/i; $date_html =~ s/\n/
    /gs; my $blurb = ''; if ($html =~ s@
    \s* ( <(BR|P)> \s* )* (.*)@@six) { $blurb = $3; } $html = '' unless ($html =~ m/[^\s]/); $blurb = '' unless ($blurb =~ m/[^\s]/); # Compute a tag by stripping down the first few # sentences of the blurb to plain text. # { my $meta = $blurb; $meta =~ s/\s+/ /gsi; $meta =~ s@(]*>\s*)+@\n@gsi; # split at paras $meta =~ s@<[^<>]*>@@gsi; $meta =~ s@([.?!]\s+)@$1\n@gsi; # split at sentences my @paras = split(/\n/, $meta); my $max = 155; $meta = ''; foreach my $p (@paras) { next if ($p =~ m/^\s*$/si); $meta .= "$p "; last if (length ($meta) > $max); } $meta =~ s/\"/"/gsi; $meta =~ s/\s+/ /gsi; $meta =~ s@^\s+|\s+$@@si; $Text::Wrap::columns = 77; $meta = wrap ("\t\t", "\t", $meta); $meta =~ s@^\s+|\s+$@@si; $event->{meta_desc} = $meta; } my $tickets = $event->{tickets}; if ($tickets) { my $first_onsale_date = undef; my $vip_txt = undef; my $out = ''; my $vip_blurb = "(What's this?)"; foreach my $t (@$tickets) { my ($ticket, $desc, $price, $onsale, $offsale, $vip_p) = @$t; my $off_p = ticket_off_sale_p ($event, $onsale, $offsale); if ($off_p < 0) { # not on sale yet $ticket = undef; $first_onsale_date = $onsale unless defined($first_onsale_date || $out); } elsif ($off_p > 0) { # no longer on sale $ticket = undef; } elsif ($vip_p && !$desc) { $desc = "VIP Service: $vip_price"; } elsif (!$desc) { $desc = ($tickets_form_p ? "Buy Tickets" : "Buy tickets now!"); } if (!$ticket) { } elsif ($tickets_form_p) { my ($id) = ($ticket =~ m/\bitem=(\d+)/s); $out .= ("
    \n" . " \n" . " \n" . " \n" . ($vip_p ? "\n$vip_blurb\n" : "") . "
    \n"); } else { $out .= ("" . "$desc" . ($vip_p ? "
    $vip_blurb" : "") . "
    "); } } if (!$out && $first_onsale_date) { my $s = strftime ("%b %d", localtime($first_onsale_date)); $out = "Tickets on sale $s."; } $tickets = $out; } $tickets = '' unless $tickets; if ($video) { $video = make_embed_tag ($video, $event->{videoname}, undef, undef); $video =~ s/\s+/ /gs; $video = "
    $video
    "; } if ($galleries) { my $ghtml = ''; my $count = 0; my @used = (); my $max = 6; for ($count = 0; $count < $max; $count++) { my $gal = pop @$galleries; last unless $gal; unshift @used, $gal; $ghtml .= ("" . "" . ""); } # put the ones we consumed back at the other end of the queue. unshift @$galleries, @used; # No galleries unless we got a full line. $ghtml = '' unless ($count == $max); $ghtml = "
    $ghtml
    " if ($ghtml); $galleries = $ghtml; } else { $galleries = ''; } my $fimg = undef; if ($flyer) { $flyer = "../../$flyer"; $fimg = $flyer; $fimg =~ s@\.html$@-m.jpg@si; $flyer = ""; $flyer = "
    $flyer
    \n"; } my $share = make_event_id_links ($event, $future_p) || ''; my $fblike = make_fblike_link ($event); $time =~ s/(&[a-z\d]+;)/$1\001/gsi; # kludge to protect entities. $price =~ s/(&[a-z\d]+;)/$1\001/gsi; $time =~ s/;\s+/;
    /gs; # break after semicolons. $price =~ s/;\s+/;
    /gs; $time =~ s/\.\s+/.
    /gs; # break after sentences. $price =~ s/\.\s+/.
    /gs; $time =~ s/\001//gs; $price =~ s/\001//gs; $price =~ s@(gen\.)\s*
    \s*(adm)@$1 $2@gsi; # blah. if (!$age) { } elsif ($age eq 'AA') { $age = "all ages."; } elsif ($age eq '18') { $age = "$age+."; } else { $age = "$age+."; } if ($time) { # hcalendar microformat nonsense. Using is required for the # date fields, but we don't have 3 easily-parsable pieces of text to # hang the fields on. Also, that causes there to be an annoying # tooltip over whatever text we do wrap in . # # So, use null text inside the and hope that works, even # though the hcalendar validator warns about it. # # Also, I'm not sure this is a legal usage of "tzid" here. # my ($ical_start, $ical_duration, $tz) = ical_dtstart ($event); $time = ("" . "" . "" . $time); } if ($photo) { $photo = "../../$photo"; $photo = ("
    " . "" . "Photo Gallery:" . "" . "" . "
    \n"); } my $awards = find_awards ($pres, $title, 1, 0) || ''; my $groups = find_awards ($pres, $title, 1, 1) || ''; # Assume if we're not doing a tickets form, we're on a white background... my $title_img = find_title_image ($title, $tickets_form_p); my $sub; $title = entitify($title); #### because of the stupid title parser $sub = $2 if ($title =~ s/^(.*?):\s+(.*)$/$1/si); my $title_class = 'event_title_box summary'; # hcalendar if ($title_img) { $title = "\"$title\"
    "; } # Leave subtitle out of link. $title = "$title" if $title_url; if ($sub) { $title .= ":
    " unless $title_img; # break after colons $title .= $sub; } $title = "
    $title
    "; $title = "
    $pres
    $title" if ($pres); $title = "
    $title
    \n"; $date_html = "
    $date_html
    \n"; $holiday = "
    $holiday
    \n" if ($holiday); $repeat = "
    And $repeat
    \n" if ($repeat); $genre = "
    $genre
    \n" if ($genre); $time = "
    $time
    \n" if ($time); $age = "
    $age
    \n" if ($age); $price = "
    $price
    \n" if ($price); $tickets = "
    $tickets

    \n" if ($tickets); $awards = "
    $awards
    \n" if ($awards); $share = "
    $share
    \n" if ($share); $fblike = "
    $fblike
    \n"; # Append the "Join the Facebook group" stuff to the blurb, if there is one. # $blurb .= "\n

    $groups" if ($blurb && $groups); my $stats_top = ("

    \n" . "
    \n" . $date_html . $holiday . $repeat . $time . $genre . $age . $price . "
    \n" . "
    \n"); my $stats_bot = $stats_top; $stats_bot =~ s/_top\b/_bottom/gs; $stats_top = '
    ' unless ($tickets_form_p); # Kludge for weekly.html my $event_output = ("
    \n" . # hcalendar "\n" . # hcalendar $title . $stats_top . $flyer . $video . $awards . $galleries . "
    \n" . $stats_bot . "
    \n" . "
    \n" . $tickets . $fblike . $share . $photo . "
    \n" . "
    \n" . "
    \n" . # hcalendar "
    \n" . " $html\n" . "
    \n" . "
    \n" . " $blurb\n" . "
    \n" . "
    \n" . "
    \n"); $event_output = clean_html ($date, $event_output); $mm = sprintf("%02d", $mm); $month =~ s/^(...).*$/$1/s; my $links .= (" \n" . " \n" . " \n" . " \n" . " \n" . $xml_link_tag); my $left = ''; my $related = ''; $otitle =~ s/:\s.*$//s; { my $p1 = $event->{prev_event} || ''; my $n1 = $event->{next_event} || ''; my $p2 = $event->{prev_similar} || ''; my $n2 = $event->{next_similar} || ''; my $EE = sub($) { my ($e) = @_; return unless $e; my ($eyear, $emm, $edotm) = @{$e->{times}}; my ($edd) = ($e->{key} =~ m/^\d{4}-\d{2}-(\d{2}[ab]?)$/s); my $emonth = $months[$emm-1]; $emonth =~ s/^(...).*$/$1/gsi; # If the previous event has a subtitle, and the same title as this # event, omit the event name and show only the title. # my $tt = $e->{title}; $tt =~ s/^\Q$otitle\E:\s+//s; my $date = "$emonth $edotm"; my $date2 = "$edotm $emonth $eyear"; my $date3 = $date; # If the linked event is not in this event's year, and is more than # N months away from it, display the year instead of day/month. # my $max = 9; # months if ($year != $eyear && abs(($year * 12 + $mm) - ($eyear * 12 + $emm)) > $max) { $date3 = $eyear; } $e = [ sprintf ("../%04d/%02d-%s.html", $eyear, $emm, $edd), $edotm, $date, $date2, $date3, entitify ($tt) ]; }; $p1 = &$EE ($p1); $n1 = &$EE ($n1); # HEAD LINKs # my $s = ' ' . "\n"; $links .= sprintf ($s, 'prev', $p1->[0], $p1->[3], $p1->[5]) if $p1; $links .= sprintf ($s, 'next', $n1->[0], $n1->[3], $n1->[5]) if $n1; # LEFT nav links # $s = '%s'; $p1 = sprintf ($s, $p1->[0], 'navL', $p1->[5], "<< " . $p1->[1]) if ($p1); $n1 = sprintf ($s, $n1->[0], 'navR', $n1->[5], $n1->[1] . " >>") if ($n1); $left = (($p1 || '') . ($n1 || '') . sprintf ('
    %s
    ', $mm, $month)); # "Upcoming related" links # my $max = 6; my ($upcoming, $previous) = find_similar_events ($event, $max, $max); my @upcoming = $upcoming ? @$upcoming : (); my @previous = $previous ? @$previous : (); $s = '
  • %s: %s
    • '."\n"; foreach my $e (@upcoming) { $e = &$EE ($e); $e = sprintf ($s, $e->[0], $e->[2], $e->[5]); } foreach my $e (@previous) { $e = &$EE ($e); $e = sprintf ($s, $e->[0], $e->[4], $e->[5]); } $related .= ("Upcoming related events:
      \n" . join ('', @upcoming) . "
    \n") if @upcoming; $related .= ("Past related events:
      \n" . join ('', @previous) . "
    \n") if @previous; $related = ("
    " . "
    $related
    ") if $related; } # Use the flyer as the thumbnail for this page for Facebook. # if ($fimg) { $fimg = DNA::Menuify::expand_url ($fimg, $url); $links .= " \n"; } my $related_bottom = $related; $related_bottom =~ s/_top\b/_bottom/gi; $related_bottom = '' unless ($tickets_form_p); # Kludge for weekly.html $month =~ s/^(...).*$/$1/gsi; $dotw =~ s/^(...).*$/$1/gsi; my $ptitle = sprintf ("DNA Lounge: %s, %d %s %04d (%s)", entitify ($event->{title}), $dotm, $month, $year, $dotw); $event_output = ("\n" . " $ptitle\n" . $links . "\n" . "\n" . "\n" . $left . $related . "\n\n" . $left . "\n" . $event_output . $related_bottom . "\n" . "\n"); return $event_output; } # Returns the plain text for a single calendar event. # sub build_event_text($$$$$$$) { my ($event, $date_p, $future_p, $infoline_p, $long_lines_p, $day_prefix, $day_suffix) = @_; my $pres = $event->{pres} || ''; my $title = $event->{title}; my $holiday = $event->{holiday}; my $flyer = $event->{flyer}; my $photo = $event->{photos}; my $times = $event->{times}; my $tickets = $event->{tickets}; my $embed = $event->{video}; my $genre = $event->{genre} || ''; my $time = $event->{time} || ''; my $age = $event->{age} || ''; my $price = $event->{price} || ''; my $src = $event->{text_out} || ''; my ($year, $month, $dotm) = @$times; my $output = ""; my $m = $months[$month-1]; $m =~ s/^(...).*/$1/ unless ($infoline_p); $src =~ s@\s*---------+\n.*$@@s if ($infoline_p); # nuke blurb # If there is a blurb, append the Facebook group links. # if ($src =~ m/^--------+$/m) { my $groups = find_awards ($pres, $title, 0, 1); $src .= "\n\n$groups" if ($groups); } my $reformat_p = ($src =~ m/^Performing live:/mi); foreach ($price) { $_ = de_entify($_); s@.*?@@gs; s/<[^<>]*>//gs; s/\s+/ /gs; s/^\s+|\s+$//gm; } my $headers = ''; foreach ($time, $genre) { s@<@<@gs; s@>@>@gs; s@&@&@gs; s@\s+@ @gs; s@^\s+|\s+$@@gs; s@<[^<>]*>@@gs; } $age =~ s@^(18|21)$@$1$age_text@gsi; # convert to english. $age =~ s@^AA$@$age_aa_text@gsi; $title =~ s@\s+@ @gs; $title =~ s@^\s+|\s+$@@gs; if ($pres) { $pres =~ s@<[^<>]+>@@g; $pres =~ s@\s+@ @gs; $pres =~ s@^\s+|\s+$@@gs; $pres = de_entify($pres); } $title = upcase_html($title) unless $infoline_p; $title = de_entify($title); # newlines after semicolons/sentences. $time =~ s/([;!.])\s+/$1\n/gsi if $time; $price =~ s/([;!.])\s+/$1\n/gsi if $price; $price =~ s@(gen\.)\s*(adm)@$1 $2@gsi; # blah. if (! $reformat_p) { $headers .= "$pres\n\n" if $pres; $headers .= "$title\n\n"; } $headers .= "$genre\n\n" if $genre; $headers .= "$time\n\n" if $time; $headers .= "$age\n\n" if $age; $headers .= "$price\n\n" if $price; $headers =~ s/\s+$//s; if (! $infoline_p) { $headers =~ s/\n\n+/\n/sg; # delete blank lines # but put one back after capwords (including cap acronyms and posessives.) $headers =~ s/([[:upper:]][.\']?[[:upper:]] [ \t]*[[:upper:]\d]* [ \t]*[.,+&]?:?)$/$1\n/xmg; # Total kludge for a night with a single character name... $headers =~ s/^(Q)$/$1\n/mg; } # put some URLs between the head and the tail. # the flyer URL always come first. # my @event_urls; if (! $infoline_p) { my $u = $event->{title_url}; push @event_urls, $u if $u; my $flyer = $event->{flyer}; if ($flyer) { $flyer = "$url_base$flyer"; unshift @event_urls, $flyer; } push @event_urls, $embed if ($embed); } if ($reformat_p) { $src .= "\n\n$headers"; $headers = ''; } if ($#event_urls >= 0) { my $u = ''; # only include each URL once # (in case the event URL is the same as one of the band URLs.) foreach (@event_urls) { $u .= "$_\n" unless ($src =~ m/\Q$_\E/i); } if ($reformat_p) { $src = "$src\n\n$u"; } else { $src = "$u\n\n$src"; } } if ($future_p && !$infoline_p) { if ($tickets) { my $ticket_txt = ""; my $vip_txt = ""; my $ticket_count = 0; my $first_onsale_date = undef; foreach my $t (@$tickets) { my ($ticket, $desc, $price, $onsale, $offsale, $vip_p) = @$t; my $off_p = ticket_off_sale_p ($event, $onsale, $offsale); if ($off_p < 0) { # not on sale yet $first_onsale_date = $onsale unless defined($first_onsale_date || $ticket_txt); } elsif ($off_p > 0) { # no longer on sale } elsif ($vip_p) { $vip_txt = ("VIP Service:" . ((length ($ticket) > 59) ? "\n" : " ") . "$ticket\n"); } elsif ($desc) { $desc = de_entify($desc); $ticket_txt .= "\n $desc: $ticket"; } else { $ticket_txt .= ((length ($ticket) > 59) ? "\n" : " "); $ticket_txt .= "$ticket\n"; } } if ($ticket_txt) { $ticket_txt = "Tickets:$ticket_txt"; } elsif ($first_onsale_date) { my $s = strftime ("%b %d", localtime($first_onsale_date)); $ticket_txt = "Tickets on sale $s."; } $ticket_txt .= ($ticket_txt ? "\n\n" : "") . $vip_txt; $src .= "\n\n$ticket_txt" if $ticket_txt; } } $output .= "$headers\n\n" if $headers; $output .= $src; # Indent all lines following a line ending with colon and a blank line. # Also lines beginning with "main room:" or "lounge:". # $output =~ s@( (?: ^ | \n ) (?: [^\n]+?: | Main \s Room: [^\n]* | Lounge: [^\n]* | Performing \s Live \b [^\n]* ) \n\n) ( (?: [^\n]+ (?: \n | $) )+ ) @{ my ($head, $para) = ($1, $2); $para =~ s/^/ /gm; $head . $para; }@gsexi; # Lose blurb HR. $output =~ s/----------+\n+//s; $output =~ s/^/ /mg; $output =~ s/[ \t]+$//gm; $output =~ s/(\n\n)\n+/$1/gs; # compress multiple blank lines $output =~ s/^\n+//s; $output =~ s/\n+$//s; if (! $long_lines_p) { $Text::Wrap::columns = 70; $Text::Wrap::unexpand = 0; $Text::Wrap::huge = 'overflow'; # If any line is long, and ends in a parenthesized clause, # break the line before the open paren, and indent. # my @lines = split(/\n/, $output); foreach my $line (@lines) { if (length($line) > $Text::Wrap::columns) { $line =~ s@^(\s*)(.*) (\(.*\))$@$1$2\n$1 $3@s; } } $output = join("\n", @lines); $output =~ s/ --(\n +http:)/$1/gsi; # if we wrapped url, lose dashes # Finally, wrap each long line. # @lines = split(/\n/, $output); foreach my $line (@lines) { if (length($line) > $Text::Wrap::columns) { $line =~ s/^(\s*)//s; $line = wrap ($1, $1, $line); } } $output = join("\n", @lines); # Try to line up the URLs. # $output =~ s@^(.*?) (\s -- \s http:.*)$@{ my ($a, $b) = ($1, $2); my $c = 20; my $L = length($a); $a .= (' ' x ($c-$L)) if ($L < $c); $a . $b; }@gmexi; } $output = reformat_infoline ($output) if ($infoline_p); if ($date_p) { my $d = $event->{date}; # the dotw desc (e.g., "Sunday Night") is $d =~ s/^([^,]+),.*$/$1/s; # the first set of words before the comma. $d = "$day_prefix $d" if (defined ($day_prefix)); $d = "$d -- $day_suffix" if (defined ($day_suffix)); if (defined($holiday) && !$infoline_p) { $holiday =~ s@
    @ @gi; $holiday =~ s@<[^<>]+>@@g; # strip any tags in holiday text $d .= " -- $holiday"; } # slightly rewrite if there's a day suffix and a holiday. $d =~ s/^(.*) -- (.*) -- (.*)$/$1 -- $2, $3/; if ($infoline_p) { $output = sprintf("\n$d, $m $dotm.\n\n") . $output; } else { $output = ("\n" . ('-' x 72) . "\n\n" . sprintf("%02d $m $year ($d)\n\n", $dotm) . $output); } } return "$output\n"; } # Returns the crontab text for a single calendar event. # sub build_event_crontab($) { my ($event) = @_; my $title = $event->{title}; my $webcast = $event->{webcast}; return '' if ($webcast eq 'off'); my $times = $event->{times}; my ($year, $month, $dotm, $dotw, $start_minute, $end_minute, $webcast_end_minute) = @$times; my $days_in_month = days_per_month ($month, $year); my $flyer = $event->{flyer} || ''; $flyer =~ s@^flyers/@@s; $title = asciify ($title); my $length = $webcast_end_minute - $start_minute; my $shour = int($start_minute / 60); my $smin = int($start_minute % 60); my $key = $event->{key}; my $ct = sprintf ("%2d %2d %2d %2d * ", $smin, $shour, $dotm, $month); $length = sprintf("%d:%02d", int($length / 60), int($length % 60)); $ct .= "ID=$key LENGTH=$length FLYER=$flyer TITLE=\"$title\"\n"; # mktime: dotm: 1-31; month: 0-11; year: -1900; dotw: 0-6. # cron: dotm: 1-31; month: 1-12; year: n/a. dotw: 0-6; my $stime = mktime (0, $smin, $shour, $dotm, $month-1, $year-1900, 0, 0, -1); my $etime = $stime + (($webcast_end_minute - $start_minute) * 60); my ($esec, $emin, $ehour, $edotm, $emon, $eyear) = localtime ($etime); my $ct2 = sprintf ("%2d %2d %2d %2d * ", $emin, $ehour, $edotm, $emon+1); $ct2 .= "END\n"; $ct .= $ct2; if ($verbose > 3) { my $d = "$dotm-$months[$month-1]-$year"; my $s = sprintf("%d:%02d %s", ($shour == 0 ? 12 : $shour > 12 ? $shour - 12 : $shour), $smin, ($shour < 12 ? "AM" : "PM")); $_ = $length; my ($lh, $lm) = m/^(\d\d?):(\d\d)$/; my $ee = ($shour * 60) + $smin + ($lh * 60) + $lm; my $ehour = int ($ee / 60) % 24; my $emin = int ($ee % 60); my $e = sprintf("%d:%02d %s", ($ehour == 0 ? 12 : $ehour > 12 ? $ehour - 12 : $ehour), $emin, ($ehour < 12 ? "AM" : "PM")); $_ = $ct; s/^/$progname: crontab: /gm; s/\n$/ ($d: $s - $e)\n/s; print STDERR "$_"; } return $ct; } # Return a string with leading whitespace added so as to center the given # text within 72 columns. # sub center_line($) { my ($line) = @_; my $cols = 72; # $fill_column ? $line = (' ' x int(($cols - length($line)) / 2)) . $line; return $line; } # Constructs files describing the given month. Returns: # - the body of an HTML document; # - the body of a text document. # - a hash of "NN" -> HTML for that single event page. # If $summarize_only_p, then only generates the @future_events list. # sub build_month_bodies($$$$$$) { my ($dir, $year, $month, $prev_p, $next_p, $summarize_only_p) = @_; my $month_html = ""; my $month_text = ""; my %event_html; my %event_meta; my ($csec, $cmin, $chour, $cdotm, $cmon, $cyear) = localtime; $cmon++; $cyear += 1900; my $now_i = ($cyear * 100000000 + $cmon * 1000000 + $cdotm * 10000 + $chour * 100 + $cmin); my $mon_i = ($year * 100000000 + $month * 1000000 + 32 * 10000); my $thismonth_p = ($cmon == $month && $cyear == $year); ###################### # Generate html header ###################### $month_html .= "$page_title: $months[$month-1] $year\n"; my ($header, $prev, $next, $prev_name, $next_name) = build_cal_header ($year, $month, $prev_p, $next_p); my $grid = make_calendar_grid_html ($dir, $year, $month, $prev, $next); my $links = ''; $links .= (" \n" . " \n" . " \n" . " \n" . " \n" . $xml_link_tag); $links .= " \n" if ($prev); $links .= " \n" if ($next); $month_html .= $links; $month_html .= (# # JS to remap "YYYY/MM.html#DD" => "YYYY/MM-DD.html" # "\n" . "\n" . "$header\n" . "\n" . "\n" . "\n" . "$months[$month-1] $year\n\n" . $grid . "\n" ); # update the "d30" IDs in the CSS, in the same manner as # calendar/update-calboxes.pl... # my $dd = ($thismonth_p ? $cdotm : 0); $month_html =~ s/^( *(\.[a-z\d]+)?#d)\d\d?\b/$1$dd/gm; ############################ # Generate plain text header ############################ my $hr = center_line('-' x 24) . "\n"; $month_text .= "$hr\n"; $month_text .= center_line($page_title) . "\n"; $month_text .= center_line($months[$month-1] . " $year") . "\n"; $month_text .= "\n$hr\n"; $month_text .= center_line(sprintf ("${url_base}calendar/$year/%02d.html", $month)) . "\n"; ################################ # Loop over body events for both ################################ my $days = days_per_month ($month, $year); my @future_events_1 = (); # the event just before the "today" cutoff time my $month_yesterday_event = undef; # Parse the "--only" option, if any. # my @target_date; my $found_target_p = 0; if ($summarize_only_p ne 0 && $summarize_only_p ne 1) { my ($dd, $mmm, $yyyy, $two) = ($summarize_only_p =~ m/^(\d\d?)[-\s]+([a-z]{3}[a-z]*)[-\s]+(\d{4})\s*(#2)?$/si); error ("unparsable --only \"$summarize_only_p\"") unless $yyyy; @target_date = ($dd+0, $monthvals{lc($mmm)}, $yyyy+0, ($two ? 2 : undef)); } for (my $dotm = 1; $dotm <= $days; $dotm++) { if ($target_date[0]) { # --only was specified if ($dotm == $target_date[0] && $month == $target_date[1] && $year == $target_date[2]) { $found_target_p = 1; } else { next; } } my @events = get_all_events ($year, $month, $dotm, 1); # Kludge for suspension if ($events[0] && $events[0]->{title} =~ m/SUSPENDED/i) { @events = (); } my $event_number = 1; foreach my $event (@events) { my $times = $event->{times}; my $cancelled_p = ($event->{title} =~ m/(CANCELL?ED|POSTPONED|CLOSED|SUSPENDED)\b/i); my ($igy, $igm, $igdm, $igdw, $start_minute) = @$times; my $hour = int ($start_minute / 60); my $min = int ($start_minute % 60); # Events go on @future_events if the event starts today or later. # That controls what goes on the front page. # my $event_i = $year * 100000000 + $month * 1000000 + ($dotm+1) * 10000; my $future_p = ($event_i >= $now_i); push @future_events_1, $event if ($future_p && !$cancelled_p); $month_yesterday_event = $event # save the last "past" event unless ($future_p || $cancelled_p); # Found our --only date. if ($found_target_p && ($target_date[3] ? $event_number == 2 : 1)) { print STDOUT build_event_html ($event, $future_p, 1); return (); } if (!$summarize_only_p) { $month_text .= build_event_text ($event, 1, $future_p, 0, 0, undef, undef); my $key = $event->{key}; $key =~ s/^\d{4}-\d\d-//s; my $html = build_event_html ($event, $future_p, 1); my $meta = $event->{meta_desc}; $meta = " \n" if $meta; $html = "$meta$html"; # If the event is cancelled, only write the file if the file exists # already. Overwrite existing files, but don't create new ones # if the cancelled event hasn't been published yet, or has been # deleted. # $html = "-$html" if ($cancelled_p); $event_html{$key} = $html; } $event_number++; } } # put this together backwards, since the order in which we generate # the calendar pages is later months to earlier months. # (the order is Dec01 ... Dec31, Nov01 .. Nov31, etc.) # unshift @future_events, @future_events_1; $yesterday_event = $month_yesterday_event unless ($yesterday_event); # Only needed to compute future_events in --summarize-only mode, # don't need to finish constructing the page. return () if ($summarize_only_p); ###################### # Generate text footer ###################### $month_text .= "\n" . ('-' x 72) . "\n"; # $fill_column ? if ($month_text =~ m/(&[a-z]+;)/i) { error ("$year-$month: stray entity: \"$1\""); } return ($month_html, $month_text, \%event_html); } # Writes files describing the given month: # # - calendar/YYYY/MM.html # - calendar/YYYY/MM.txt # - calendar/YYYY/MM-DD.html # # If $summarize_only_p, doesn't actually write any files (but does some # other necessary work for the tickets pages, etc.) # sub write_month_bodies($$$$$$$) { my ($dir, $year, $month, $outfile, $prev_p, $next_p, $summarize_only_p) = @_; my ($month_html, $month_text, $days_html) = build_month_bodies ($dir, $year, $month, $prev_p, $next_p, $summarize_only_p); return if ($summarize_only_p); DNA::Menuify::write_file ($outfile, $month_html); my $txtfile = $outfile; $txtfile =~ s/\.html$/.txt/ || error ("no text version of $outfile?"); DNA::Menuify::write_file ($txtfile, $month_text); foreach my $day (sort (keys %$days_html)) { my $html = $days_html->{$day}; my $cancelled_p = ($html =~ s/^-//s); my $day_file = $outfile; $day_file =~ s@(\.[^/.]+)$@-$day$1@si; if ($cancelled_p && ! -f $day_file) { print STDERR "$progname: skipping cancelled: $day_file\n" if ($verbose > 2); next; } DNA::Menuify::write_file ($day_file, $html); } } # Returns a one liner describing this event, if there are live bands. # Plain text. # sub event_live_show_summary($) { my ($event) = @_; my $bands = compute_band_based_title ($event, 0, 0); return "" if (!defined ($bands)); $bands = de_entify ($bands); my $times = $event->{times}; my ($year, $month, $dotm, $dotw) = @$times; $month = $months[$month-1]; $month =~ s/^(...).*/$1/; $dotw = $days[$dotw]; $dotw =~ s/^(...).*$/$1/; my $date = sprintf ("%s, %s %02d", $dotw, $month, $dotm); return "$date -- $bands\n"; } # If this event has live bands, return a comma-separated list # off all those bands. Else undef. # sub compute_band_based_title($$$) { my ($event, $only_one_p, $event_first_p) = @_; my $result = undef; # If an event has bands, but also has a tag, then use the name # of the event rather than computing one from the list of bands. This # is so that, for example, "Battle of the Bands" can be called that # instead of being named after the unknown "headliner". # if (($event->{live_p} || 0) & 1) { $result = $event->{title}; } my $html = ""; if (! $result) { my @bands = (); foreach my $p (@{$event->{performers}}) { my ($name, $type) = @$p; if ($type eq 'BAND') { push @bands, de_entify ($name); last if ($only_one_p); } } if ($#bands >= 0) { $result = join (", ", @bands); # If the event description doesn't begin with "Performing live:" then # this is probably a band playing at a club night, so mention the event # name too. # my $traditional_live_show = ($html =~ m/^\s*(<[^>]*>\s*)*Performing live:/si); my $mention_event_name = !$traditional_live_show; # Dept. of Redundancies Dept. my $tt = $event->{title}; $mention_event_name = 0 if ($result =~ m/\Q$tt\E/si); if ($mention_event_name) { my $t = $event->{title}; $t =~ s/: .*$//s; # lose subtitle after colon if ($event_first_p) { $result = "$t (with $result)"; } else { $result = "$result (at $t)"; } } } } if (! $event_first_p) { # whether this is "Next event:" #### Kludge: no need to front-page-hype a band who plays here twice a month. return undef if ($result && $result =~ m/Smash-Up Derby \(at Bootie/si); } #### Kludge: Smash-Up is at Bootie all the time. Omit. $result =~ s/^(Bootie\b.*) \(with Smash-Up Derby\)$/$1/si if $result; return $result; } # Returns the subset of @future_events that have tickets for sale, # or that are live bands, or both. # sub ticket_events($$) { my ($bands_p, $tickets_p) = @_; my @result = (); foreach my $event (@future_events) { if ($bands_p && $event->{live_p}) { push @result, $event; } else { my $tix_p = 0; my $tickets = $event->{tickets}; if ($tickets) { foreach my $t (@$tickets) { my ($ticket, $desc, $price, $onsale, $offsale, $vip_p) = @$t; $tix_p = 1 unless $vip_p; # VIP tickets only don't count. } } push @result, $event if ($tickets_p && $tix_p); } } return @result; } # Find the %%LEFT%% text from the store pages (the table that has links # to the shopping cart and order status pages) so that we can have those # links on the tickets/index.html page without having to duplicate that # HTML here too. # sub load_store_blurb($) { my ($dir) = @_; my $file = "$dir/$store_file"; 1 while $file =~ s@[^/]+/\.\./@@g; open (my $in, '<', $file) || error ("$file: $!"); print STDERR "$progname: reading $file\n" if ($verbose > 2); local $/ = undef; # read entire file my $body = <$in>; close $in; my ($blurb) = ($body =~ m@(.*?)@s); $blurb = '' unless defined ($blurb); $blurb =~ s/^\s+//s; $blurb =~ s/\s+$//s; error ("no %%LEFT%% in $file") unless ($blurb =~ m/./); $blurb .= "\n"; return $blurb; } # Loads the template file and constructs our etc from it. # This is used for the overview.html and upcoming.html files. # sub load_template() { $body_template = ''; my $template_file = $DNA::Menuify::template_file; open (my $in, '<', $template_file) || error ("$template_file: $!"); print STDERR "$progname: reading $template_file\n" if ($verbose > 3); local $/ = undef; # read entire file $body_template = <$in>; close $in; # lose everything inside $body_template =~ s@(]*>).*(.*)$@$1\n $2@si; $body_template =~ s@^\s*\s*\n@@gmi; # bleh. $body_template =~ s@%%ROOT%%@../@gs; } # Write the tickets/index.html file. # sub generate_tickets_html($) { my ($dir) = @_; my @tickets = ticket_events (0, 1); # tickets only (not bands too) my @portal_html; my @rcnt_html; my @live_html; my @other_html; foreach my $dir (sort keys (%portal_dirs)) { my $title = $portal_dirs{$dir}; next if ($title eq 1); # Not a real portal directory, e.g., CVS. my $title_img = find_title_image ($title, 1); if ($title_img) { $title = "\"$title\"
    "; } $title = "$title"; $title = "
    $title
    " unless $title_img; push @portal_html, "
    $title
    \n\n"; } foreach my $event (@tickets) { my $title = $event->{title}; my $times = $event->{times}; my $live_p = $event->{live_p}; my $date = $event->{date}; my $tickets = $event->{tickets}; my ($year, $month, $dotm) = @$times; my ($dd) = ($event->{key} =~ m/^\d{4}-\d{2}-(\d{2}[ab]?)$/s); my $url = sprintf ("../calendar/%04d/%02d-%s.html", $year, $month, $dd); $date =~ s/^([a-z]{3})[a-z]* (\s+[a-z]+)? ,? \s (\d\d?) \s ([a-z]{3}) [a-z]* \s \d{4} $ /$1, $4 $3/six; if ($live_p) { my $t2 = compute_band_based_title ($event, 0, 0); if ($t2) { $title = $t2; } else { $live_p = 0; # might have decided this one isn't worth listing. } } $title = entitify ($title); my $d = '
    '; if ($live_p && $title =~ s@^([^,()]+),\s*(.*)$@$d$1
    with $2@si) { } elsif ($live_p && $title =~ s@^([^,()]+)\s*\((.*)\)$@$d$1
    $2@si) { } else { $title = "$d$title"; } my $html = ("
    \n" . "
    " . "$date:" . "
    \n" . "
    $title
    \n" . "
    \n\n"); my $any_this_week_p = 0; foreach my $t (@$tickets) { my ($ticket, $desc, $price, $onsale, $offsale, $vip_p) = @$t; if (!$onsale || ticket_on_sale_this_week_p ($onsale, 14)) { $any_this_week_p = 1; } } if ($any_this_week_p) { # Omit Bootie and Blow Up from "Recently Announced" unless there # is a subtitle. if ($live_p || $title =~ m/:/ || $title !~ m/Bootie SF|Blow Up/i) { push @rcnt_html, $html; } } if ($live_p) { push @live_html, $html; } else { push @other_html, $html; } } my ($portal_html1, $portal_html2, $rcnt_html1, $rcnt_html2, $live_html1, $live_html2, $other_html1, $other_html2) = ('', '', '', '', '', '', '', '', ''); if ($#rcnt_html >= 0) { # Did any tickets go on sale this week? $rcnt_html1 = join('', @rcnt_html[0 .. $#rcnt_html/2]); $rcnt_html2 = join('', @rcnt_html[$#rcnt_html/2+1 .. $#rcnt_html]); } if ($#live_html >= 0) { # Are there any live shows coming up... $live_html1 = join('', @live_html[0 .. $#live_html/2]); $live_html2 = join('', @live_html[$#live_html/2+1 .. $#live_html]); } else { error ("no upcoming live shows? unpossible!"); } if ($#other_html >= 0) { # Are there any other shows coming up... $other_html1 = join('', @other_html[0 .. $#other_html/2]); $other_html2 = join('', @other_html[$#other_html/2+1 .. $#other_html]); } else { error ("no upcoming non-live shows? unpossible!"); } if ($#portal_html >= 0) { $portal_html1 = join('',@portal_html[0 .. $#portal_html/2]); $portal_html2 = join('',@portal_html[$#portal_html/2+1.. $#portal_html]); } if ($#rcnt_html < 4) { $rcnt_html1 .= $rcnt_html2; $rcnt_html2 = ''; } if ($#live_html < 4) { $live_html1 .= $live_html2; $live_html2 = ''; } if ($#other_html < 4) { $other_html1 .= $other_html2; $other_html2 = ''; } if ($#portal_html< 4) { $portal_html1 .= $portal_html2; $portal_html2 = ''; } my $output = ("$page_title: Tickets\n" . "\n" . "\n" . "\n" . load_store_blurb ($dir) . "\n" . "\n" . "
    \n" . "\n" . "Monthly and Weekly Events\n" . "\n" . "Multiple dates are available for these" . " recurring events!" . "\n" . "
    \n\n" . $portal_html1 . "
    \n" . "
    \n\n" . $portal_html2 . "
    \n\n" . ($rcnt_html1 ? ("

    \n" . "\n" . "Recently Announced\n" . "\n" . "

    \n\n" . $rcnt_html1 . "
    \n" . "
    \n\n" . $rcnt_html2 . "
    \n\n") : "") . ($live_html1 ? ("

    \n" . "\n" . "Upcoming Live Shows\n" . "\n" . "

    \n\n" . $live_html1 . "
    \n" . "
    \n\n" . $live_html2 . "
    \n\n") : "") . ($other_html1 ? ("

    \n" . "\n" . "Tickets Also Available for these DJ Events\n" . "\n" . $tickets_vip_blurb . "

    \n\n" . $other_html1 . "
    \n" . "
    \n\n" . $other_html2 . "
    \n\n") : "") . "
    \n" . "\n"); # Since this HTML was generated assuming it would be sitting in # "calendar/YYYY/MM.html", and we're putting it in "tickets/index.html", # we have one too many ".." links in the relative URLs. Take one off. # # $output =~ s@(\"\.\./)(\.\./)@$1@sg; my $outfile = "$dir/$calendar_tickets_file"; 1 while $outfile =~ s@[^/]+/\.\./@@g; DNA::Menuify::write_file ($outfile, $output); } sub generate_calendar_upcoming_1($$$$$$$$) { my ($dir, $max_events, $bands_p, $tickets_p, $list_all_bands_p, $list_next_p, $thisweek_p, $ticket_form_p) = @_; my $output = ""; my @events = ticket_events ($bands_p, $tickets_p); # Get the next upcoming event, but skip any private/cancelled events. # my $next_event = undef; my $next_event_2 = undef; for (my $i = 0; $i <= $#future_events; $i++) { $next_event = $future_events[$i]; $next_event_2 = $future_events[$i+1]; # $next_event_2 is only set if there are two events on the same day. if ($next_event_2 && ($next_event_2->{times}[0] ne $next_event->{times}[0] || $next_event_2->{times}[1] ne $next_event->{times}[1] || $next_event_2->{times}[2] ne $next_event->{times}[2])) { $next_event_2 = undef; } # If our next event is a pair of events on the same day, but event #1 # is already over, throw it away and use only event #2. # if ($next_event_2) { my $times = $next_event->{times}; my ($year, $month, $dotm, $dotw, $start_minute, $end_minute, $webcast_end_minute) = @$times; my $shour = int($start_minute / 60); my $smin = int($start_minute % 60); my $stime = mktime (0, $smin, $shour, $dotm, $month-1, $year-1900, 0, 0, -1); my $etime = $stime + (($end_minute - $start_minute) * 60); my $now = time(); if ($now >= $etime) { shift @events; $next_event = $next_event_2; $next_event_2 = undef; } } my $title = $next_event->{title}; if ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CANCELL?ED|POSTPONED|CLOSED|SUSPENDED)\b/i) { $next_event = undef; print STDERR "$progname: skipping private: $title\n" if ($verbose > 2); } if ($next_event_2) { $title = $next_event_2->{title}; if ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CANCELL?ED|POSTPONED|CLOSED|SUSPENDED)\b/i) { $next_event_2 = undef; print STDERR "$progname: skipping private: $title\n" if ($verbose > 2); } } if (defined($next_event_2) && !defined($next_event)) { $next_event = $next_event_2; $next_event_2 = undef; } last if (defined ($next_event)); } if (!$list_next_p) { $next_event = undef; $next_event_2 = undef; } if ($list_next_p) { unshift @events, $next_event_2 unless (!defined ($next_event_2) || $events[0] eq $next_event_2 || $events[1] eq $next_event_2); unshift @events, $next_event unless ($events[0] eq $next_event || $events[1] eq $next_event); } my $twit_onsale = ''; if ($#events >= 0) { my $body = ""; my $heading_inserted_p = 0; my $next_inserted_p = 0; my $thisweek_html = ''; my $output_count = 0; foreach my $event (@events) { my $next_p = ($next_event && $event eq $next_event); my $next2_p = ($next_event_2 && $event eq $next_event_2); my $title = $event->{title}; my $times = $event->{times}; my $flyer = $event->{flyer}; my $tickets = $event->{tickets}; my $price = $event->{price} || ''; my $live_p = $event->{live_p}; my $hype_p = $event->{hype_p}; my $free_p = ($price =~ m/\bFREE ADMISSION\b/i && $price !~ m/\$\d+\b/i); my $out_p = ($price =~ m/\bSOLD OUT\b/); # case sensitive my $do_thisweek_p = 0; my $first_ticket = undef; foreach my $t (@$tickets) { my ($ticket, $desc, $price, $onsale, $offsale, $vip_p) = @$t; if (!$first_ticket && !$vip_p && !ticket_off_sale_p ($event, $onsale, $offsale)) { $first_ticket = $ticket; if ($thisweek_p && (!$onsale || ticket_on_sale_this_week_p ($onsale, 7))) { $do_thisweek_p = 1; } } } # If this is an event with a ticket portal, link there instead of # directly to the first ticket. # if ($first_ticket) { my ($ptitle, $pdir) = find_portal_dir ($title, $event->{pres}); $first_ticket = "../tickets/$pdir/" if $pdir; } if ($live_p) { $title = compute_band_based_title ($event, !$list_all_bands_p, ($next_p || $next2_p)); next unless $title; # might have decided this one isn't worth listing. } # If we've emitted enough events, stop emitting. # But, if *any* upcoming event has the HYPE property, # emit that event even if it means we exceed the max. # Also emit any event that went on sale this week, if we're checking. # next if (!$hype_p && !$do_thisweek_p && $output_count >= $max_events); $output_count++; my ($year, $month, $dotm, $dotw) = @$times; $dotw = $days[$dotw]; $dotw =~ s/^(...).*$/$1/; $_ = $months[$month-1]; s/^(...).*$/$1/; my $date = sprintf("%s %s %02d", $dotw, $_, $dotm); $month = sprintf("%02d", $month); my ($dd) = ($event->{key} =~ m/^\d{4}-\d{2}-(\d{2}[ab]?)$/s); my $cal_url = "$year/$month-$dd.html"; # Let's just always use the calendar URL now. $flyer = $cal_url; my $flyer_open = ($flyer ? "" : ""); my $flyer_close = ($flyer ? "" : ""); # # Build up the line for this event. # my $tr = " \n"; my $col1 = ''; if ($first_ticket) { $col1 = "(buy)"; if ($ticket_form_p && $first_ticket =~ m@/order/\?item=(\d+)$@s) { my $id = $1; $col1 = ("
    \n" . " \n" . " \n" . "
    "); } } elsif ($free_p) { $col1 = "-free-"; } elsif ($out_p) { $col1 = "sold out!"; } $tr .= " $col1"; my $ages = ''; if (!$list_all_bands_p) { # include ages $ages = $event->{age} || ''; if ($ages) { $ages = ($ages eq 'AA' ? 'all ages' : $ages . '+'); $ages = "$ages"; $ages = "($ages)" unless ($title =~ m/\)\s*$/s); } } $title = entitify ($title); $title = "$flyer_open$title$flyer_close"; # Convert "Band (at Event)" to # Convert "Band (at Event)". $title =~ s@( \(.*?\))(()?)@$2$1@si; $title .= " $ages"; $tr .= (" " . "  $date    " . "" . " " . "$title" . "\n" . " \n"); # If this is a ticket that went on sale this week, save it for # later so that we can move it to the top of the list. # if ($do_thisweek_p) { $thisweek_html .= $tr; $twit_onsale .= $event->{key} . "\n"; next; } # # Insert the "Upcoming" headings into $body if it's now time. # if (!$heading_inserted_p && !($next_p || $next2_p)) { # Heading goes on its own line $body .= (" \n" . " " . "" . "Upcoming live shows:" . "" . "\n" . " \n"); $heading_inserted_p = 1; } if (!$next_inserted_p && ($next_p || $next2_p)) { $body .= (" " . "" . "Next event:" . "" . "\n"); $next_inserted_p = 1; } # # Finally, tack this line onto $body. # $body .= $tr; } if ($thisweek_html) { $body =~ s@(Upcoming live shows:)@
    Other \l$1@si; $body = (" \n" . " " . "" . "Just announced:" . "" . "\n" . " \n" . $thisweek_html . $body); } $output .= $body; } my $twit_thisweek = ''; if ($thisweek_p) { my $now = time(); my $end = $now + (60 * 60 * 24 * 7); # 7 days foreach my $event (@future_events) { my $title = $event->{title}; next if ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CANCELL?ED|POSTPONED|CLOSED|SUSPENDED)\b/i); my $times = $event->{times}; my ($year, $month, $dotm, $dotw, $start_minute, $end_minute, $webcast_end_minute) = @$times; my $shour = int($start_minute / 60); my $smin = int($start_minute % 60); my $stime = mktime (0, $smin, $shour, $dotm, $month-1, $year-1900, 0, 0, -1); if ($stime >= $now && $stime <= $end) { $twit_thisweek .= $event->{key} . "\n"; } } } return ($output, $twit_onsale, $twit_thisweek); } # Write the calendar/upcoming.html file. # This file is later included in the top level /index.html file, # sub generate_calendar_upcoming($) { my ($dir) = @_; my ($upcoming_html, $output_twit) = generate_calendar_upcoming_1 ($dir, 5, # $max_events 1, # $bands_p 0, # $tickets_p 0, # $list_all_bands_p 1, # $next_p 0, # $thisweek_p 0 # ticket_form_p - ugly. ); $upcoming_html = ("
    \n" . "\n" . $upcoming_html . " \n" . "
    \n" . "Advance tickets for other events are " . "available here." . "
    \n"); my $output = ("\n" . "

    \n" . "\n" . $upcoming_html . "\n" . "\n"); my $body = $body_template; my $title = "$page_title: Tickets"; $body =~ s@(]*>).*()@$1$title$2@s; $body =~ s@(]*>).*()@$1\n\n$output $2@s; my $outfile = "$dir/$calendar_upcoming_file"; 1 while $outfile =~ s@[^/]+/\.\./@@g; DNA::Menuify::write_file ($outfile, $body); return $upcoming_html; } # Write the calendar/overview.html file. # This file is later included in the top level /index.html file, # as the "Calendar Overview" sidebar. # sub generate_calendar_overview($) { my ($dir) = @_; my $output = ""; my $ov_width = 180; my $max_embeds = 3; # Use 3 while the DNA Pizza box is there $output .= ("\n" . "

    \n" . "
    \n"); $output .= ("\n" . "
    \n" . "
    Calendar Overview
    \n"); my $count = 0; my $embed_html = ''; my $embed_count = 0; my %already_embedded; foreach my $event (@future_events) { my $title = $event->{title}; my $times = $event->{times}; my $flyer = $event->{flyer}; my $embed = $event->{video}; my $embedname = $event->{videoname}; my ($year, $month, $dotm, $dotw) = @$times; $dotw = $days[$dotw]; $dotw =~ s/^(...).*$/$1/; $_ = $months[$month-1]; s/^(...).*$/$1/; my $date = "$dotw, $_ $dotm"; my $cal_url; { my $key = $event->{key}; my ($yyyy, $mm, $dd) = ($key =~ m/^(\d{4})-(\d{2})-(\d{2}[ab]?)$/s); $cal_url = "../calendar/$yyyy/$mm-$dd.html"; } # Don't include private or cancelled events on the front page. if ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CANCELL?ED|POSTPONED|CLOSED|SUSPENDED)\b/i) { print STDERR "$progname: skipping private: $date: $title\n" if ($verbose > 2); next; } # Let's just always use the calendar URL now. $flyer = $cal_url; $title = entitify ($title); $title = "$title" if defined ($flyer); $output .= ("
    \n" . " $date\n" . " $title\n" . "
    \n"); last if (++$count >= $overview_max_links); # If this event has embedded video, save that to emit after the table. # if ($embed && $embed_count < $max_embeds) { my $w = $ov_width; my $h = $w / (16 / 9) + 25; # 126 # my $h = $w / (4 / 3) + 25; # 160 $embedname =~ s/\s*:.*$//s; # lose everything after colon $embedname =~ s/\s*,\s+\d+[-\s][a-z]+[-\s]\d+\s*$//si; # trailing date $embedname = "$date: $embedname"; if (! $already_embedded{$embed}) { $embed_html .= ("
    " . # for Firefox... make_embed_tag ($embed, $embedname, $w, $h) . "" . "$embedname" . "
    " . "

    \n"); $embed_count++; } $already_embedded{$embed} = 1; } } $output .= ("

    \n" . " iCal\n" . " " . "more >>\n" . "
    \n" . "
    \n"); if ($embed_count > 0) { $output .= "\n$embed_html"; } $output .= ("\n" . "\n" . "
    \n" . "
    \n" . "\n"); my $body = $body_template; my $title = "$page_title: Overview"; $body =~ s@(]*>).*()@$1$title$2@s; $body =~ s@(]*>).*()@$1\n\n$output $2@s; my $outfile = "$dir/$calendar_overview_file"; DNA::Menuify::write_file ($outfile, $body); } # Write the calendar/dnalounge.rss file, for XML/RSS syndication. # sub generate_calendar_rss($) { my ($dir) = @_; my $output = ""; $output .= ("\n" . "\n" . " \n" . " $rss_channel_title\n" . " $rss_channel_url\n" . " \n" . " $rss_channel_desc\n" . " \n" . " $rss_channel_lang\n" . " webmaster\@dnalounge.com (DNA Lounge)" . "\n" . " webmaster\@dnalounge.com (DNA Lounge)" . "\n" . " \n" . #### these are optional # Tue, 09 Dec 2008 03:40:19 GMT # Tue, 09 Dec 2008 03:40:19 GMT " \n" . " $rss_channel_title\n" . " $rss_logo_url\n" . " $rss_channel_url\n" . " $rss_logo_width\n" . " $rss_logo_height\n" . " $rss_channel_title\n" . " \n"); my @events = @future_events; unshift @events, $yesterday_event if ($yesterday_event); my %guids_used; my $count = 0; foreach my $event (@events) { my $title = $event->{title}; my $times = $event->{times}; my $flyer = $event->{flyer}; my ($year, $month, $dotm, $dotw, $start_minute) = @$times; # Guids can't be duplicated, so when we have two events using the same # flyer, we can only use the flyer as the guid for the first one; we # need to use the calendar as the guid for subsequent ones. # if ($flyer) { if (defined($guids_used{$flyer})) { $flyer = undef; } else { $guids_used{$flyer} = 1; } } $dotw = $days[$dotw]; $dotw =~ s/^(...).*$/$1/; $_ = $months[$month-1]; s/^(...).*$/$1/; my $date = "$_ $dotm ($dotw)"; # Don't include private or cancelled events in the RSS file. if ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CANCELL?ED|POSTPONED|CLOSED|SUSPENDED)\b/i && ($event ne $yesterday_event)) { print STDERR "$progname: skipping private: $date: $title\n" if ($verbose > 2); next; } $month = sprintf("%02d", $month); $dotm = sprintf("%02d", $dotm); my $cal_url; { my $key = $event->{key}; my ($yyyy, $mm, $dd) = ($key =~ m/^(\d{4})-(\d{2})-(\d{2}[ab]?)$/s); $cal_url = "calendar/$yyyy/$mm-$dd.html"; } my $ititle = "$date: $title"; my $url = $url_base . ($flyer ? $flyer : $cal_url); # I think this can't happen... error ("$event->{key}: duplicate GUID: $url") if (defined($guids_used{$url})); $guids_used{$url} = 1; reset_galleries_queue ($event); my $html = build_event_html ($event, 1, 0); my $text = build_event_text ($event, 0, 1, 0, 1, undef, undef); ($html) = ($html =~ m@(.*?)@si); $html = decolorize_html ($html); $html = hardcode_stylesheet ($dir, $html); # Also, "../vip.html" => "..../calendar/vip.html" $html =~ s@\"\.\./([^\"]+\")@\"${url_base}calendar/$1@sg; $text = asciify ($text); $text =~ s/^ //gm; # de-indent by 4 spaces. $text =~ s/&/&/gsi; $text =~ s//>/g; # RSS can't have entities other than &, <, >. Fuck it. $ititle = asciify (de_entify ($ititle)); $ititle =~ s/&/&/gsi; $ititle =~ s/</</g; $ititle =~ s/>/>/g; $html = '' unless $html; $html =~ s/\s+/ /gs; $html =~ s/^\s+|\s+$//gs; $html = "<P>$html"; # Safari screws up if CDATA doesn't begin with <P> my $start_hour = int($start_minute / 60); $start_minute = int($start_minute % 60); my $stime = mktime (0, $start_minute, $start_hour, $dotm, $month-1, $year-1900, 0, 0, -1); my $sdate = strftime ("%a, %d %b %Y %H:%M:%S %Z", localtime ($stime)); $output .= (" <item>\n" . " <title>$ititle\n" . " $url\n" . " $sdate\n" . " $text\n" . " \n" . make_custom_rss ($event) . " \n"); last if (++$count >= $rss_max_links); } $output .= " \n"; $output .= "\n"; my $outfile = "$dir/$calendar_rss_file"; DNA::Menuify::write_file ($outfile, $output); } sub make_custom_tag($$;$) { my ($name, $val, $attrs) = @_; return '' unless defined ($val); my $ns = 'dnalounge'; $name = lc($name); $attrs = '' unless defined ($attrs); $val =~ s@<[^<>]*>@ @gsi; $val = asciify ($val); $val =~ s/&/&/gsi; $val =~ s//>/g; $val =~ s/\s+/ /gsi; $val =~ s/^\s+//gsi; $val =~ s/\s+$//gsi; if ($val =~ m/\.(html|jpg)$/ && $val !~ m/^http:/) { $val = $url_base . $val; } return "<$ns:$name$attrs>$val\n"; } sub make_custom_rss($) { my ($event) = @_; my $ns = 'dnalounge'; my $rss = ''; my $title = $event->{title}; my $time = $event->{time} || ''; my $genre = $event->{genre} || ''; my $price = $event->{price} || ''; my $age = $event->{age} || ''; if ($age) { error ("unparsable age: \"$age\"") unless ($age =~ m/^(AA|18|21)$/si); $age = 'all ages' if ($age eq 'AA'); } if ($price) { $price =~ s@ ?< ?@ before @gsi; $price =~ s@ ?> ?@ after @gsi; } my $date = $event->{date}; $date =~ s/ (Morning|Afternoon|Night)\b//si; $date =~ s/^([a-z][a-z][a-z])[a-z]*, (.*)/$2 ($1)/gsi; my $tickets = $event->{tickets}; my $live_title = compute_band_based_title ($event, 1, 0); if ($live_title && $live_title eq $event->{title} && $event->{live_p} != 3) { $live_title = undef; } $rss .= make_custom_tag ('title', $event->{title}); $rss .= make_custom_tag ('live_title', $live_title) if ($live_title); $rss .= make_custom_tag ('flyer', $event->{flyer}); $rss .= make_custom_tag ('date', $date); $rss .= make_custom_tag ('event_id', $event->{key}); $rss .= make_custom_tag ('time', $time); $rss .= make_custom_tag ('genre', $genre) if ($genre); $rss .= make_custom_tag ('price', $price) if ($price); $rss .= make_custom_tag ('age', $age) if ($age); if ($tickets) { foreach my $t (@$tickets) { my ($ticket, $desc, $price, $onsale, $offsale, $vip_p) = @$t; if (!ticket_off_sale_p ($event, $onsale, $offsale)) { # Always mention price of ticket in tag. $price = "\$$price"; $desc = ($vip_p ? "VIP Service" : "Buy Tickets") unless $desc; $desc .= ": $price" unless ($desc =~ m/\Q$price\E/s); my $tag = ($vip_p ? "vipticket" : "ticket"); $desc = ($desc ? " text=\"$desc\"" : undef); $rss .= make_custom_tag ($tag, $ticket, $desc); } } } foreach my $p (@{$event->{performers}}) { my ($name, $type, $dup, $url, $room) = @$p; my $tag = $type; $tag = 'PERFORMER' if ($tag eq 'OTHER'); my $attrs = ""; $url =~ s/&/&/gs if $url; $attrs .= " HREF=\"$url\"" if $url; $attrs .= " LOUNGE=\"true\"" if ($room && $room eq 'LOUNGE'); $rss .= make_custom_tag ($tag, $name, lc($attrs)); } # Also put in tags to link to Facebook, etc. # my $times = $event->{times}; my ($year, $month, $dotm) = @$times; my $eid = $event->{key}; foreach my $key (@{$event_ids{$eid}}) { my ($site, $id) = ($key =~ m/^(.*?)=(.*)$/si); error ("unparsable event_id: $key") unless ($id); my ($url, $name) = make_event_id_url ($site, $id, $title); next unless $url; $rss .= make_custom_tag ("link", $url); } $rss =~ s/^/ /gm; return $rss; } # Quotifies the text to make it safe for iCal/vCalendar # sub ical_quote($) { my ($text) = @_; $text =~ s/\s+$//gs; # lose trailing newline. $text =~ s/([\"\\,;])/\\$1/gs; # quote backslash, comma, semicolon. $text =~ s/\n/\\n\n /gs; # quote newlines, and break at newlines. # Combining blank lines confuses the Sonic Living parser. Fuck it. # $text =~ s/(\\n)\n (\\n)/$1$2/gs; # combine blank lines. # combine multiple blank lines into one. $text =~ s/(\n *\n)( *\n)+/$1/gs; # iCal seems to insist on Unicode, not Latin1. Fuck that, they get ASCII. $text = asciify($text); # Wrap long lines, just in case something somewhere chokes on them. { $Text::Wrap::columns = 77; my @paras = split(/\n/, $text); foreach my $p (@paras) { $p = wrap ('', ' ', $p) if (length($p) > $Text::Wrap::columns); } $text = join ("\n", @paras); } return $text; } # Returns the start and duration of the event in ical format. # sub ical_dtstart($) { my ($event) = @_; my $times = $event->{times}; my ($year, $month, $dotm, $dotw, $start_minute, $end_minute) = @$times; my $shour = int($start_minute / 60); my $smin = int($start_minute % 60); # Set the end time to midnight, since Mozilla Calendar loses its mind # when events span days. MacOS iCal doesn't lose its mind, but in # the month view, it does show the event on both days, and that looks # funny. # my $midnight = (24 * 60); $end_minute = $midnight if ($end_minute > $midnight); my $length = $end_minute - $start_minute; my $start = sprintf ("%04d%02d%02dT%02d%02d%02d", $year, $month, $dotm, $shour, $smin, 0); my $duration = (($length % 60) ? sprintf ("PT%dH%dM", ($length / 60), ($length % 60)) : sprintf ("PT%dH", ($length / 60))); my $tz = $rss_channel_tz; #$tz =~ s@/@-@gs; # RFC example says "US-Pacific", # but Apple iCal requires "US/Pacific". return ($start, $duration, $tz); } # Write the calendar/dnalounge.ics file, for iCal/vCalendar syndication. # See http://www.faqs.org/rfcs/rfc2445.html # sub generate_calendar_ical($) { my ($dir) = @_; my $outfile = "$dir/$calendar_ical_file"; # First, read the existing iCal file, to see what the DTSTAMPs are. # This is so we can leave the DTSTAMP ("entry creation time") unchanged # if the body of the entry has not changed. # my %dtstamps; { if (open (my $in, '<', $outfile)) { local $/ = undef; # read entire file my $body = <$in>; close $in; $body =~ s/\r\n/\n/gs; $body =~ s/(^BEGIN:VEVENT)/\000$1/gm; my @entries = split (/\000/, $body); shift @entries; foreach (@entries) { s/END:VCALENDAR.*$//gs; my ($url) = m/UID:([^\s]+)/; my ($dt) = m/DTSTAMP:([^\s]+)/; my ($seq) = m/SEQUENCE:([^\s]+)/; $seq = 0 unless defined($seq); s/(DTSTAMP|SEQUENCE):([^\s]+)/$1:%%$1%%/gs; my @entry = ($dt, $seq, $_); $dtstamps{$url} = \@entry; } } } my $output = ("BEGIN:VCALENDAR\n" . "X-WR-CALNAME;VALUE=TEXT:" . ical_quote ($rss_channel_title) . "\n" . "X-WR-CALDESC;VALUE=TEXT:" . ical_quote ($rss_channel_desc2) . "\n" . "X-WR-TIMEZONE;VALUE=TEXT:$rss_channel_tz\n" . "PRODID:-//dnalounge.com//calendar//EN\n" . "VERSION:2.0\n" . "CALSCALE:GREGORIAN\n" . "METHOD:PUBLISH\n"); my @events = @future_events; unshift @events, $yesterday_event if ($yesterday_event); my $count = 0; foreach my $event (@events) { my $key = $event->{key}; my $title = $event->{title}; my $times = $event->{times}; my $flyer = $event->{flyer}; my ($year, $month, $dotm, $dotw, $start_minute, $end_minute) = @$times; $month = sprintf("%02d", $month); $dotm = sprintf("%02d", $dotm); my ($dotmb) = ($key =~ m@-(\d\d[ab]?)$@s); my $url = "${url_base}calendar/$year/$month-$dotmb.html"; $flyer = "${url_base}$flyer" if defined($flyer); my $locurl = "${url_base}directions/"; # Don't include cancelled events in the iCal file. # But do include private events. if ($title =~ m/\b(CANCELL?ED|POSTPONED)\b/i) { my $m = $months[$month-1]; $m =~ s/^(...).*$/$1/; print STDERR "$progname: skipping cancelled: $dotm $m: $title\n" if ($verbose > 2); next; } my ($start, $duration, $tz) = ical_dtstart ($event); # If this is a new or changed entry, set DTSTAMP to "now" # and increment SEQUENCE. my ($csec, $cmin, $chour, $cdotm, $cmon, $cyear) = localtime; $cmon++; $cyear += 1900; my $dtstamp = sprintf ("%04d%02d%02dT%02d%02d%02d", $cyear, $cmon, $cdotm, $chour, $cmin, $csec); my $sequence = 0; my $desc = build_event_text ($event, 0, 1, 0, 1, undef, undef); # delete the calendar and flyer url lines from the text. # (this would be a good idea if any of the calendar programs # respected the URL or ALTREP fields, but they don't!) # # $desc =~ s/^ * \Q $url \E *\n//gm; # $desc =~ s/^ * \Q $flyer \E *\n//gm if defined ($flyer); $desc =~ s/^ //gm; # de-indent by 4 spaces. # The UID of entries must be different for two events on the same day. $url = ical_quote ($url); $flyer = ical_quote ($flyer) if $flyer; my $entry = ("BEGIN:VEVENT\n" . "UID:" . $url . "\n" . "DTSTAMP:%%DTSTAMP%%\n" . "SEQUENCE:%%SEQUENCE%%\n" . "ORGANIZER:dnalounge\n" . "LOCATION;" . "ALTREP=\"$locurl\":\n " . ical_quote ($rss_channel_loc) . "\n" . "GEO:" . $rss_latlong . "\n" . # don't quote ";" "SUMMARY:" . ical_quote ($title) . "\n" . "DTSTART;" . "TZID=$tz:$start\n" . "DURATION:$duration\n" . # "URL:" . ($flyer ? $flyer : $url) . "\n" . "URL:" . $url . "\n" . "DESCRIPTION;" . "ALTREP=\"$url\":\n " . ical_quote ($desc) . "\n" . "CLASS:PUBLIC\n" . "CATEGORIES:Performance\n" . "STATUS:CONFIRMED\n" . "END:VEVENT\n"); my $oentry = $dtstamps{$url}; if (defined ($oentry)) { my ($odt, $oseq, $oentry) = @$oentry; $sequence = $oseq+1; if ($entry eq $oentry) { $dtstamp = $odt; $sequence = $oseq; print STDERR "$progname: $outfile: keeping " . "$dtstamp / $sequence \"$title\"\n" if ($verbose > 4); } else { print STDERR "$progname: $outfile: CHANGED " . "$dtstamp / $sequence \"$title\"\n" . "$progname: $outfile: from $odt / $oseq\n" if ($verbose > 3); } } else { print STDERR "$progname: $outfile: new $dtstamp / $sequence \"$title\"\n" if ($verbose > 3); } $entry =~ s/%%DTSTAMP%%/$dtstamp/gs; $entry =~ s/%%SEQUENCE%%/$sequence/gs; $output .= $entry; } $output .= "END:VCALENDAR\n"; $output =~ s/\n/\r\n/gs; # convert to CRLF DNA::Menuify::write_file ($outfile, $output); } # Write the calendar/crontab.txt file, containing the webcast crontab # for the next few events. # sub generate_crontab($) { my ($dir) = @_; my @events = @future_events; unshift @events, $yesterday_event if ($yesterday_event); my $nevents = 10; my $output = ""; foreach my $event (@events) { my $title = $event->{title}; my $date = $event->{date}; # Don't include cancelled events in the crontab file. if ($title =~ m/\b(CANCELL?ED|POSTPONED|CLOSED|SUSPENDED)\b/i) { print STDERR "$progname: crontab: cancelled: $date: $title\n" if ($verbose > 2); } elsif ($nevents <= 0) { print STDERR "$progname: crontab: future: $date: $title\n" if ($verbose > 3); } else { $output .= build_event_crontab ($event); $nevents--; } } my $outfile = "$dir/$calendar_crontab_file"; DNA::Menuify::write_file ($outfile, $output); } # Compress whitespace, but insert newlines so that no lines are too long. # sub compress_and_wrap_html($) { my ($html) = @_; $html =~ s@\s+@ @gsi; # compress whitespace # Insert a newline before these tags $html =~ s@\s*(<(TABLE|TD|DIV)\b[^<>]*>)@\n$1@gsi; $html =~ s@\s*()\s*@$1\n@gs; $html =~ s/^\s+|\s+$//gs; # leading/trailing whitespace in document $html =~ s/^[ \t]+|[ \t]+$//gm; # leading/trailing whitespace on line $html =~ s/[ \t]+/ /gm; # horizontal to single space $html =~ s/\n\n+/\n/gs; # replace SPC with \n for lines still longer than 60 chars 1 while ($html =~ s@^([^\n]{60,}?)[ \t]@$1\n@gmi); return $html; } # Remove the style sheet from the HTML, and convert all CLASS= to STYLE=. # This is so we don't have to deal with namespace conflicts in HTML that # will end up getting displayed embedded in someone's webmail page. # my $hardcoded_css = undef; sub hardcode_stylesheet($$) { my ($dir, $html) = @_; my $sheet = ''; if (! $hardcoded_css) { $hardcoded_css = ''; foreach my $f ("$dir/../dnalounge.css", "$dir/calendar.css") { open (my $in, '<', $f) || error ("$f: $!"); local $/ = undef; # read entire file my $sheet1 = <$in>; close $in; # Comments. $sheet1 =~ s@()\s*@@gs; $sheet1 =~ s@/\*.*?\*/@@gs; # This isn't actually valid parsing, but it works for our sheets. # Just toss everything between "@media" and "\n}\n". $sheet1 =~ s/\n\@media\b.*?\n}\n/\n/gs; $hardcoded_css .= $sheet1; } } $sheet .= $hardcoded_css; while ($html =~ s@(\s*)@@si) { $sheet .= "\n$2"; } # Since we can't use "margin", set some paddings instead. $sheet .= "\n .event_lineup, .event_blurb { padding: 1em; }\n"; $sheet .= "\n .event_export, .share_line { padding: 1em; }\n"; $sheet .= "\n .event_video { padding-bottom: 1em; }\n"; # Thicker border. $sheet .= "\n .event_title_box { border: 4px solid; }\n"; $sheet .= "\n .noprint {}\n"; # Kludge. # Remove all colors. $sheet =~ s@(color|background):\s*[^;{}]+;?@@gsi; $sheet =~ s@(border[-a-z]*:[^;{}]+?)#[\dA-F]{3,6}\b\s*@$1@gsi; $sheet =~ s@(-webkit-)?text-stroke:\s*[^;{}]+;?@@gsi; # These are also stripped by Hotmail. Strip them here since # they *shouldn't* matter, and if they do, I want to see it. # $sheet =~ s@ \b ( position | margin(-[a-z]+)? | z-index | overflow ) \s* : \s* [^;"{}]+ ;? @@gsix; # Lose max-width and max-height, since that isn't helpful in email. $sheet =~ s@\s*\bmax-(width|height):[\d.\s]+(px|em)\s*;?@@gsi; my %classes; while ($sheet =~ s@^ \s* ( [-.a-z\d_:#]+ # class (?: \[ [^\[\]]+ \] )? # [crud] (?: [,\s]+ >? \s* # , or > [-.a-z\d_:#]+ # class (?: \[ [^\[\]]+ \] )? # [crud] )* ) \s* { \s* ( [^{}]* ) \s* } \s* @@six) { my ($key, $val) = ($1, $2); $val =~ s/\s+/ /gs; $val =~ s/(^\s+|[;\s]+$)//gs; $val =~ s/\s*([:;])\s*/$1/gs; foreach my $sel (split (m/,\s*/, $key)) { next unless ($sel =~ s/^\.//s); if ($sel =~ m/[^-_a-z\d]/si) { # complicated selector #print STDERR "complicated: $sel\n"; next; } my $v = $classes{$sel}; $v .= ";" if ($v && $v !~ m/;\s*$/s); $v .= $val; $classes{$sel} = $v; } } # Split CLASS="x y" into CLASS="x" CLASS="y" 1 while ($html =~ s@(\s+CLASS=\"[^\"\s]+)\s+([^\"]+\")@$1" CLASS=\"$2@gsi); foreach my $sel (sort keys (%classes)) { my $val = $classes{$sel}; my %attrs; foreach my $attr (split(/\s*;[;\s]*/, $val)) { my ($key, $val) = ($attr =~ m@^([-a-z]+)\s*:\s*(.*)$@s); error ("unparsable attr: $attr") unless defined($val); $attrs{$key} = $val; } $val = ''; foreach my $key (keys (%attrs)) { $val .= "; " if $val; $val .= "${key}:" . $attrs{$key}; } $val = " STYLE=\"$val\"" if ($val =~ m/[^\s]/); $html =~ s@\s+CLASS=\"\Q$sel\E\"@$val@gsi; } error ("unparsable style sheet: $sheet") if $sheet; $html =~ s@(\bCLASS=\"([^\"]+))@{ my ($o, $c) = ($1, $2); error ("failed to nuke class \"$c: $html\n") unless ($c eq 'g-plusone'); $o; }@gsexi; error ("stripped CSS still contains $1") if ($html =~ m@\b (( position | margin(-[a-z]+)? | z-index ) \s*:\s* [^;"]+ )@six); error ("stripped CSS still contains $1") if ($html =~ m@( \b display: \s* none \b )@six); # merge adjascent styles within a tag 1 while ($html =~ s@(STYLE="[^"]+);?\s*"\s+STYLE="@$1;@gsi); # The tags are only in here for the hcalendar microformat. $html =~ s@]*>@@gsi; # Since we had to strip "margin" properties, add some line breaks. $html =~ s@(]+?facebook)@

    $1@gsi; # Before "fblike" $html =~ s@(

    $1@gsi; # Before DIVs with borders # $html =~ s@(]*>)@

    $1

    @gsi; # Around images $html =~ s@()(]*>(.*?)@$1@gsi; # Can't fix this. $html =~ s/\bBGCOLOR=[^\s<>]+//gsi; $html =~ s/\s+[HV]SPACE=\"?\d+\"?//gsi; $html =~ s/\b(background|color):[^\";<>]+\s*;?\s*//gsi; $html =~ s/\b(border\b.*)\s+#[\dA-F]+\b/$1/gsi; $html =~ s/\s+STYLE=""//gsi; $html =~ s/[ \t]+/ /gsi; $html =~ s@()\s+@$1@gsi; $html =~ s@\s+(]*>@@gsi; return $html; } # Write the calendar/weekly.txt and calendar/weekly.html files, # containing the text and HTML versions of the next two weeks' # worth of events. This inserts "calendar/prolog.txt" in each, # if it exists. # # The output files are used by calendar/mail-weekly.pl # sub generate_weekly($) { my ($dir) = @_; # my $ndays = 16; my $output_text = ""; my $output_html = ""; my $live_shows = ""; my $prologue = ''; { if (open (my $in, '<', "$dir/$calendar_weekly_prolog")) { local $/ = undef; # read entire file $prologue = <$in>; close $in; } $prologue =~ s/[ \t]+$//mi; $prologue =~ s/\s+$//si; } my $prologue_html = $prologue; $prologue_html =~ s/&/&/g; $prologue_html =~ s//>/g; $prologue_html =~ s/\n\n+/\n

    /gsi; $prologue_html =~ s@\b(http://([^<>\s\"\',/]+)[^<>\s\"\',]+)\b@$2@gsi; $prologue_html =~ s@\b([a-z\d]+\@[a-z\d]+\.[a-z\d.]+)\b@$1@gsi; my ($csec, $cmin, $chour, $cdotm, $cmon, $cyear) = localtime; my $today = mktime (0, 0, 0, $cdotm, $cmon, $cyear, 0, 0, -1); my $from = $today; foreach my $event (@future_events) { my $title = $event->{title}; if ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CLOSED|SUSPENDED)\b/i) { print STDERR "$progname: infoline: skipping private: $title\n" if ($verbose > 2); next; } my $times = $event->{times}; my ($year, $month, $dotm) = @$times; my $etime = mktime (0, 0, 0, $dotm, $month-1, $year-1900, 0, 0, -1); $live_shows .= event_live_show_summary ($event); my $days_away = int (($etime - $from) / (24 * 60 * 60)); my $hype_p = $event->{hype_p}; if ($days_away < 14 || $hype_p) { my $day_prefix = ($days_away < 7 ? "This" : $days_away < 14 ? "Next" : undef); my $day_suffix = ($days_away == 0 ? "Tonight" : $days_away == 1 ? "Tomorrow" : undef); my $txt = build_event_text ($event, 1, 1, 0, 0, $day_prefix, $day_suffix); $output_text .= $txt; reset_galleries_queue ($event); my $html = build_event_html ($event, 1, 0); ($html) = ($html =~ m@(.*?)@si); error ("no RIGHT section in event HTML") unless $html; $html = decolorize_html ($html); # hack the day prefixes/suffixes if ($day_prefix || $day_suffix) { my $days_re = "\\b((" . join ('|', @days) . ")\\b[^<>]*)"; my $pre = ($day_prefix ? "$day_prefix " : ""); my $suf = ($day_suffix ? "
    -- $day_suffix" : ""); $html =~ s@$days_re@$pre$1$suf@; } $output_html .= $html; $output_html .= '

    '; # since Hotmail strips margin-top. if ($verbose > 3) { my $title = $event->{title}; my $date = $event->{date}; $date = "$day_prefix $date" if (defined ($day_prefix)); $date = "$day_suffix, $date" if (defined ($day_suffix)); print STDERR "$progname: weekly: $date: $title\n"; } } elsif ($verbose > 3) { my $title = $event->{title}; my $date = $event->{date}; print STDERR "$progname: weekly: future: $date: $title\n"; } } $output_text = ("DNA Lounge, 375 Eleventh Street.\n" . "\n" . " ${url_base}directions/\n" . " ${url_base}calendar/\n" . " ${url_base}flyers/\n" . "\n" . " webcal://www.dnalounge.com/calendar/dnalounge.ics (iCal feed)\n" . $output_text); my ($upcoming_html, $output_twit_onsale, $output_twit_thisweek) = generate_calendar_upcoming_1 ($dir, 15, # $max_events 1, # $bands_p 0, # $tickets_p 1, # $list_all_bands_p 0, # $next_p 1, # $thisweek_p 0 # ticket_form_p ); $upcoming_html = decolorize_html ($upcoming_html); $upcoming_html = "\n" . "$upcoming_html
    "; $upcoming_html =~ s@(\(buy\))@$1  @gsi; $upcoming_html = ("

    \n" . "
    \n" . $upcoming_html . "
    \n" . "
    \n"); $output_html = ("
    \n" . "" . "" . "" . "" . "\n" . "" . "" . "" . "" . "" . "" . "" . "" . "
    " . "DNA Lounge. 375 Eleventh Street.
    \n" . "    		" . "
    " . $prologue_html . "

    To unsubscribe, " . "" . "click here." . "

    " . "    		\n" . "\n" . "
    " . # The "?M" is a webbug for the logs. "
    " . "    		" . "\n" . "Directions
    \n" . "Calendar
    \n" . "Flyers
    \n" . "" . "iCal Feed\n" . "
    " . "
    \n" . "

    \n" . # "

    " . # "It's that time of year again! Reserve a date now to host your " . # "company's holiday party here at DNA Lounge. Wouldn't you rather " . # "have it here than in the company cafeteria? Of course you would! " . # "We can provide any level of support for your party, from a simple " . # "room rental, to catering and start-to-finish entertainment. " . # "Please check out our " . # "Private Parties page, and contact us at " . # "" . # "booking\@dnalounge.com for more information or to schedule" . # " a tour.

    " . "

    " . " FREE COFFEE FEBRUARY!" . "

    We're giving away FREE coffee and " . " espresso drinks every morning in February from 6am to 10am at " . " DNA Pizza, our " . " cafe next door! Come check us out before work. Tell your " . " friends and help us spread the word!" . "

    " . "

    Won't you be our friend? We're on " . "Facebook, " . "Twitter, " . # "MySpace, " . "SonicLiving, " . "Last.FM, " . "Upcoming, " . "and " . "Yelp." . "

    " . "DNA Pizza is " . "open 24/7!\n" . "Join us right next door for a slice before or after your night " . "of clubbing, or for espresso and pastries early in the morning! " . "We also serve deli sandwiches and a fine selection of beers. " . "Free delivery, free wifi!" . "

    " . "
    \n" . "
    \n" . "

    " . "\n" . $upcoming_html . "

    " . $output_html); if ($live_shows ne '') { $live_shows =~ s/^/ /gm; $live_shows = "Upcoming live shows:\n\n" . $live_shows . "\n"; $live_shows .= "For advance tickets to all these shows,"; $live_shows .= " go to $url_base\n\n"; $output_text = $live_shows . $output_text; } $output_text .= ("\n" . ('-' x 72) . "\n" . # $fill_column ? "To unsubscribe: http://www.dnalounge.com/contact/unsubscribe.html\n" . "or send mail to \"announce-request\@dnalounge.com\" with \"unsubscribe\"\n". "in the body of the message. To subscribe a different address, send\n". "mail from the new address with \"subscribe\" in the body.\n" ); # $output_text = "upcoming DNA Lounge events\n\n" . $output_text; $output_text = "$prologue\n\n$output_text" if ($prologue); $output_text = asciify($output_text); # no Latin1 in text/plain. # Since there's no hope that our embed floating/scaling tricks will work # in email, just hardcode the video size. # $output_html =~ s@(

    \s*
    \s* ]*> .*? \s*
    \s*
    )@{ my $embed = $1; my ($url) = ($embed =~ m/(?:SRC|DATA)=\"([^<>\"]+)\"/si); my $w = 320; my $h = int ($w / (16/9)) + 30; $embed = ("
    " . "" . "
    "); $embed; }@gsexi; $output_html = hardcode_stylesheet ($dir, $output_html); $output_html .= ("\n

    " . "

    " . "To unsubscribe, " . "" . "click here,\n" . "or send mail to " . "" . "announce-request\@dnalounge.com with\n" . "\"unsubscribe\" in the body of the message." . " To subscribe a different\n". "address, send mail from the new address with " . "\"subscribe\" in the body." . "

    \n" ); # Fix URLs. $output_html = DNA::Menuify::expand_urls ($output_html, "$url_base$dir/"); # Auugh. $output_html =~ s@(\.com)(/(vip\.html|export\.cgi|images/))@$1/calendar$2@g; # Lose any empty rows $output_html =~ s@ \s* ]*> \s* \s* \s*@@gsix; $output_html =~ s@]*>\s*@@gsi; # Need the plusone nonsense $output_html = ("\n" . $output_html); # max-width doesn't work in all mail readers, but it does in some... my $s = 'max-width:68em;'; # Yes, iPad, I would like you to fucking obey my font size changes. $s .= '-webkit-text-size-adjust:none;'; $output_html = "

    $output_html
    "; $output_html = ("\n" . "\n" . "\n" . "\n" . "\n" . "$output_html\n" . "\n" . "\n"); $output_html = compress_and_wrap_html ($output_html); $output_html .= "\n"; my $outfile = "$dir/$calendar_weekly_file"; my $o2 = $outfile; DNA::Menuify::write_file ($outfile, $output_text); $outfile =~ s@\.txt$@.html@; DNA::Menuify::write_file ($outfile, $output_html); $outfile =~ s@\.[a-z]+$@-onsale.txt@; DNA::Menuify::write_file ($outfile, $output_twit_onsale); $outfile = $o2; $outfile =~ s@\.[a-z]+$@-thisweek.txt@; DNA::Menuify::write_file ($outfile, $output_twit_thisweek); } # Generate the pages listing all tickets for repeating events: # tickets/blowup/index.html, etc. # sub generate_ticket_portals($) { my ($dir) = @_; my %dirs; my $store = load_store_blurb ($dir); foreach my $k (keys (%portal_dirs)) { $dirs{$k} = ''; } foreach my $event (@future_events) { my $pres = $event->{pres} || ''; my $title = $event->{title}; my $date = $event->{date}; my $times = $event->{times}; my $time = $event->{time} || ''; my $price = $event->{price} || ''; my $tickets = $event->{tickets}; my $subtitle = $2 if ($title =~ s@^(.*?): (.*)$@$1@si); my ($ptitle, $pdir) = find_portal_dir ($title, $pres); next unless defined ($pdir); my $html = $dirs{$pdir}; # For "XYZ presents" entries. Include the real title. if (!$subtitle && $title ne $ptitle) { $subtitle = $title; } $title = entitify($title); #### because of the stupid title parser # Duplicated from build_event_html. # $time =~ s/(&[a-z\d]+;)/$1\001/gsi; # kludge to protect entities. $price =~ s/(&[a-z\d]+;)/$1\001/gsi; $time =~ s/;\s+/;
    /gs; # break after semicolons. $price =~ s/;\s+/;
    /gs; $time =~ s/\.\s+/.
    /gs; # break after sentences. $price =~ s/\.\s+/.
    /gs; $time =~ s/\001//gs; $price =~ s/\001//gs; $price =~ s@(gen\.)\s*
    \s*(adm)@$1 $2@gsi; # blah. $price = "
    $price
    \n" if ($price); $time = "
    $time
    \n" if ($time); my ($year, $mm, $dotm) = @$times; my $dotw = dotw ($dotm, $mm, $year); my $month = $months[$mm-1]; $dotw = $days[$dotw]; my ($dd) = ($event->{key} =~ m/^\d{4}-\d{2}-(\d{2}[ab]?)$/s); my $date_html = sprintf ("%s, %s %0d", $dotw, $month, $dotm); my $url = sprintf ("../../calendar/%04d/%02d-%s.html", $year, $mm, $dd); $date_html = "
    $date_html
    \n"; my $buy = "Buy tickets here!"; my @lineup = (); my $max = 4; my $maxxed = 0; foreach my $p (@{$event->{performers}}) { my ($name, $type) = @$p; next if ($subtitle && $subtitle =~ m/\Q$name/si); if (@lineup >= $max) { $maxxed = 1; next; } push @lineup, $name; } my $lineup = join (", ", @lineup); if ($subtitle) { my $o = $lineup; $lineup = "$subtitle"; $lineup .= "
    With: $o" if $o; } if ($maxxed) { $lineup .= ", and more!"; } elsif ($lineup eq '') { $lineup = "Details TBA!"; } elsif ($event->{html_out} =~ m/\bTBA\b/s) { $lineup .= ", and more TBA!"; } else { $lineup .= "." unless ($lineup =~ m@\s*$@si); } my $on_sale_p = 0; if ($tickets) { foreach my $t (@$tickets) { my ($ticket, $desc, $price, $onsale, $offsale, $vip_p) = @$t; my $off_p = ticket_off_sale_p ($event, $onsale, $offsale); if ($off_p < 0) { # not on sale yet $ticket = undef; } elsif ($off_p > 0) { # no longer on sale $ticket = undef; } elsif ($vip_p) { $ticket = undef; # ignore these } $on_sale_p += defined($ticket); } } next unless $on_sale_p; $html .= ("
    \n" . "
    \n" . "
    \n" . " $date_html\n" . " $time\n" . " $lineup\n" . "
    \n" . "
    \n" . "
    \n" . "
    \n" . " $buy\n" . " $price\n" . "
    \n" . "
    \n" . "
    \n"); $dirs{$pdir} = $html; } foreach my $pdir (sort keys (%dirs)) { my $otitle = $portal_dirs{$pdir}; my $title = $otitle; next unless $title; my $title_img = find_title_image ($title, 1); my $title_img_w = find_title_image ($title, 0); next if ($otitle eq 1); # Not a real portal directory, e.g., CVS. if ($title_img) { $title = "\"$title\"
    "; } $title .= ":
    " unless $title_img; $title .= "Tickets on sale now"; $title = "
    $title
    "; $title = "
    $title
    \n"; my $html = $dirs{$pdir}; $html = ("


    \n" . "No $otitle tickets tickets are on sale right now. " . "Check back soon!" . "
    ") unless $html; $html = ("$otitle Tickets\n" . "\n" . "\n" . ($title_img_w ? (" \n" . " \n") : "") . "\n" . $store . "\n" . "\n" . $title . $html . "\n"); my ($tickets_dir) = ($calendar_tickets_file =~ m@^(.*)/@si); my $outfile = "$dir/$tickets_dir/$pdir/index.html"; 1 while $outfile =~ s@[^/]+/\.\./@@g; DNA::Menuify::write_file ($outfile, $html); } } # Write the calendar/infoline.txt file, containing the text version of # the next two weeks' worth of events. # sub generate_infoline($) { my ($dir) = @_; my $ndays = 16; my $output = (" Hello! And thank you for calling DNA Lounge.\n" . " We are located at 375 Eleventh Street, between Folsom and Harrison.\n". " Advance tickets are available at DNA Lounge dot com.\n" . "\n" . " DNA Pizza is open 24 7, right next door!\n" . # " Join us for a slice before or after your night of clubbing!\n" . " Pizza, sandwiches, coffee, espresso, and a fine selection of\n" . " beers. Free delivery, free why-fie!\n" . "\n" . " Here are our upcoming events!\n" . " Press star, to skip ahead.\n" . " Press any other key to back up.\n" . "\n"); my ($csec, $cmin, $chour, $cdotm, $cmon, $cyear) = localtime; my $today = mktime (0, 0, 0, $cdotm, $cmon, $cyear, 0, 0, -1); my $from = $today; my $to = $from + ($ndays * 24 * 60 * 60); foreach my $event (@future_events) { #foreach my $event (@event_ords) { my $title = $event->{title}; my $times = $event->{times}; my ($year, $month, $dotm) = @$times; my $etime = mktime (0, 0, 0, $dotm, $month-1, $year-1900, 0, 0, -1); if ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CLOSED|SUSPENDED)\b/i) { print STDERR "$progname: infoline: skipping private: $title\n" if ($verbose > 2); } elsif ($etime <= $to) { my $txt = build_event_text ($event, 1, 1, 1, 1, undef, undef); $output .= $txt; if ($verbose > 3) { my $title = $event->{title}; my $date = $event->{date}; print STDERR "$progname: infoline: $date: $title\n"; } } elsif ($verbose > 3) { my $title = $event->{title}; my $date = $event->{date}; print STDERR "$progname: infoline: future: $date: $title\n"; } } $output = asciify($output); # No Latin1 in infoline. $output .= ("\n\n" . " Thank you for calling!\n" . " Please check our site on the inter-webs for more" . " details.\n" . " DNA Lounge dot com.\n" . " You can also be our friend on the face-books and" . " the twitters.\n" . " Transmission ends.\n"); $output =~ s/(\n\n)\n+/$1/gs; my $outfile = "$dir/$calendar_infoline_file"; DNA::Menuify::write_file ($outfile, $output); } sub reformat_infoline($) { ($_) = @_; # Strip some crap out of the text before reading it out loud. # Lose everything in parens. s@\(.*?\)@ @gsi; # Lose everything after "--" on a line. s@--+.*$@@gmi; # Lose all URLs. s@((https?|mailto):[^\s]+)@@gsi; # Spell this out a little more. s@^(\s*)(Main Room|Lounge):@$1In the $2:@gmi; # Capitalize all-caps words. s/\b([A-Z])([-A-Z\d]{3,})\b/$1\L$2/gs; # Spell out idiosyncratic punctuation. s/\s<\s/ before /gi; s/\s>\s/ after /gi; s/\s&([\s<])/ and$1/gi; s/(18|21)[+]/$1 and over/gi; s/[+]/ and /gi; s@\b w/ @with @gsx; s/[ \t]+$//gm; # Every sentence on its own line. s@([.?!]) @$1\n@gs; # Every line must be a sentence-end. s@([^\s.?!:;])$@$1.@gm; s@^\s*\.+@@gm; $_ .= "\n"; # delete any sentences about who's doing visuals or massage. # s/^.*?\bVideo by .*?\n//gim; s/^.*?\bvisual install.*?\n//gim; s/^.*?\bvisual support .*?\n//gim; s/^.*?\bvisuals by .*?\n//gim; s/^.*?\bbody work\b.*?\n//gim; s/^.*?\bmassage by\b.*?\n//gim; s/^.*?\bstring art by\b.*?\n//gim; s/^.*?\bstring artistry\b.*?\n//gim; s/^.*?\bcostumed freestyle go-gos by .*?\n//gim; s/^.*?\bBest of .* winner.*\n//gim; s/^.*?\bIf your band would like to participate.*\n//gim; # Each sentence on its own line. s/([.!?:;]) ([a-z])/$1\n$2/gsi; s/\n\n+/\n/gs; s/^ */ /gm; return $_; } # Check the upcoming events for any that still have no info or "TBA" # in them, and warn... # sub check_impending_tba() { return unless $verbose; # If the event is < N days out with missing info, "IMMINENT" warning. my $ndays1 = 16; # if the event is > N days out, don't warn about missing flyers, etc. my $ndays2 = 28; my ($csec, $cmin, $chour, $cdotm, $cmon, $cyear) = localtime; my $today = mktime (0, 0, 0, $cdotm, $cmon, $cyear, 0, 0, -1); my $from = $today; my $to1 = $from + ($ndays1 * 24 * 60 * 60); my $to2 = $from + ($ndays2 * 24 * 60 * 60); my $warnings = ''; my $errors = ''; foreach my $event (@future_events) { my $times = $event->{times}; my ($year, $month, $dotm) = @$times; my $etime = mktime (0, 0, 0, $dotm, $month-1, $year-1900, 0, 0, -1); my $flyer = $event->{flyer}; my $time_to_warn_p = ($etime <= $to2); my $title = $event->{title}; my $date = $event->{date}; $date =~ s/^([a-z]{3})[a-z]*( [A-Za-z]+)?,\s*(\d+) +([a-z]+).*$/$1, $4 $3/si; $date =~ s/ (\d)$/ 0$1/s; my $ignore_p = ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CANCELL?ED|POSTPONED)\b/i); my $video_p = $event->{video} || ''; my $time = $event->{time} || ''; my $price = $event->{price}; my $age_p = $event->{age}; my $adv_p = ($price && $price =~ m@\$\d+\s+advance@si); my $start_p = ($time && $time =~ m@\b \d\d?(:\d\d)? [AP]M \b | \b noon \b | \b midnight \b @ix); my $md = $event->{markdown} || ''; my $blurb = ''; $blurb = $2 if ($md =~ s@^(.*?)\s*---------+\n(.*)$@$1@si); my $blank_p = ($md =~ m/^\s*$/s); my $blurb_p = ($blurb !~ m/^\s*$/s); my $tba_p = ($md =~ m@\bTBA\b@i); my $band_p = 0; my $nperf = @{$event->{performers}}; my $tickets = $event->{tickets}; my $ticket_p = 0; my $vip_p = 0; if ($tickets) { foreach my $t (@$tickets) { my ($ticket, $desc, $price, $onsale, $offsale, $vip2) = @$t; $ticket_p = 1; $vip_p = 1 if $vip2; } } foreach my $p (@{$event->{performers}}) { my ($name, $type) = @$p; if ($type eq 'BAND') { $band_p = 1; last; } } # Don't warn about videos for these events, since they don't have them. $video_p = 1 if ($title =~ m/( ^Battle\s+of\s+the\s+Bands | ^Gorilla )/six); # We generally don't sell tickets for Death Guild or Meat. $ticket_p = 1 if ($title =~ m/( ^Death\sGuild$ | ^Meat\b )/six); # Consider a distant event to be blank if it has < N performers listed. $blank_p = 1 if ($nperf < 3 && !$time_to_warn_p); # If an event is blank, don't warn about certain things. # if ($blank_p) { $blurb_p = 1; $video_p = 1; $age_p = 1; $tba_p = 0; # If a blank event is still far in the future, don't warn about these: # if (!$time_to_warn_p) { $blank_p = 0; $flyer = 1; $ticket_p = 1; $vip_p = 1; $price = 1; $blurb_p = 1; } } if (!$ignore_p) { my @miss = (); push @miss, "time" if (!$start_p && !$blank_p); push @miss, "line-up" if ($blank_p && !$tba_p); push @miss, "ticket" if (!($ticket_p || $vip_p)); push @miss, "flyer" unless $flyer; push @miss, "price" unless $price; push @miss, "age" unless $age_p; push @miss, "blurb" unless $blurb_p; push @miss, "video" unless $video_p; my $miss = ''; if ($#miss >= 0) { foreach (@miss[0..$#miss-1]) { $_ .= ','; } @miss[$#miss..$#miss+1] = ("or", @miss[$#miss..$#miss+1]) if ($#miss > 0); $miss = join (' ', @miss); $miss =~ s/, or / or /; $miss = "no $miss"; } if ($tba_p) { if ($miss) { $miss = "still TBA; $miss"; } else { $miss = "still TBA" } } if ($miss) { $miss = " $date: $miss: $title\n"; if ($etime > $to1) { $warnings .= $miss; } else { $errors .= $miss; } } } } print STDERR "\n" if ($errors || $warnings); print STDERR "Missing info -- IMMINENT:\n\n$errors\n" if ($errors); print STDERR "Missing info -- less-imminent:\n\n$warnings\n" if ($warnings); } # Check whether any of the embedded videos have been deleted. # sub ping_videos() { my $all_p = 0; foreach my $event ($all_p ? @event_ords : @future_events) { my $date = $event->{date}; my $video = $event->{video}; next unless $video; $date =~ s/^([A-Z][a-z][a-z])[a-z]*( [A-Za-z]+)?/$1/; # my $body = LWP::Simple::get($video) || ''; my $ua = LWP::UserAgent->new; $ua->agent ("$progname/$version"); my $res = $ua->get ($video); my $body = ($res ? $res->decoded_content : '') || ''; my $err; $err = "blank page" if (!$err && $body =~ m/^\s*$/si); $err = "censored" if (!$err && $body =~ m/that is inappropriate/i); $err = "deleted" if (!$err && $body =~ m/removed by the user/i); $err = "deleted audio" if (!$err && $body =~ m/audio has been disabled/i); $err = "unembeddable" if (!$err && $body =~ m/embedding disabled/i); $err = "blocked" if (!$err && $body =~ m/blocked.*in your country/i); if (!$err && $body =~ m@
    ]* > \s* ( [^<>]+? ) \s*
    @six) { $err = $1; } $err = $res->status_line if (!$err && !$res->is_success); if ($err) { my $title = $event->{title}; print STDERR "$date: $err: $title ($video)\n"; } elsif ($verbose > 1) { print STDERR "$date: video OK\n"; } } } # Given the name of an event, and the name of a ticket in the store, # return a string used to present that ticket in the calendar. # sub extract_ticket_name($$$$$) { my ($ticket_id, $date, $ename, $tname, $vip) = @_; $ename = asciify($ename); # The names of tickets in the store are the event name, followed # by an optional comma and more text describing the ticket, e.g., # # Death Guild, VIP Service # or # Bootie: New Years Eve Bootleg Ball, Early Bird Special # # That suffix text is what we present on the ticket links in the # calendar (or "Buy Tickets" / "VIP Service" if it is unspecified). # # If the event name in the calendar contains a comma, that is # omitted from the ticket's name part, to avoid ambiguity. # my ($tname_base, $tname_suffix) = ($tname =~ m/^(.*?)(?:,\s+([^,]+))?$/s); my $e2 = $ename; $e2 =~ s/,//g; if ($tname_base ne $e2) { print STDERR "$progname: WARNING: $ticket_id: $date: name mismatch:\n" . "$progname:\tstore: $tname\n" . "$progname:\tcal: $ename" . ($tname_suffix ? ", $tname_suffix" : "") . "\n\n" if ($verbose); } else { # Make sure the VIP flag in the ticket matches the textual description # of the ticket. my $tvip = ($tname =~ m@((VIP|Table) Service|VIP Table)@si); print STDERR "$progname: WARNING: $ticket_id: $date: VIP mismatch: $tname\n" if ((!$vip) != (!$tvip) && $verbose); } if ($vip && $tname_suffix && $tname_suffix eq 'VIP Service') { # default string $tname_suffix = "" } # Kludge for Blow Up's age-based ticket. if ($tname_suffix && $tname_suffix =~ m/^(18|21)\+$/) { $tname_suffix .= " Ticket"; # "18+" => "18+ Ticket" } return ($tname_suffix || ""); } # Load the data in tickets.txt (a dump of the store's state) and insert # those tickets into the corresponding events. # sub load_tickets($) { my ($file) = @_; open (my $in, '<', $file) || error ("$file: $!"); local $/ = undef; # read entire file my $data = <$in>; close $in; my %ticket_events; # events for which we have just added tickets foreach my $line (split (/\n/, $data)) { my ($ticket, $date, $onsale, $offsale, $calid, $price, $svc, $vip, $flyer, $name, $hidden, $soldout) = split(/\t/, $line); error ("unparsable: $line") unless ($name && $name =~ m/[^\s]/s); $price =~ s/\.00$//s; $flyer =~ s@-\d-thumb(\.[^./]+)$@.html@si; error ("$ticket: no calid") unless ($calid); # Sanity check the various dates. # print STDERR ("$progname: WARNING: $ticket: $calid:" . " offsale <= onsale: \"$name\"\n" . strftime ("\t%a, %d %b %Y %I:%M %p", localtime($offsale)) . "\n" . strftime ("\t%a, %d %b %Y %I:%M %p", localtime($onsale)) . "\n\n") if ($offsale <= $onsale && $verbose); print STDERR ("$progname: WARNING: $ticket: $calid:" . " offsale > date - 1h: \"$name\"\n" . strftime ("\t%a, %d %b %Y %I:%M %p", localtime($offsale)) . "\n" . strftime ("\t%a, %d %b %Y %I:%M %p", localtime($date)) . "\n\n") if ($offsale > $date - (60 * 60) && $verbose); print STDERR ("$progname: WARNING: $ticket: $calid:" . " onsale > date - 1h: \"$name\"\n" . strftime ("\t%a, %d %b %Y %I:%M %p", localtime($onsale)) . "\n" . strftime ("\t%a, %d %b %Y %I:%M %p", localtime($date)) . "\n\n") if ($onsale > $date - (60 * 60) && $verbose); # Iterate over the events happening on the date of this ticket, # and find the event corresponding to this ticket. There should # be exactly one match. # my ($tsec, $tmin, $thour, $tdotm, $tmon, $tyear) = localtime($date); $tmon++; $tyear += 1900; my @events = get_all_events ($tyear, $tmon, $tdotm, 0); my $ok = 0; foreach my $event (@events) { next unless $event->{key} eq $calid; my $times = $event->{times}; my ($year, $month, $dotm, $dotw, $start_minute) = @$times; my $eid = $event->{key}; next unless ($calid eq $eid); error ("$ticket: $eid: multiple event matches") if $ok; my $eflyer = $event->{flyer} || ''; my $start_hour = int($start_minute / 60); $start_minute = int($start_minute % 60); my $edate = mktime (0, $start_minute, $start_hour, $dotm, $month-1, $year-1900, 0, 0, -1); # Make sure the start-time of this event matches the ticket. # print STDERR ("$progname: WARNING: $ticket: $calid:" . " time mismatch: \"$name\"\n" . "\tstore: " . strftime ("%a, %d %b %Y %I:%M %p", localtime($date)) . " vs\n" . "\tcal: " . strftime ("%a, %d %b %Y %I:%M %p", localtime($edate)) . "\n\n") if ($date != $edate && $verbose); # # Make sure the ticket's price matches the price in the event listing. # # # my $eprice = $event->{price} || ''; # if ($vip) { # $eprice = $vip_price; # } elsif ($eprice =~ m/\$(\d+)\s*advance/si) { # $eprice = $1; # } else { # # Delete "$8 < .." and "$8 before .." to get the later price. # $eprice =~ s/\$[\d.]+ (<|<|b4|before|until) //sg; # # always take the last price listed, so that "$7 before 10, $10 after" # # results in a presale price of $10, not $7. # # # $eprice =~ s/\$.*\$/\$/s; # if ($eprice =~ m/\$(\d+)\b/si) { # $eprice = $1; # } # } # $eprice =~ s/^\$//s; # print STDERR ("$progname: WARNING: $ticket: $calid:" . # " price mismatch: \"$name\"\n" . # "\tstore: $price\n" . # "\tcal: $eprice\n\n") # if ($price != $eprice); # Make sure the ticket's thumbnail matches the event's flyer. # $eflyer = $url_base . $eflyer if ($eflyer); if ($eflyer && !$flyer) { # print STDERR "$progname: WARNING: $ticket: $eid:" . # " thumb missing: \"$name\"\n" . # "$progname: $eflyer\n\n" # if ($verbose); } elsif ($flyer ne $eflyer) { print STDERR "$progname: WARNING: $ticket: $eid:" . " thumb mismatch: \"$name\"\n" . "$progname: " . ($flyer || "''") . " vs\n" . "$progname: " . ($eflyer || "''") . "\n\n" if ($verbose); } my $desc = extract_ticket_name ($ticket, $calid, $event->{title}, $name, $vip); my $url = $ticket_url_base . $ticket; # If this is a VIP ticket with a nonstandard price, include the # price in the description. # my $vprice = $vip_price; $vprice =~ s/^\$//s; if ($vip && $price != $vprice) { $desc = 'VIP Service' unless $desc; $price =~ s/\.00$//s; $desc .= ": \$$price"; } my @t = ($url, $desc, $price, $onsale, $offsale, $vip); if ($hidden || $soldout) { print STDERR "$progname: $eid: ticket $ticket is sold out\n" if ($soldout && $verbose > 1); print STDERR "$progname: $eid: ticket $ticket is hidden\n" if ($hidden && $verbose > 1); } else { my $P = $event->{tickets}; my @P = ($P ? @$P : ()); push @P, \@t; $event->{tickets} = \@P; $ticket_events{$eid} = $event; } $ok = 1; } print STDERR "$progname: ticket $ticket: $calid: " . "no matching event: $tyear-$tmon-$tdotm\n" unless $ok; } # Sort the tickets in the events we've modified. # - Non-VIP tickets come before VIP tickets. # - Else, sort by price. # - Else, sort by onsale date. # - Else, sort by ticket number. # foreach my $event (values %ticket_events) { my @t = @{$event->{tickets}}; @t = sort { my ($urla, $desca, $pricea, $onsalea, $offsalea, $vipa) = @$a; my ($urlb, $descb, $priceb, $onsaleb, $offsaleb, $vipb) = @$b; if ($vipa != $vipb) { return $vipa cmp $vipb; } elsif ($pricea != $priceb) { return $pricea <=> $priceb; } elsif ($onsalea != $onsaleb) { return $onsalea <=> $onsaleb; } else { return $urla cmp $urlb; } } @t; $event->{tickets} = \@t; } # If an event has a bunch of tickets (that is, more than one non-VIP or # more than one VIP) then tag each ticket with its price. # foreach my $event (values %ticket_events) { my $non_count = 0; my $vip_count = 0; foreach my $t (@{$event->{tickets}}) { my ($url, $desc, $price, $onsale, $offsale, $vip) = @$t; if ($vip) { $vip_count++; } else { $non_count++; } } if ($non_count > 1 || $vip_count > 1) { foreach my $t (@{$event->{tickets}}) { my @t = @$t; my ($url, $desc, $price, $onsale, $offsale, $vip) = @t; if (! $desc) { $desc = ($vip ? 'VIP Service' : 'Buy Tickets'); } $desc .= ": \$$price" unless ($desc =~ m@\$\d@s); @t = ($url, $desc, $price, $onsale, $offsale, $vip); $t = \@t; } } } } # Write all of the files: # - calendar/YYYY/MM.html # - calendar/YYYY/MM.txt # - calendar/YYYY/MM-DD.html # - calendar/upcoming.html # - calendar/overview.html # - calendar/dnalounge.rss # - calendar/crontab.txt # - tickets/index.html # sub generate_calendars($$$$$) { my ($dir, $first, $last, $summarize_only_p, $topten_p) = @_; load_template (); error ("from range must be YYYY-MM: $first\n") unless $first =~ m/^\d{4}-\d{2}$/; error ("to range must be YYYY-MM: $last\n") unless $last =~ m/^\d{4}-\d{2}$/; $_ = $first; my ($first_year, $first_month) = m/^(\d{4})-(\d{2})$/; $_ = $last; my ($last_year, $last_month) = m/^(\d{4})-(\d{2})$/; @future_events = (); $yesterday_event = undef; for (my $year = $last_year; $year >= $first_year; $year--) { my $start_month = ($year == $first_year ? $first_month : 1); my $end_month = ($year == $last_year ? $last_month : 12); for (my $month = $end_month; $month >= $start_month; $month--) { my $outfile = sprintf ("$dir/$year/%02d.html", $month); my $prev = !($year == $first_year && $month == $first_month); my $next = !($year == $last_year && $month == $last_month); write_month_bodies ($dir, $year, $month, $outfile, $prev, $next, ($summarize_only_p || $topten_p)); } } return if ($summarize_only_p =~ m/^../s); # it's a date ("--only") if (! $topten_p) { check_impending_tba () unless ($summarize_only_p); generate_ticket_portals ($dir); generate_tickets_html ($dir); generate_calendar_overview ($dir); generate_calendar_upcoming ($dir); generate_calendar_rss ($dir); generate_calendar_ical ($dir); generate_crontab ($dir); generate_weekly ($dir); generate_infoline ($dir); generate_names_file ($dir); generate_eighties_file ($dir) unless ($summarize_only_p); } generate_ledger_html ($dir, $topten_p) unless ($summarize_only_p); } # Generates all of the "YYYY/index.html" pages listing all the months # in each year. # sub generate_months($$$) { my ($dir, $first, $last) = @_; error ("from range must be YYYY-MM: $first\n") unless $first =~ m/^\d{4}-\d{2}$/; error ("to range must be YYYY-MM: $last\n") unless $last =~ m/^\d{4}-\d{2}$/; $_ = $first; my ($first_year, $first_month) = m/^(\d{4})-(\d{2})$/; $_ = $last; my ($last_year, $last_month) = m/^(\d{4})-(\d{2})$/; for (my $year = $first_year; $year <= $last_year; $year++) { my $start_month = ($year == $first_year ? $first_month : 1); my $end_month = ($year == $last_year ? $last_month : 12); my $output = ""; $output .= "$page_title: $year\n"; my @order = (1, 5, 9, 2, 6, 10, 3, 7, 11, 4, 8, 12); my $row = 0; my $col = 0; { my $links = ''; my $prev = sprintf ("%04d", $year-1); my $next = sprintf ("%04d", $year+1); $prev = undef if ($year == $first_year); $next = undef if ($year == $last_year); my $fh = ($year == $first_year ? undef : "../$first_year/"); my $lh = ($year == $last_year ? undef : "../$last_year/"); $links .= " \n"; $links .= " \n"; $links .= " \n" if ($fh); $links .= " \n" if ($prev); $links .= " \n" if ($next); $links .= " \n" if ($lh); $links .= $xml_link_tag; $output .= $links; } { my $prev = sprintf ("%04d", $year-1); my $next = sprintf ("%04d", $year+1); my $prev_href = ($year == $first_year) ? undef : "../$prev/"; my $next_href = ($year == $last_year) ? undef : "../$next/"; # Kludge for the ancient history... # if ($year == $first_year) { my $f = $calendar_eighties_file; $f =~ s/\.txt$/.html/s; $prev_href = "../$f"; $f =~ s/\..*$//; $prev = $f; } $prev = "<< $prev"; $next = "$next >>"; $output .= ("\n" . ($prev_href ? "$prev\n" : "$prev\n") . ($next_href ? "$next\n" : "$next\n") . "\n"); } $output .= "\n"; $output .= "\n"; $output .= "$year Calendar\n\n"; $output .= "
    " . "\n"; $output .= " \n"; for (my $i = 0; $i < 12; $i++) { my $month = $order[$i]; my $text = $months[$month-1]; if ($month >= $start_month && $month <= $end_month) { $text = sprintf ("$text", $month); } else { $text = "$text"; } my $align = ($col == 0 ? "RIGHT" : $col == 1 ? "CENTER" : "LEFT"); $output .= " \n"; if (++$col == 3) { $col = 0; $row++; $output .= " \n"; $output .= " \n" if ($row < 4) } } $output .= "
    $text
    \n"; $output .= "\n"; my $outfile = "$dir/$year/index.html"; DNA::Menuify::write_file ($outfile, $output); } write_years_index ($dir, $first_year, $last_year); } # Writes the HTML for the page listing all years (calendar/index.html). # sub write_years_index($$$) { my ($dir, $first, $last) = @_; $dir .= "/" unless ($dir =~ m@/$@); $dir = "" if $dir eq "./"; my $output = ""; my $page_title = "Calendar Archive"; my $td = ("TD VALIGN=TOP STYLE=\"font-size:larger; font-weight: bold;" . " padding: 0.1em 0.5em;\""); $output .= ("DNA Lounge: $page_title\n\n" . "\n" . "\n" . "$page_title\n\n" . "

    \n" . "
    \n" . "\n" . " \n" . " <$td ALIGN=CENTER COLSPAN=2>" . "1985-1999" . "\n" . " \n" . " \n" . " <$td ALIGN=RIGHT>\n"); my $i = 0; foreach my $year ($first .. $last) { $output .= " \n <$td ALIGN=LEFT>\n" if ($i == int(($last-$first)/2)+1); $output .= " $year
    \n"; $i++; } $output .= ( "\n" . " \n" . " \n" . " <$td ALIGN=CENTER COLSPAN=2>
    \n" . "Latest\n" . "\n" . " \n" . " \n" . " <$td ALIGN=CENTER COLSPAN=2>
    " . "". "Alphabetically
    by performer    " . "\n" . "\n" . "
    \n" . "
    \n"); $output .= "\n"; my $outfile = "${dir}index.html"; DNA::Menuify::write_file ($outfile, $output); } ############################################################################## sub error($) { my ($err) = @_; print STDERR "$progname: $err\n"; exit 1; } sub usage() { print STDERR "usage: $progname [--verbose] [--quiet] [--debug]\n" . "\t[--summarize-only] [--topten] [--ping-videos] [--only DD-MMM-YYYY]\n" . "\tdirectory [configfile]\n"; exit 1; } sub main() { my ($dir, $infile); my $summarize_only_p = 0; my $topten_p = 0; my $ping_videos_p = 0; error ("LANG is $ENV{LANG} -- UTF is no good, man!") if ($ENV{LANG} && $ENV{LANG} =~ m/utf/i); while ($_ = $ARGV[0]) { shift @ARGV; if (m/^--?verbose$/s) { $verbose++; } elsif (m/^-v+$/) { $verbose += length($_)-1; } elsif (m/^--?q(uiet)?$/s) { $verbose = 0; } elsif (m/^--?summarize(-only)?$/s) { $summarize_only_p++; } elsif (m/^--?topten$/s) { $topten_p++; } elsif (m/^--?ping-videos$/s) { $ping_videos_p++; } elsif (m/^--?debug$/s) { $debug_p++; } elsif (m/^--?only$/s) { $summarize_only_p = shift @ARGV; } elsif (m/^-./) { usage; } elsif (!defined($dir)) { $dir = $_; } elsif (!defined($infile)) { $infile = $_; } else { usage; } } usage unless $dir; $dir =~ s@/+$@@; # lose trailing slash $infile = $calendar_data_file unless ($infile); $summarize_only_p = 0 if ($topten_p); $DNA::Menuify::verbose = $verbose; $DNA::Menuify::debug = $debug_p; $DNA::Menuify::validate = $debug_p; $DNA::Markdown::verbose = $verbose; $DNA::Markdown::debug = 0; $ua->agent("$progname/$version"); # set user agent for all LWP::Simple calls load_event_ids ($calendar_eventid_file); load_galleries ("$dir/$gallery_file"); load_title_images ($dir); load_portal_dirs ($dir); load_calendar ($infile, $summarize_only_p); load_tickets ($calendar_store_file); my ($from, $to) = find_scheduled_range (); generate_calendars ($dir, $from, $to, $summarize_only_p, $topten_p); generate_months ($dir, $from, $to) unless ($summarize_only_p || $topten_p); ping_videos() if ($ping_videos_p); } main(); exit 0;