#!/usr/bin/perl -w # Copyright © 2000-2013 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 POSIX qw(mktime strftime); use LWP::Simple qw($ua); use LWP::UserAgent; use Text::Wrap; use HTML::Entities; #use open ":encoding(utf8)"; # costs 50% speed BEGIN { push @INC, ("utils/", "calendar/"); } use Menuify; # DNA::Menuify use Markdown; # DNA::Markdown DNA::Menuify->import qw(error url_quote url_unquote html_quote html_unquote cgi_exec); ############################################################################## # # Configuration and stuff # ############################################################################## my $progname = $0; $progname =~ s@.*/@@g; my $version = q{ $Revision: 1.905 $ }; $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_thumbs_file = "thumbs.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 $warnings_file = "warnings.html"; my $posters_file = "../store/posters.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://www.dnalounge.com/order/"; my $ticket_url_base = "$ticket_form_url?item="; 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; ############################################################################## # # Data structures and stuff # ############################################################################## my %calendar = (); # keys are "YYYY-MM-DD", values are references to lists # (since there can be multiple 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 # venue 0 or 1 (which room it's in) # 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 events # ogalleries saved copy to reset 'galleries' # age "21", "18", or "AA" # adv text (advance ticket price) # door text (door price) # price text (adv and door merged together) # genre text # tickets ("url" "desc" vip-p price offsale-p # onsale_time offsale_time) # webcast "main", "lounge", "off" # videos ( ("youtube-url" "title") ... ) # 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 %posters; # which flyers are on sale in the store 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 %wrote_files; 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 # ############################################################################## # Does a halfassed attempt at downcoding a Unicode string to ASCII. # Some Unicode characters may remain. # sub asciify($) { my ($s) = @_; # Convert Unicode to entities; hack those; convert back. $s = html_quote ($s); $s =~ s@&([a-zA-Z])(uml|acute|grave|circ|tilde|cedil|ring|slash);@$1@gs; return html_unquote ($s); } # Performs some simple cleanup on the HTML (mainly stripping whitespace from # strategic places) # sub clean_html($$) { my ($lineno, $html) = @_; # handle backslashes at end-of-line $html =~ s/\\\n[ \t]*//gs; # delete HTML comments. $html =~ s/[ \t]*[ \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}}; # If the event is over by 10:30pm, then it counts as a "daytime" event, # because we could conceivably have a second event after it. # (Logic duplicated in calendar/edit.cgi) # my $e_early_p = ($end_minute <= (22 * 60) + 30); 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)" . print STDERR sprintf("%d: %04d-%02d-%02d (%s)", $lineno, $year, $month, $dotm, $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.../; my $venue = $entry_hash->{venue}; my $d1 = key_suffix (sprintf ("%04d-%02d-%02d", $from_year, $from_month, $from_day), $venue, $early_p); my $d2 = key_suffix (sprintf ("%04d-%02d-%02d", $to_year, $to_month, $to_day), $venue, $early_p); print STDERR "$progname: $lineno: stored $d1 - $d2" . " 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. # # Now that there are two venues, venue #2 uses "c" and "d". # Add the proper suffix to the event key: # YYYY-MM-DDa (DNA Lounge, early) # YYYY-MM-DD (DNA Lounge, late) # YYYY-MM-DDc (Above DNA, late) # YYYY-MM-DDd (Above DNA, late) # YYYY-MM-DDe (DNA Pizza, late) # YYYY-MM-DDf (DNA Pizza, late) # sub key_suffix($$$) { my ($key, $venue, $early_p) = @_; error ("$key already has a suffix") if ($key =~ m/[a-z]$/si); error ("bad key: $key") unless ($key =~ m/^\d{4}-\d\d-\d\d$/s); if ($venue == 0) { $key .= ($early_p ? 'a' : ''); } elsif ($venue == 1) { $key .= ($early_p ? 'c' : 'd'); } elsif ($venue == 2) { $key .= ($early_p ? 'e' : 'f'); } else { error ("bogus venue $venue"); } return $key; } sub splice_price($$) { my ($adv, $door) = @_; my $price = $adv || $door || ''; if ($adv && $door) { $adv =~ s/\.$//s; foreach ($adv, $door) { s/\.$//s; } $adv .= ' advance' if ($adv =~ m/^\$[\d.]+$/s); $door .= ' door' if ($door =~ m/^\$[\d.]+$/s); $price = "$adv; $door"; } $price .= '.' if ($price =~ m/[^.!]$/s); # Gaaah. "$10 after; $10 gen. adm." $price =~ s@((\$[\d.]+) after); \2 gen\. adm\.$@$1.@gsi; return $price; } # 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; print STDERR "WARNING: $lineno: non-ASCII character ($1)\n" if ($body =~ m/([^\s -\176])/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 = html_unquote ($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 $h = $headers; my $venue = ($h =~ s@^\s* VENUE: \s* (.*?) \s* $@@mix) ? $1 : undef; my $time = ($h =~ s@^\s* TIME: \s* (.*?) \s* $@@mix) ? $1 : undef; my $age = ($h =~ s@^\s* AGE: \s* (.*?) \s* $@@mix) ? $1 : undef; my $genre = ($h =~ s@^\s* GENRE: \s* (.*?) \s* $@@mix) ? $1 : undef; my $adv = ($h =~ s@^\s* ADV: \s* (.*?) \s* $@@mix) ? $1 : undef; my $door = ($h =~ s@^\s* DOOR: \s* (.*?) \s* $@@mix) ? $1 : undef; my $flyer = ($h =~ s@^\s* FLYER: \s* (.*?) \s* $@@mix) ? $1 : undef; my $video1 = ($h =~ s@^\s* VIDEO: \s* (.*?) \s* $@@mix) ? $1 : undef; my $video2 = ($h =~ s@^\s* VIDEO: \s* (.*?) \s* $@@mix) ? $1 : undef; my $video3 = ($h =~ s@^\s* VIDEO: \s* (.*?) \s* $@@mix) ? $1 : undef; my $live_p = ($h =~ s@^\s* LIVE: \s* (.*?) \s* $@@mix) ? $1 : undef; my $webcast = ($h =~ s@^\s* WEBCAST: \s* (.*?) \s* $@@mix) ? $1 : undef; my $hype_p = ($live_p && $live_p =~ m/^HYPE$/si); if (! defined($venue) || $venue =~ m/^DNA Lounge$/si) { $venue = 0; } elsif ($venue =~ m/^Above DNA$/si) { $venue = 1; } elsif ($venue =~ m/^DNA Pizza$/si) { $venue = 2; } else { error ("$lineno: venue unparsable: \"$venue\""); } my $key; if (defined($dotm)) { $key = sprintf ("%04d-%02d-%02d", $year, $month, $dotm); $key = key_suffix ($key, $venue, $early_p); } $live_p = ($live_p ? 1 : 0); # it's a bit-field, kinda. foreach my $val ($time, $genre, $adv, $door) { ($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, $venue, $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 = html_unquote ($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"); } print STDERR "$progname: WARNING: $lineno: $key: no age for \"$title\"\n" unless ($age || $title =~ m/^\(?CLOSED|CANCELL?ED|SUSPENDED\)?$/si); my @videos = (); foreach my $video ($video1, $video2, $video3) { next unless $video; $video = DNA::Markdown::fix_naked_ampersand($video); my $vurl = ($video =~ s@\s*\b(https?:[^\s]+[a-z\d/])\s*@@gsi) ? $1 : undef; error ("no URL in VIDEO: $video") unless $vurl; error ("no title in VIDEO: $video") unless ($video =~ m/[a-z]/i); push @videos, [ $vurl, $video ]; } foreach my $p (@$performers) { my ($name, $type) = @$p; if ($type eq 'BAND') { $live_p |= 2; last; } } $headers =~ s/^(TIME|AGE|GENRE|ADV|DOOR|FLYER|VIDEO|LIVE|WEBCAST|HYPE|VENUE) :[^\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{venue} = $venue; $hash{age} = $age; $hash{adv} = $adv; $hash{door} = $door; $hash{price} = splice_price ($adv, $door); $hash{genre} = $genre; $hash{webcast} = $webcast; $hash{videos} = \@videos; $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 $venue = $event->{venue}; my ($year, $month, $dotm, $dotw, $start_minute) = @$times; if (! defined($key)) { # This is a repeating event. $key = sprintf ("%04d-%02d-%02d", $year, $month, $dotm); $key = key_suffix ($key, $venue, $early_p); $event->{key} = $key; } my $nevents = 1; my $event_number = 0; # YYYY-MM-DDa = DNA Lounge Early; # YYYY-MM-DDc = Above DNA Early. # YYYY-MM-DDe = DNA Pizza Early. if ($key =~ m/^(\d{4}-\d\d-\d\d)[ace]$/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"}) || defined($calendar{$1 . "c"}) || defined($calendar{$1 . "e"}))) { $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, $venue, $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. # "YYYY-MM-DDa" < "YYYY-MM-DD" < "YYYY-MM-DDc" (the "b" is silent). # sub calendar_id_cmp($$) { my ($a, $b) = @_; foreach ($a, $b) { $_ .= 'b' 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([a-z])?$/); 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 (html_unquote ($title)); $title =~ s/<[^<>]*>/ /gsi; $title =~ s/:\s+.*$//s; $title =~ s/^\s+|\s+$//gsi; my $pres = $event->{pres} || ''; $pres = lc (html_unquote ($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 ($pres); $p =~ s/\s+/ /gsi; $p =~ s/^\s+|\s+$//gsi; next unless $p; # Don't link in-house promoted events together, since they generally # don't have anything to do with each other. next if ($p eq 'dna lounge'); 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. # (Logic duplicated in calendar/edit.cgi) # sub extract_hours($$$) { my ($text, $dotw) = @_; my ($start, $end); $text =~ s@<[^<>]*>@ @gsi; my $otext = $text; # Correct typo. error ("missing AM/PM: \"$text\"") if ($text =~ m@\b(\d\d?(:\d\d)?\s+(door|show))@si || $text =~ m@\b(\d\d?(:\d\d)?)[;.]@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; $start = 60 * 24 if ($start == 0); # midnight means 12:00 AM tomorrow 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 ~6 hours later. # $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; $start = 60 * 24 if ($start == 0); # midnight means 12:00 AM tomorrow if (!defined($end)) { if ($start < (60 * 18)) { # starts before 6pm... $end = $start + (60 * 6); # guess end time of +6 hours. } 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 # ############################################################################## 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}[a-z]?)$/s); my ($dotm) = ($dd =~ m/^(\d+)[a-z]?$/s); my $key = $name; $key = html_unquote ($key); $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 = asciify (html_unquote ($name)); $name2 =~ s/$noisewords//si; if (defined($listref)) { # there was an entry already my ($oname, $otype, $ourl, $oord, $odatesref) = @list; $oname = asciify (html_unquote ($oname)); $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: WARNING: $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: WARNING: $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 (html_unquote (lc ($s))); # try to downcode unicode $s = lc($s); $s =~ s/^(the|dj|mc|mr\.?)\s+//i; # lose leading noise words my $o = $s; $s =~ s/[-.]//gs; # omit dots and hyphens $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 =~ s/^plus d$/a plus d/gs; # kludge $s = "0 $o" if ($s eq ''); # worst case... $s =~ s/[^\001-\176]/\177/gs; # lose remaining unicode # 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[a-z]?)$/s); my $u = ($year < 2001 ? "1985-1999.html\#$year" : sprintf("%04d/%02d-%s.html", $year, $month, $dd)); my ($dotm) = ($dd =~ m/^(\d+)[a-z]?$/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://www.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, html_unquote ($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, html_unquote ($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, html_unquote ($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 = html_unquote ($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); $wrote_files{$outfile} = 1; 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" . "Bands and DJs\n" . "\n" . "


\n" . "
\n" . " $band_count bands
\n" . " $dj_count djs
\n" . " $nevents events
\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" . $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); $wrote_files{$outfile} = 1; } # 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)([a-z])?$/); next unless defined ($dotm); my $event = $calendar{$key}; my $title = $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 = html_unquote ($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, $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); $wrote_files{$outfile} = 1; } # 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 =~ s/:\s+$//gsi; $bands = "$bands" if ($flyer); $output .= (" " . "$date" . "" . "$bands" . "\n"); } close $in; $output .= "\n"; my $title = "1985-1999"; $output = ("$title\n" . "\n" . " \n" . "\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); $wrote_files{$outfile} = 1; } ############################################################################## # # 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, $venue, $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?)([a-z]?)[-\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 = key_suffix (sprintf ("%04d-%02d-%02d", $nyear, $nmonth, $ndotm), $venue, $early_p); $key =~ m/^(\d{4})-(\d{2})-(\d{2})([a-z]?)$/si; my $odotm = 0 + $3; my $omonth = $2; my $oyear = 0 + $1; my $onumeric = ($oyear * 10000) + ($omonth * 100) + $odotm; 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}[a-z]?)$/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($event->{title}); $key =~ s/: .*$//s; $key =~ s/:, .*$//s; return $all_galleries{$key}; } # Populate the %posters table with the file names that are on sale. # sub load_posters($) { my ($dir) = @_; my $count = 0; print STDERR "$progname: reading $posters_file\n" if ($verbose > 2); open (my $in, '<', "$dir/$posters_file") || error ("$posters_file: $!"); local $/ = undef; # read entire file my $body = <$in>; close $in; $body =~ s/^\s+/ /gm; $body =~ s/(\"]+)\"/si); next unless $href; my ($file) = ($href =~ m@(flyers/\d{4}/\d\d/\d\d[a-z]?\.html)@); next unless $file; $posters{$file} = 1; $count++; } error ("no posters on sale?") unless $count; print STDERR "$progname: $count posters on sale\n" if ($verbose > 2); } # 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. # As a side-effect, stores the title into the $portal_dirs table. # 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[a-z]?)$/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[a-z]?)$/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, $venue, $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)); next if ($venue != $entry_hash->{venue}); # 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 = key_suffix (sprintf ("%04d-%02d-%02d%s", $year, $month, $dotm), $venue, $early_p); $_ = $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; next unless $e; 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 = "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[a-z]?)$/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 (asciify (html_unquote ($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([a-z])?$/) { # real events, not holidays my $suf = ($1 || 'b'); my $early_p = ($suf =~ m/^[ace]$/s); 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+)[a-z]?$/) { 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 ($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 >>"; return ($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 per venue. # 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, $venue, $night_p) = @_; my $k0 = key_suffix ($key, $venue, 0); my $ka = key_suffix ($key, $venue, 1); my $e0 = $calendar{$k0}; my $ea = $calendar{$ka}; return undef unless ($e0 || $ea); my $e; if (!$night_p && $ea && $e0) { $e = $ea; } # day A+0 11 elsif (!$night_p && !$ea && $e0) { $e = undef; } # day 0 01 elsif (!$night_p && $ea && !$e0) { $e = $ea; } # day A 10 elsif ( $night_p && $ea && $e0) { $e = $e0; } # night A+0 11 elsif ( $night_p && !$ea && $e0) { $e = $e0; } # night 0 01 elsif ( $night_p && $ea && !$e0) { $e = undef; } # night A 10 else { error ("$key: um what? $venue/$night_p/$ea/$e0"); } 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_venue_events($$$$$) { my ($year, $month, $dotm, $venue, $include_closed_p) = @_; my $key = sprintf ("%04d-%02d-%02d", $year, $month, $dotm); my @events = (); my $e0 = get_event ($key, $venue, 0); my $e1 = get_event ($key, $venue, 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, $venue, $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, $venue, $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 a list of events falling on the given day, in any venue. # They may be real events, or repeaters. # sub get_all_events($$$$) { my ($year, $month, $dotm, $include_closed_p) = @_; my @events = (); for (my $venue = 0; $venue <= 2; $venue++) { push @events, get_all_venue_events ($year, $month, $dotm, $venue, $include_closed_p); } 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" . "
    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; my $oclass = $class; foreach my $e (@events) { my $key = $e->{key}; my ($yyyy, $mm, $dd) = ($key =~ m/^(\d{4})-(\d{2})-(\d{2}[a-z]?)$/s); my $n = $#events + 1; if ($n > 1) { # use "ccell2a" or "ccell2b" to get two half-height boxes; # use "ccell3a", "ccell3b" "ccell3c" for three third-height, etc. $class = "$oclass ccell$n" . (chr(ord('a') + $count)); } my $title = html_quote (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 $thumbs = generate_calendar_thumbs_1 ($dir, $today_event); $thumbs =~ s@((HREF|SRC)=\")@$1../@gsi; $output .= "

    $thumbs"; } return $output; } ############################################################################## # # Generating full calendar body text and html # ############################################################################## # Constructs an EMBED tag from a YouTube URL. # sub make_embed_tag($$) { my ($url, $title) = @_; my $url2 = $url; if ($url =~ m@^http://www\.youtube\.com/@) { error ("extra junk in youtube URL: $url") if ($url =~ m/\&|\?.*\?/); $url2 =~ s@&.*$@@; # lose args $url2 =~ s@/(watch)?\?v=@/embed/@; # "/watch?v=XXX" => "/embed/XXX" } else { error ("VIDEO URL is not YouTube: $url"); } return ("

    " . # Note: rewritten by DNA::Menuify "
    " . "" . "
    " . "
    " . ($title ? "$title" : "") . "\n"); } # 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. # future_p: is this event in the future. # simple_p: generate less complex HTML for the weekly.html email and RSS. # sub build_event_html($$$) { my ($event, $future_p, $simple_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 $videos = $event->{videos}; 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} || ''; my ($year, $mm, $dotm) = @$times; my $dotw = dotw ($dotm, $mm, $year); my ($dd) = ($key =~ m/^\d{4}-\d{2}-(\d{2}[a-z]?)$/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 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; if (! $meta) { # No blurb? Try to simplify the lineup. $meta = $html; $meta =~ s@]*>@@gsi; $meta =~ s@([^\s.?!;:])\s*
    @$1.@gsi; # Punctuate after performers. $meta =~ s@

    @
    @gsi; # No paras. $meta =~ s@<[^<>]*>@@gsi; # Kill remaining tags. $meta =~ s@([^\s.?!;:])$@$1.@si; # Trailing period. } $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); # How many characters in a description tag? Google shows 156, and # Yahoo shows 161. However, Google *indexes* more than that, and # will show more if it's in a search hit. So, let's guess... # my $max = 400; $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?)"; # Count up the various ticket types. # my $vip_count = 0; my $vip_soldout_count = 0; my $non_vip_count = 0; my $non_vip_soldout_count = 0; my $total_onsale_count = 0; my $last_vip_onsale = -1; my $last_non_vip_onsale = -1; foreach my $t (@$tickets) { my ($ticket, $desc, $vip_p, $price, $offsale_p) = @$t; $total_onsale_count++ unless $offsale_p; if ($vip_p) { $vip_count++; $vip_soldout_count++ if ($offsale_p == 2); $last_vip_onsale = $vip_count unless $offsale_p; } else { $non_vip_count++; $non_vip_soldout_count++ if ($offsale_p == 2); $last_non_vip_onsale = $non_vip_count unless $offsale_p; } } # Emit HTML warning of sold out tickets. # if ($non_vip_count > 0 && # tickets on sale $non_vip_count == $non_vip_soldout_count) { # and all sold out if ($vip_count > 0 && # vip on sale $vip_count != $vip_soldout_count) { # but not all sold out $out .= "Gen. adm. tickets are "; } $out .= ("SOLD OUT!" . "
    Extremely limited tickets will be available at the door." . "

    "); } # Emit HTML forms for the tickets. # my $vip_i = 0; my $non_vip_i = 0; foreach my $t (@$tickets) { my ($ticket, $desc, $vip_p, $price, $offsale_p, $onsale) = @$t; $vip_i++ if $vip_p; $non_vip_i++ unless $vip_p; my $last_vip_p = ($vip_p && $vip_i == $last_vip_onsale); my $last_non_vip_p = (!$vip_p && $non_vip_i == $last_non_vip_onsale); if ($offsale_p < 0) { # not yet on sale $ticket = undef; $first_onsale_date = $onsale unless (defined($first_onsale_date) || $out); } elsif ($offsale_p > 0) { # no longer on sale, or sold out $ticket = undef; } if (!$ticket) { } elsif ($simple_p) { $out .= ("" . "$desc" . ($last_vip_p ? "
    $vip_blurb" : "") . "
    "); } else { my ($id) = ($ticket =~ m/\bitem=(\d+)/s); #### duplicated in /order/index.php $MAX_TICKETS_PER_LINE. my $max_tickets = 99; $out .= ("

    \n" . " \n" . " \n" . " \n" . ($last_vip_p ? "\n$vip_blurb\n" : "") . "
    \n"); } # Put a space between VIP and non-VIP if we have both. $out .= "
    " if (!$simple_p && $total_onsale_count > 0 && $last_non_vip_p && $vip_count > 0 && $vip_count != $vip_soldout_count); } if (!$out && $first_onsale_date) { my $s = strftime ("%a, %b %e at %I%p", localtime($first_onsale_date)); $s =~ s/(AM|PM)$/\L$1/s; # downcase $s =~ s/ at 12\s*AM//gsi; # omit midnight $s =~ s/\b12\s*PM/noon/gsi; # noon $out = "Tickets on sale $s."; } $tickets = $out; } $tickets = '' unless $tickets; my $vcount = 0; my $video_out = ''; foreach my $v ($videos ? @$videos : ()) { my ($video, $vtitle) = @$v; # Omit trailing "YY-MM-DDDD" $vtitle =~ s/[:,] \d\d?[- ][A-Z][a-z][a-z][- ]\d{4}$//gs; # Omit trailing year $vtitle =~ s/[:,]? \d{4}$//gs; my $vo = ''; if ($simple_p) { $vo .= "
    "; $vo .= "Watch and listen: " if ($vcount == 0); $vo .= "$vtitle
    "; } else { $vo = make_embed_tag ($video, $vtitle); } $vo =~ s/\s+/ /gs; $vo = "
    $vo
    "; $video_out .= $vo; $vcount++; } # $video_out = "
    $video_out
    " # if ($video_out); 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); if ($ghtml) { my $c = "event_photos"; $c .= " noflyer" unless $flyer; $ghtml = "
    $ghtml
    "; } $galleries = $ghtml; } else { $galleries = ''; } my $fimg = undef; if ($flyer) { $fimg = $flyer; $fimg =~ s@\.html$@-1-thumb.jpg@si; if (! -f $fimg) { my $f2 = $fimg; $f2 =~ s/\.jpg$/.gif/si; error ("$fimg does not exist") unless (-f $f2); $fimg = $f2; } my $poster_p = defined($posters{$flyer}); $flyer = "../../$flyer"; $fimg = "../../$fimg"; $flyer = ""; $flyer .= ("

    \n" . "Buy this poster!" . "

    \n") if ($poster_p); $flyer = "

    $flyer
    \n"; } my $flyer_top = $flyer; my $video_top = $video_out; my $flyer_bot = $flyer_top; my $video_bot = $video_top; $flyer_bot =~ s/_top\b/_bottom/gs; $video_bot =~ s/_top\b/_bottom/gs; $flyer = undef; $video_out = undef; # Only one in weekly and RSS since we don't have CSS selectors. $flyer_bot = '' if ($simple_p); $video_bot = '' if ($simple_p); 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; $price =~ s@(\.]+>)\s*@$1
    @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) || ''; # White background on images for weekly.html and RSS. my $title_img = find_title_image ($title, !$simple_p); my $sub; $title = html_quote ($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_box = ("

    \n" . "
    \n" . $date_html . $holiday . $repeat . $time . $genre . $age . $price . "
    \n" . "
    \n"); $mm = sprintf("%02d", $mm); my $links .= (" \n" . " \n" . " \n" . " \n" . $xml_link_tag); my $left = ''; my $related = ''; if (!$simple_p) { # No "upcoming related events" in weekly, RSS my $p1 = $event->{prev_event} || ''; my $n1 = $event->{next_event} || ''; my $p2 = $event->{prev_similar} || ''; my $n2 = $event->{next_similar} || ''; $otitle =~ s/:\s.*$//s; 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}[a-z]?)$/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, html_quote ($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; # "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; # 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); if ($simple_p) { # no arrow links in weekly or RSS $n1 = ''; $p1 = ''; } $title =~ s@^(]*>)(.*)(
    )$@$1$n1$2$3@si if $n1; $title =~ s@^(]*>)(.*)()$@$1$p1$2$3@si if $p1; } my $event_output = ("
    \n" . # hcalendar "\n" . # hcalendar $title . ($simple_p ? "

    " : "") . $flyer_top . $video_top . ($simple_p ? "" : $awards) . $galleries . ($simple_p ? $awards : "") . "

    \n" . $stats_box . "
    \n" . "
    \n" . $tickets . $fblike . $share . $photo . "
    \n" . "
    \n" . "
    \n" . # hcalendar "
    \n" . " $html\n" . "
    \n" . "
    \n" . " $blurb\n" . "
    \n" . $flyer_bot . $video_bot . "
    \n" . "
    \n"); $event_output = clean_html ($date, $event_output); $month =~ s/^(...).*$/$1/s; # Use the flyer as the thumbnail for this page for Facebook. # If there's no flyer but there is a video, use that. # if (!$fimg) { my $videos = $event->{videos}; foreach my $v ($videos ? @$videos : ()) { my ($video, $vtitle) = @$v; if ($video =~ m@[?/]v[=/]([^/&?\s\"\'<>]+)@si) { $fimg = "http://img.youtube.com/vi/$1/0.jpg"; last; } } } if ($fimg) { $fimg = DNA::Menuify::expand_url ($fimg, $url); $links .= " \n"; } $month =~ s/^(...).*$/$1/gsi; $dotw =~ s/^(...).*$/$1/gsi; my $ptitle = sprintf ("DNA Lounge: %s, %d %s %04d (%s)", html_quote ($event->{title}), $dotm, $month, $year, $dotw); $event_output = ("\n" . " $ptitle\n" . $links . "\n" . "\n" . "\n" . $event_output . ($simple_p ? '' : $related) . "\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 $key = $event->{key}; 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 $videos = $event->{videos}; 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); $price = html_unquote ($price); $price =~ s@.*?[.;]?@@gs; $price =~ s/<[^<>]*>//gs; $price =~ s/\s+/ /gs; $price =~ s/^\s+|\s+$//gm; $price =~ s@;\s*$@.@gs; 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 = html_unquote ($pres); } $title = html_unquote ($title); if (! $infoline_p) { # This makes uc() work, but it fails in Perl 5.8.8. # use feature 'unicode_strings'; # So do it this super-sketchy way: # eval 'use feature "unicode_strings"; $title = uc ($title)'; # No, that's no good, because then traitor and cerebrum have # different behavior and fight with each other. # $title = uc ($title); # So instead, try to upcase it, then convert it to entities; upcase any # obviously-still-lower-case entities; then convert it back. # $title = HTML::Entities::encode_entities ($title); $title =~ s@&([a-z](uml|acute|grave|circ|tilde|cedil|ring|slash);) @&\u$1@gsx; $title = HTML::Entities::decode_entities ($title); $title =~ s/\b([ND])(:CODE)/\l$1$2/gs; #### Kludge for "n:CODE" } # 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 && !$infoline_p); $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; } # Find the Facebook event ID for this event. # my $rsvp = ''; foreach my $key (@{$event_ids{$key}}) { my ($site, $id) = ($key =~ m/^(.*?)=(.*)$/si); if ($site eq 'facebook') { my ($url, $name) = make_event_id_url ($site, $id, $title); $rsvp = $url; last; } } # put some URLs between the head and the tail. # the Facebook URL always come first. # my @event_urls; if (! $infoline_p) { my $u = $event->{title_url}; push @event_urls, $u if $u; if ($rsvp) { unshift @event_urls, "RSVP: $rsvp"; } foreach my $v ($videos ? @$videos : ()) { my ($video, $vtitle) = @$v; push @event_urls, $video; } } 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 $ticket_count = 0; my $first_onsale_date = undef; foreach my $t (@$tickets) { my ($ticket, $desc, $vip_p, $price, $offsale_p, $onsale) = @$t; if ($offsale_p < 0) { # not yet on sale $first_onsale_date = $onsale unless defined($first_onsale_date || $ticket_txt); } elsif ($offsale_p > 0) { # no longer on sale, or sold out } elsif ($desc) { $desc = html_unquote ($desc); # omit VIP prices, to make the line shorter. # $desc =~ s/^(VIP.*): \$\d+$/$1/si; $ticket_txt .= "\n $desc: $ticket"; } else { $ticket_txt .= ((length ($ticket) > 59) ? "\n" : " "); $ticket_txt .= "$ticket\n"; } } if ($ticket_txt) { $ticket_txt = "Tickets:$ticket_txt" unless ($ticket_txt =~ m/^\s*Buy Tickets/si); } elsif ($first_onsale_date) { my $s = strftime ("%b %d", localtime($first_onsale_date)); $ticket_txt = "Tickets on sale $s."; } $src .= "\n\n$ticket_txt\n\n" 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; # Unwrap VIP ticket links. $output =~ s/(\n *VIP.*?:)\n *(http.*)$/$1 $2/gsi; } $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}; # We currently have no webcast in Above DNA or DNA Pizza. $webcast = 'off' unless ($event->{venue} == 0); 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; 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\""; $ct .= " WEBCAST=off" if ($webcast eq 'off'); $ct .= "\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; 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 ($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" . $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" . "
    \n" . ($prev ? " <<\n" : " <<") . ($next ? " >>\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 $closed_p = $event->{title} =~ m/(CLOSED)/i; 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, 0); 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, 0); 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); $html = "-$html" if ($closed_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); $wrote_files{$outfile} = 1; my $txtfile = $outfile; $txtfile =~ s/\.html$/.txt/ || error ("no text version of $outfile?"); DNA::Menuify::write_file ($txtfile, $month_text); $wrote_files{$txtfile} = 1; foreach my $day (sort (keys %$days_html)) { my $html = $days_html->{$day}; my $cancelled_p = ($html =~ s/^-//s); my $closed_p = ($html =~ s/^-//s); my $day_file = $outfile; $day_file =~ s@(\.[^/.]+)$@-$day$1@si; if (($closed_p || $cancelled_p) && ! -f $day_file) { print STDERR "$progname: skipping cancelled: $day_file\n" if ($verbose > 2); next; } DNA::Menuify::write_file ($day_file, $html); $wrote_files{$day_file} = 1; } } # 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); return "" if (!defined ($bands)); $bands = html_unquote ($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) = @_; 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, html_unquote ($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}; my $tt2 = $tt; $tt2 =~ s/ [+&] .*$//s; # "Band A + Band B" $tt2 =~ s/: .*$//s; $mention_event_name = 0 if ($result =~ m/\b\Q$tt\E\b/si || $result =~ m/\b\Q$tt2\E\b/si || $tt =~ m/\b\Q$result\E\b/si); if ($mention_event_name) { my $t = $event->{title}; $t =~ s/: .*$//s; # lose subtitle after colon $result = "$result (at $t)"; } } } #### 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, $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; $body =~ s/^.*%%BOTTOM_START%%//s; my ($menu) = ($body =~ m@(
      )@si); $menu .= "\n"; return $menu; } # Loads the template file and constructs our etc from it. # This is used for the calendar/thumbs.html file. # 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; } # Whether the given time_t is between now, and N days ago. # sub days_ago_p($$) { my ($date, $days) = @_; my $now = time(); my $cutoff = $now - ($days * 24 * 60 * 60); return ($date > $cutoff && $date <= $now); } # 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; # Don't emit the image link for portal dirs that have no upcoming events. # my %portals_with_events; foreach my $event (@future_events) { my $pres = $event->{pres} || ''; my $title = $event->{title}; my ($ptitle, $pdir) = find_portal_dir ($title, $pres); $portals_with_events{$pdir} = 1 if $pdir; } foreach my $dir (sort keys (%portals_with_events)) { 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}[a-z]?)$/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); if ($t2) { $title = $t2; } else { $live_p = 0; # might have decided this one isn't worth listing. } } my $otitle = $title; $title = html_quote ($title); my $d = '
      '; if ($live_p && $title =~ s@^([^,()]+),\s*(.*)$@$d$1
      With $2@si) { } elsif ($live_p && $title =~ s@^([^,()]+)\s*\((.*)\)$@$d$1\u$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, $vip_p, $price, $offsale_p, $onsale) = @$t; if (!$onsale || days_ago_p ($onsale, 14)) { $any_this_week_p = 1; } } if (!$any_this_week_p) { # Omit event unless ticket on sale this week. } elsif ($otitle =~ m/^Bootie\b/) { # Always omit Bootie. } elsif ($otitle =~ m/^Blow Up$/i) { # Omit Blow Up unless subtitle. } elsif ($live_p || $otitle =~ m/:/) { # Announce it if it is a live show, or if it has a subtitle. push @rcnt_html, $html; } if ($live_p) { push @live_html, $html; } else { push @other_html, $html; } } my ($portal_html, $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_html = join ('',@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 = ''; } my $output = ("$page_title: Tickets\n" . "\n" . "\n" . # load_store_blurb ($dir) . "
      \n" . "\n" . "Monthly and Weekly Events\n" . "\n" . "Multiple dates are available for these" . " recurring events!" . "\n" . "$portal_html\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"); my $outfile = "$dir/$calendar_tickets_file"; 1 while $outfile =~ s@[^/]+/\.\./@@g; DNA::Menuify::write_file ($outfile, $output); $wrote_files{$outfile} = 1; } # Generates the "Just Announced" and "Other upcoming live shows" blurb # at the top of the weekly mailing. Also the twitter post contents. # sub generate_calendar_upcoming($) { my ($dir) = @_; my $output = ""; my $max_events = 15; my @events = ticket_events (1, 0); my $twit_onsale_lastweek = ''; my $twit_onsale_yesterday = ''; if ($#events >= 0) { my $body = ""; my $heading_inserted_p = 0; my $next_inserted_p = 0; my $lastweek_html = ''; my $output_count = 0; foreach my $event (@events) { 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 $lineup_p = scalar (@{$event->{performers}}); 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 $onsale_lastweek_p = 0; my $onsale_yesterday_p = 0; my $first_ticket = undef; foreach my $t (@$tickets) { my ($ticket, $desc, $vip_p, $price, $offsale_p, $onsale) = @$t; if (!$first_ticket && !$vip_p && !$offsale_p) { $first_ticket = $ticket; $onsale_yesterday_p = days_ago_p ($onsale, 1); $onsale_lastweek_p = days_ago_p ($onsale, 7); if ($verbose > 1 && $onsale_lastweek_p) { print STDERR "$progname: " . $event->{key} . " went onsale " . sprintf("%.1f", ((time() - $onsale) / (24 * 60 * 60))) . " days ago\n"; } } } # If the ticket went on sale with *no* performers listed, then don't # announce it. This means it won't get announced at all, which is # unfortunate. # if (! $lineup_p) { $onsale_yesterday_p = 0; $onsale_lastweek_p = 0; } # 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, 0); 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 && !$onsale_yesterday_p && !$onsale_lastweek_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}[a-z]?)$/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)"; } elsif ($free_p) { $col1 = "-free-"; } elsif ($out_p) { $col1 = "sold out!"; } $tr .= " $col1"; $title = html_quote ($title); $title = "$flyer_open$title$flyer_close"; # Convert "Band (at Event)" to # Convert "Band (at Event)". $title =~ s@( \(.*?\))(()?)@$2$1@si; $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 ($onsale_lastweek_p) { $lastweek_html .= $tr; $twit_onsale_lastweek .= $event->{key} . "\n"; $twit_onsale_yesterday.= $event->{key} . "\n" if ($onsale_yesterday_p); next; } # # Insert the "Upcoming" headings into $body if it's now time. # if (!$heading_inserted_p) { # Heading goes on its own line $body .= (" \n" . " " . "" . "Upcoming live shows:" . "" . "\n" . " \n"); $heading_inserted_p = 1; } # # Finally, tack this line onto $body. # $body .= $tr; } if ($lastweek_html) { $body =~ s@(Upcoming live shows:)@
      Other \l$1@si; $body = (" \n" . " " . "" . "Just announced:" . "" . "\n" . " \n" . $lastweek_html . $body); } $output .= $body; } my $twit_thisweek = ''; { 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_yesterday, $twit_onsale_lastweek, $twit_thisweek); } sub image_size($) { my ($file) = @_; my $mtime = (stat($file))[9]; error ("$file does not exist") unless $mtime; return (0, 0) unless $mtime; my $cmd = ('identify' . ' -define pdf:use-trimbox=true' . ' -density 300x300' . ' -format "%wx%h\n"' . ' "' . $file . '"'); print STDERR "$progname: executing: $cmd\n" if ($verbose > 7); my $result = `$cmd`; $result =~ s/\s+$//s; print STDERR "$progname: ==> $result\n" if ($verbose > 7); my ($ww, $hh, $pages) = (0, 0, 0); foreach (split(/\n/, $result)) { next unless $_; my ($w, $h) = m/^(\d+)x(\d+)$/; error ("unparsable: $_") unless ($w && $h); $ww = $w; $hh += $h; $pages++; } error ("no size: $file") unless ($ww && $hh); print STDERR "$progname: $pages pages\n" if ($pages > 1 && $verbose > 7); return ($ww, $hh); } # Write the calendar/thumbs.html file. # This file is later included in the top level /index.html file. # my $saved_calendar_thumbs = undef; # we use it a couple times sub generate_calendar_thumbs_1($$) { my ($dir, $first_event) = @_; return $saved_calendar_thumbs if ($saved_calendar_thumbs); my $output = ""; $output .= ("\n" . "
      \n" . "\n"); my $max = 5; my $embed_html = ''; my $embed_count = 0; my %already_embedded; my %done; foreach my $which ('week', 'live') { my $count = 0; my @events = (); my @hype = (); for (my $event = $first_event; $event; $event = $event->{next_event}) { my $title = $event->{title}; my $date = $event->{date}; my $flyer = $event->{flyer}; my $live_p = $event->{live_p}; my $hype_p = $event->{hype_p} && ($which eq 'live'); next unless $flyer; next if ($done{$title}); # next if ($done{$flyer}); if ($live_p) { # might have decided this one isn't worth listing. my $t2 = compute_band_based_title ($event, 0); $live_p = 0 unless $t2; } next if ($which eq 'live' && !($live_p || $hype_p)); # 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/ix) { print STDERR "$progname: skipping private: $date: $title\n" if ($verbose > 2); next; } $count++; if ($count > $max) { if ($hype_p) { push @hype, $event; $done{$title} = 1; $done{$flyer} = 1; } next; } push @events, $event; $done{$title} = 1; $done{$flyer} = 1; } # We now have $max events in @events, and may have more in @hype. # Take N (length of @hype) entries off the back of @events and then # append it, for a total of $max. # pop @hype while (@hype > $max); pop @events while (@events > ($max - @hype)); push @events, @hype; my @entries = (); my $max_h = 0; foreach my $event (@events) { my $title = $event->{title}; my $times = $event->{times}; my $flyer = $event->{flyer}; 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}[a-z]?)$/s); $cal_url = "../calendar/$yyyy/$mm-$dd.html"; } $title = html_quote ($title); $title =~ s/: /
      /gs; my $fimg = $flyer; $fimg =~ s@\.html$@-1-thumb.jpg@si; my ($w, $h) = image_size ($fimg); my $landscape_p = ($w * 0.95 > $h); $h *= 2 if $landscape_p; $max_h = $h if ($h > $max_h); push @entries, [ $title, $date, $cal_url, $flyer, $fimg, $w, $h, $landscape_p ]; } # Figure out what the total width would be if each image was scaled # to the height of the tallest image. # my $total_w = 0; foreach my $e (@entries) { my ($title, $date, $cal_url, $flyer, $fimg, $w, $h) = @$e; my $scaled_w = $w * $max_h / $h; $total_w += $scaled_w; } $output .= ("" . ($which eq 'week' ? 'This Week' : 'Upcoming Live Shows') . "\n\n" . "
      \n"); foreach my $e (@entries) { my ($title, $date, $cal_url, $flyer, $fimg, $w, $h, $landscape_p) = @$e; my $scaled_w = $w * $max_h / $h; my $fimg2 = undef; my $wpct = 100 * $scaled_w / $total_w; $wpct = sprintf ("%.4f%%", $wpct); if ($landscape_p) { $fimg2 = $fimg; $fimg2 =~ s/-1(-thumb)/-2$1/s; if (! -f $fimg2) { $fimg2 = $fimg; } else { my ($w2, $h2) = image_size ($fimg2); $h2 *= 2; $fimg2 = $fimg unless ($w == $w2 && $h == $h2); } } $flyer = "../$flyer"; $fimg = "../$fimg"; $fimg2 = "../$fimg2" if $fimg2; $fimg = ""; $fimg .= "" if $fimg2; # no newline between $output .= ("\n" . "
      \n" . "
      \n" . " $date\n" . " $title\n" . "
      \n" . " $fimg" . "
      " . "      "); } $output .= "\n
      \n"; } $output .= ("\n" . "\n" . "
      \n" . "\n"); $saved_calendar_thumbs = $output; return $output; } sub generate_calendar_thumbs($) { my ($dir) = @_; my $output = generate_calendar_thumbs_1 ($dir, $future_events[0]); my $body = $body_template; my $title = "$page_title: Upcoming Events"; $body =~ s@(]*>).*()@$1$title$2@s; $body =~ s@(]*>).*()@$1\n\n$output $2@s; my $outfile = "$dir/$calendar_thumbs_file"; DNA::Menuify::write_file ($outfile, $body); $wrote_files{$outfile} = 1; } # 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}[a-z]?)$/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, 1); my $text = build_event_text ($event, 0, 1, 0, 1, undef, undef); ($html) = ($html =~ m@(.*?)@si); $html = decolorize_html ($html); $html = hardcode_stylesheet ($dir, "rss", $html); # Also, "../vip.html" => "..../calendar/vip.html" $html =~ s@\"\.\./([^\"]+\")@\"${url_base}calendar/$1@sg; $text =~ s/^ //gm; # de-indent by 4 spaces. $text =~ s/&/&/gsi; $text =~ s//>/g; # RSS can't have entities other than &, <, >. $ititle = html_unquote ($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); $wrote_files{$outfile} = 1; } 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 =~ s@<[^<>]*>@ @gsi; $val = html_unquote ($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 $age = $event->{age} || ''; my $price = $event->{price} || ''; 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); 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, $vip_p, $price, $offsale_p) = @$t; if (!$offsale_p) { # 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; # Wrap long lines, just in case something somewhere chokes on them. { $Text::Wrap::columns = 77; my @paras = split(/\n/, $text); foreach my $p (@paras) { if (length($p) > $Text::Wrap::columns) { $p = wrap ('', ' ', $p); $p =~ s/^\n+//s; # WTF } } $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, '<:utf8', $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[a-z]?)$@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); $wrote_files{$outfile} = 1; } # 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); $wrote_files{$outfile} = 1; } # 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; # Break before STYLE= when there are quotes to avoid wrapping inside. $html =~ s@\s+(STYLE=\"[^\"\']+\')@\n$1@gsi; $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, $name, $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; $sheet1 =~ s/\@font-face {[^{}]+}//gs; # Web Fonts. # This isn't actually valid parsing, but it works for our sheets. # Just toss everything between "@media" and "\n}\n". 1 while ($sheet1 =~ s/\n\@media\b[^\n]*{\n.*?\n}[ \t]*\n/\n/gs); 1 while ($sheet1 =~ s/\n\@media\b[^\n]*{[^\n]*}[ \t]*\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 || $sel eq 'body'); 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}; error ("no class \"$sel\"") unless defined($val); my %attrs; foreach my $attr (split(/\s*;[;\s]*/, $val)) { my ($key, $val2) = ($attr =~ m@^([-a-z]+)\s*:\s*(.*)$@s); error ("$name: unparsable attr: $attr -- $sel { $val }") unless defined($val2); $attrs{$key} = $val2; } $val = ''; foreach my $key (keys (%attrs)) { $val .= "; " if $val; $val .= "${key}:" . $attrs{$key}; } $val =~ s/\"/'/gs; # no nested double-quotes $val = " STYLE=\"$val\"" if ($val =~ m/[^\s]/); $html =~ s@\s+CLASS=\"\Q$sel\E\"@$val@gsi; } error ("$name: unparsable style sheet: $sheet") if $sheet; $html =~ s@(\bCLASS=\"([^\"]+))@{ my ($o, $c) = ($1, $2); error ("$name: failed to nuke class \"$c: $html\n") unless ($c eq 'g-plusone'); $o; }@gsexi; error ("$name: stripped CSS still contains $1") if ($html =~ m@\b (( position | margin(-[a-z]+)? | z-index ) \s*:\s* [^;"]+ )@six); error ("$name: 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@()(\n$html\n

      \n"; return $html; } # Decolorizing the style sheet isn't quite enough... # This also converts relative URLs to absolute. # sub decolorize_html($) { my ($html) = @_; $html =~ s@((HREF|SRC)=\")../../@$1$url_base@gsi; # fix relative URLs $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 various "weekly" files: # # calendar/weekly.txt text/plain half of weekly mailing # calendar/weekly.html text/html half of weekly mailing # calendar/weekly-thisweek.txt IDs of events coming up this week # calendar/weekly-onsale.txt IDs of events on sale in the last week # calendar/daily-onsale.txt IDs of events on sale yesterday # # 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, 1); ($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_yesterday, $output_twit_onsale_lastweek, $output_twit_thisweek) = generate_calendar_upcoming ($dir); $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 " . # "Rentals page, and contact us at " . # "" . # "booking\@dnalounge.com for more information or to schedule" . # " a tour.

      " . "

      Won't you be our friend? We're on " . "Facebook, " . "Twitter, " . "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 have a full bar. " . "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); # 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, "weekly", $output_html); $output_html =~ s@\s*$@@s; # re-open font-family div. $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" . "\n" . # font-family "

      \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"; $output_html =~ s@((SRC|HREF)=[\"\'])//@http://@gsi; my $outfile = "$dir/$calendar_weekly_file"; my $o2 = $outfile; DNA::Menuify::write_file ($outfile, $output_text); $wrote_files{$outfile} = 1; $outfile =~ s@\.txt$@.html@; DNA::Menuify::write_file ($outfile, $output_html); $wrote_files{$outfile} = 1; $outfile =~ s@\.[a-z]+$@-onsale.txt@; DNA::Menuify::write_file ($outfile, $output_twit_onsale_lastweek); $wrote_files{$outfile} = 1; $outfile =~ s@weekly@daily@; DNA::Menuify::write_file ($outfile, $output_twit_onsale_yesterday); $wrote_files{$outfile} = 1; $outfile = $o2; $outfile =~ s@\.[a-z]+$@-thisweek.txt@; DNA::Menuify::write_file ($outfile, $output_twit_thisweek); $wrote_files{$outfile} = 1; } # 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} = ''; } # Update titles in $portal_dirs for expired events. foreach my $event (@event_ords) { my $pres = $event->{pres} || ''; my $title = $event->{title}; find_portal_dir ($title, $pres); } my ($csec, $cmin, $chour, $cdotm, $cmm, $cyear) = localtime; $cmm++; $cyear += 1900; 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 = ($title =~ s@^(.*?): (.*)$@$1@si ? $2 : ''); 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 = html_quote ($title); $subtitle = html_quote ($subtitle) if $subtitle; # 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}[a-z]?)$/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 $today_p = ($year == $cyear && $mm == $cmm && $dotm == $cdotm); my @lineup = (); my $max = 4; my $maxxed = 0; foreach my $p (@{$event->{performers}}) { my ($name, $type) = @$p; next if ($title =~ m/\b\Q$name\E\b/si); next if ($subtitle && $subtitle =~ m/\b\Q$name\E\b/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 $onsale_p = 0; my $non_vip_count = 0; if ($tickets) { foreach my $t (@$tickets) { my ($ticket, $desc, $vip_p, $price, $offsale_p) = @$t; $non_vip_count++ unless $vip_p; if ($offsale_p < 0) { # not yet on sale: still list it } elsif ($offsale_p == 2) { # sold out: still list it } elsif ($offsale_p > 0) { # no longer on sale, or sold out $ticket = undef; } elsif ($vip_p) { $ticket = undef; # ignore these } $onsale_p += defined($ticket); } } next unless ($onsale_p || ($today_p && $non_vip_count > 0)); my $buy = ($onsale_p ? "Buy tickets here!" : "Tickets no longer on sale:" . "Buy tickets at the door!"); $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 are on sale right now. " . "Check back soon!" . "
      ") unless $html; $html = ("$page_title: $otitle Tickets\n" . "\n" . ($title_img_w ? (" \n" . " \n") : "") . "\n" . $title . # $store . # "
      \n" . $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); $wrote_files{$outfile} = 1; } } # 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 = join("\n", ('Hello! And thank you for calling DNA Lounge.', 'We are located at 375 Eleventh Street, between Folsom and Harrison.', 'Advance tickets are available at DNA Lounge dot com.', '', 'DNA Pizza is open 24 7, right next door!', 'Pizza, sandwiches, coffee, espresso, and a full bar.', 'Free delivery, free why-fie!', '', 'Join us for coffee and pastries in the morning, and ' . 'for a slice before or after your night of clubbing! ', '', 'Here are our upcoming events!', 'Press star, to skip ahead.', 'Press any other key to back up.')) . "\n"; $output =~ s/^/ /gm; $output =~ s/ +$//gm; 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); # Avoid Unicode 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); $wrote_files{$outfile} = 1; } 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|Dazzle Room):@$1In the $2:@gmi; s/\b([A-Z])([-A-Z\d]+)\b/$1\L$2/gs; # Capitalize all-caps words. s/\b(SF|LA|DJ|MC|ID|TBA|DNA|VIP)\b/\U$1/gsi; # Upcase special words # 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/gen\.? adm\.?/general admission/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/^.*?\bHosted by .*?\n//gim; s/^.*?\bPhotobooth by .*?\n//gim; s/^.*?\bRoaming photos 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($) { my ($dir) = @_; # If the event is < N1 days out with missing info, "IMMINENT" warning. my $ndays1 = 16; # if the event is > N2 days out, don't warn about missing flyers, etc. my $ndays2 = 28; # if the event is > N3 days out, STFU. my $ndays3 = 90; 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 $to3 = $from + ($ndays3 * 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 $distant_future_p = ($etime >= $to3); my $pres = $event->{pres} || ''; 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 $url = $event->{key}; $url =~ s@-@/@s; $url = "${url_base}calendar/$url.html"; $date = "$date"; my $ignore_p = ($title =~ m/\b(PRIVATE\s+(PARTY|EVENT)|CANCELL?ED|POSTPONED)\b/i); $ignore_p = 1 if ($distant_future_p); my $video_p = $event->{videos} ? @{$event->{videos}} > 0 : 0; my $time = $event->{time} || ''; my $genre = $event->{genre} || ''; my $price = $event->{price} || ''; my $age_p = $event->{age}; 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 $genre_p = ($genre !~ m/^\s*$/s); my $tba_p = ($md =~ m@\bTBA\b@i); my $band_p = 0; my $above_p = ($event->{venue} > 0); my $tickets = $event->{tickets}; my $ticket_p = 0; my $vip_p = 0; my $performer_count = 0; my $band_count = 0; my $dj_count = 0; my $band_url_count = 0; my $dj_url_count = 0; if ($tickets) { foreach my $t (@$tickets) { my ($ticket, $desc, $vip2) = @$t; if ($vip2) { $vip_p = 1; } else { $ticket_p = 1; } } } # Find the Facebook event ID for this event. # my $facebook_p = 0; foreach my $key (@{$event_ids{$event->{key}}}) { my ($site, $id) = ($key =~ m/^(.*?)=(.*)$/si); if ($site eq 'facebook') { $facebook_p = 1; last; } } foreach my $p (@{$event->{performers}}) { my ($name, $type, $dup, $url, $room) = @$p; $performer_count++; if ($type eq 'BAND') { $band_p = 1; $band_count++; $band_url_count++ if $url; last; } elsif ($type eq 'DJ') { $dj_count++; $dj_url_count++ if $url; } } # Warn about missing URLs if: # - Any band is missing a URL; # - It's a DJ-only event and *all* the DJs are missing URLs. # This is because DJ events tend to be padded with nobodies. # my $missing_urls_p = ($band_p ? ($band_count != $band_url_count) : ($dj_count > 0 && $dj_url_count == 0)); # But don't warn about Battle of the Bands. $missing_urls_p = 0 if ($title =~ m/( ^Battle\s+of\s+the\s+Bands | ^Gorilla | ^Debut | )/six); # Consider a distant event to be blank if it has < N performers listed. $blank_p = 1 if ($performer_count <= 2 && !$time_to_warn_p); # 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 ^Tap\sTurnover )/six); # No VIPs in Above DNA or DNA Pizza. $vip_p = 1 if $above_p; # These events don't do Facebook. $facebook_p = 1 if ($title =~ m/( ^Death\sGuild )/six); # Don't warn about Facebook if there's no flyer yet. $facebook_p = 1 unless $flyer; my $small_flyer_p = 0; if ($flyer) { my $f2 = $flyer; $f2 =~ s/\.html$/-1.jpg/s; my $cmd = "identify -format \"%w %h\" \"$f2\""; my $result = `$cmd`; chomp ($result); my ($w, $h) = split(/ /, $result); $small_flyer_p = ($w < 1200 && $h < 1200); # Kludge for stupid old DG flyers $small_flyer_p = 0 if ($flyer =~ m@^flyers/2012/08/2[07]@s); } # Warn if tickets are not on sale for Mortified or Debut even if we # have no performers. if ($title =~ m/( ^Mortified | ^Debut\b )/six || $pres =~ m/( Obscura \s+ Society )/six) { $time_to_warn_p = 1; $blank_p = 0; $genre_p = 1; # Also, these have no genres. } if ($title =~ m/(^Tap Turnover)/si) { $genre_p = 1; # No genre. } # 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; $facebook_p = 1; $missing_urls_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" unless $ticket_p; push @miss, "vip 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; push @miss, "genre" unless $genre_p; push @miss, "facebook" unless $facebook_p; push @miss, "URLs" if $missing_urls_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"; } $miss = "still TBA" . ($miss ? "; $miss" : "") if ($tba_p); $miss = "small flyer" . ($miss ? "; $miss" : "") if ($small_flyer_p); if ($miss) { $miss = "
    • $date: $miss: $title
      • \n"; if ($etime > $to1) { $warnings .= $miss; } else { $errors .= $miss; } } } } my $out = ""; $out .= "

      Missing info -- IMMINENT:\n\n

        $errors
      \n" if $errors; $out .= "

      Missing info -- less-imminent:\n\n

        $warnings
      \n" if $warnings; my $html = $out; $html =~ s/& /& /gs; $html = ("\n" . " \n" . "\n" . "\n" . $html . "\n"); my $outfile = "$dir/$warnings_file"; DNA::Menuify::write_file ($outfile, $html); $wrote_files{$outfile} = 1; if ($verbose && $out) { $out =~ s/<[^<>]*?>//gsi; print STDERR "\n$out"; } } # 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 $videos = $event->{videos}; foreach my $v ($videos ? @$videos : ()) { my ($video, $vtitle) = @$v; $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/in your country/i); if (!$err && $body =~ m@
      ]* > \s* ( [^<>]+? ) \s*
      @six) { $err = $1; } $err = $res->status_line if (!$err && !$res->is_success); # Because Google thinks cerebrum is in some other country. $err = undef if ($err && $err eq 'blocked'); 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) = @_; # 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@\b ((VIP | Table) \s (Service|Upstairs|Downstairs|Double) | VIP \s Table | Booth) \b@sx); 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, '<:utf8', $file) || error ("$file: $!"); local $/ = undef; # read entire file my $data = <$in>; close $in; my $now = time(); 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_p, $flyer, $name, $hidden, $soldout_p, $price_desc) = split(/\t/, $line); error ("unparsable: $line") unless ($name && $name =~ m/[^\s]/s); error ("$ticket: no calid") unless ($calid); $price =~ s/\.00$//s; $flyer =~ s@-\d-thumb(\.[^./]+)$@.html@si; # 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) { my $eid = $event->{key}; next unless ($eid eq $calid); error ("$ticket: $eid: multiple event matches") if $ok; my $desc = extract_ticket_name ($ticket, $calid, $event->{title}, $name, $vip_p); my $url = $ticket_url_base . $ticket; # Include the VIP price in the description. # if ($vip_p) { $desc = 'VIP Service' unless $desc; $price =~ s/\.00$//s; $desc .= ": \$$price"; } # -1: not yet on sale (on-sale time has not arrived). # 0: on sale. # 1: no longer on sale (off-sale time has passed). # 2: no longer on sale (sold out). # my $offsale_p = ($onsale && $now < $onsale ? -1 : $offsale && $now >= $offsale ? 1 : $soldout_p ? 2 : 0); my @t = ($url, $desc, $vip_p, $price, $offsale_p, $onsale, $offsale, $price_desc); if ($hidden) { print STDERR "$progname: $eid: ticket $ticket is hidden\n" if ($verbose > 1); } else { print STDERR "$progname: $eid: ticket $ticket is sold out\n" if ($soldout_p && $verbose > 1); 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, $vipa, $pricea, $offsalea, $onsalea) = @$a; my ($urlb, $descb, $vipb, $priceb, $offsaleb, $onsaleb) = @$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, $vip_p) = @$t; if ($vip_p) { $vip_count++; } else { $non_count++; } } # Make sure each ticket has the price in its description. # foreach my $t (@{$event->{tickets}}) { my @t = @$t; my ($url, $desc, $vip_p, $price, $offsale_p, $onsale, $offsale, $price_desc) = @t; if (! $desc) { $desc = ($vip_p ? 'VIP Service' : 'Buy Tickets'); } $desc .= ": \$$price" unless ($desc =~ m@\$\d@s); @t = ($url, $desc, $vip_p, $price, $offsale_p, $onsale, $offsale, $price_desc); $t = \@t; } } # Make sure each event's ticket prices match the event's prices. # Events might have multiple tickets at multiple prices, so this # can be tricky. # foreach my $eid (sort calendar_id_cmp (keys %ticket_events)) { my $event = $ticket_events{$eid}; my $etitle = $event->{title}; my $door = $event->{door} || ''; my $adv = $event->{adv} || ''; # Count how many non-VIP tickets are on sale. my $ticket_count = 0; my $onsale_count = 0; foreach my $t (@{$event->{tickets}}) { my ($url, $desc, $vip_p, $price, $offsale_p) = @$t; next if ($vip_p); $ticket_count++; $onsale_count++ unless $offsale_p; } # Don't complain about events that don't have any tickets on sale yet. next if ($ticket_count == 0); # Don't complain about events that are in the past. next if ($onsale_count == 0); # Gather up the advance price description from the various tickets. # my $tadv = ''; foreach my $t (@{$event->{tickets}}) { my ($url, $desc, $vip_p, $price, $offsale_p, $onsale, $offsale, $price_desc) = @$t; next if ($vip_p); $desc =~ s/^Buy Tickets:/:/si; $desc =~ s/: \$[\d.]+$//s; my $opd = $price_desc; $price_desc .= ' gen. adm.' if ($ticket_count > 1 && !$desc && $price_desc !~ m/after/); if ($desc) { $desc =~ s@(18\+|21\+|A/?A) ticket@advance for $1@si; $price_desc .= " $desc"; } $price_desc = "$price_desc" if ($offsale_p == 2); # sold out if ($price_desc) { $tadv .= '; ' if ($tadv); $tadv .= $price_desc; } } # Figure out the advance price listed or implied by the calendar. # if (! $adv && $ticket_count > 0) { if ($door =~ m/^\$[\d.]+$/s) { $adv = $door; } # simple elsif ($door =~ m/(\$[\d.]+) after/s) { $adv = $1; } # $X after elsif ($door =~ m/^[^\$]*(\$[\d.]+)[^\$]*$/s) { $adv = $1; } # only one elsif ($door =~ m/^[^\$]*(\$[\d.]+)/s) { $adv = $1; } # first one } # Spell words the same in both. # foreach ($adv, $tadv) { s/\bltd\./limited/gs; s/\badv\./advance/gs; $_ .= ' advance' if (m/^\$[\d.]+$/s); $_ .= '.' if (m/[^.!]$/s); } my $adv_cmp = lc($adv); my $tadv_cmp = lc($tadv); next if ($adv_cmp eq $tadv_cmp); # Exact match foreach ($adv_cmp, $tadv_cmp) { s@@@gsi; } if ($adv_cmp ne $tadv_cmp) { # Warn. print STDERR "$progname: WARNING: $eid: ticket mismatch:\n" . "$progname: $etitle\n" . "$progname: using: $tadv\n" . "$progname: instead of: $adv\n\n" if ($verbose); } $event->{adv} = $tadv; # Insert. my $op = $event->{price}; $event->{adv} = $tadv; $event->{price} = splice_price ($event->{adv}, $event->{door}); if ($event->{price} eq $op) { print STDERR "WARNING: unable to repair price: \"$op\", \"$adv\"\n"; } } } # Write all of the files: # - calendar/YYYY/MM.html # - calendar/YYYY/MM.txt # - calendar/YYYY/MM-DD.html # - calendar/thumbs.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) { generate_calendar_rss ($dir); generate_calendar_ical ($dir); generate_names_file ($dir); generate_ticket_portals ($dir); generate_tickets_html ($dir); generate_calendar_thumbs ($dir); generate_crontab ($dir); generate_weekly ($dir); generate_infoline ($dir); generate_eighties_file ($dir) unless ($summarize_only_p); } generate_ledger_html ($dir, $topten_p) unless ($summarize_only_p); check_impending_tba ($dir) unless ($summarize_only_p || $topten_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; } $output .= "\n"; $output .= "
      \n"; { 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 .= (($prev_href ? "$prev\n" : "$prev\n") . ($next_href ? "$next\n" : "$next\n")); } $output .= "$year\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); $wrote_files{$outfile} = 1; } 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" . "
      $page_title
      \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); $wrote_files{$outfile} = 1; } # Print a warning if there are any files in the calendar directory # that we didn't write. # sub check_orphans($) { my ($dir) = @_; my %files; sub check_orphans_1($$); sub check_orphans_1($$) { my ($dir, $filesP) = @_; opendir (my $d, $dir) || error ("$dir: $!"); my @files = readdir ($d); closedir ($d); foreach my $f (@files) { next if ($f =~ m/^\./s); next if ($f =~ m/^CVS$/s); next if ($f =~ m/~$/s); next if ($f =~ m/^1985-/s); if (-d "$dir/$f") { check_orphans_1 ("$dir/$f", $filesP); } else { $filesP->{"$dir/$f"} = 1; } } } check_orphans_1 ($dir, \%files); my %f2; foreach my $k (keys %files, keys %wrote_files) { $f2{$k} = 1; } foreach my $k (sort (keys %f2)) { if ($files{$k} && !$wrote_files{$k} && $k =~ m@/\d@s) { if ($k =~ m/\.tmp$/s) { unlink $k; # don't even bother mentioning it, just kill it. } else { print STDERR "$progname: WARNING: orphan: $k\n"; } } } # foreach my $key (sort keys %event_ids) { # if (!defined($calendar{$key})) { # print STDERR "$progname: orphan id: $key\n"; # } # } } ############################################################################## 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_posters ($dir); 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); check_orphans ($dir) unless ($summarize_only_p || $topten_p); ping_videos() if ($ping_videos_p); } main(); exit 0;